NOTE: This patch has been committed. APPROVE COMMIT Thank you FKtPp! xemacs-packages/fsf-compat/ChangeLog addition: 2008-04-10 Aidan Kehoe <kehoea(a)parhasard.net&gt; * overlay.el: Merge FKtPp's patch of 47D560A2.5010300(a)yahoo.com.cn, adding support for BEG and END arguments to the various overlay functions that are not compatible with XEmacs' definition of sanity for the corresponding extent functions. Thank you FKtPp! Also, fix some byte-compilation warnings introduced by FKtPp's patch. XEmacs Packages source patch: Diff command: cvs -q diff -Nu Files affected: xemacs-packages/fsf-compat/overlay.el =================================================================== RCS Index: xemacs-packages/fsf-compat/overlay.el =================================================================== RCS file: /pack/xemacscvs/XEmacs/packages/xemacs-packages/fsf-compat/overlay.el,v retrieving revision 1.2 diff -u -u -r1.2 overlay.el --- xemacs-packages/fsf-compat/overlay.el 1999/11/27 20:49:51 1.2 +++ xemacs-packages/fsf-compat/overlay.el 2008/04/10 21:27:35 ＠＠ -69,6 +69,35 ＠＠ (and (extentp object) (extent-property object 'overlay))) + +(defsubst overlay-normalize-pos (pos buffer) + "Return the normalized POS, so 1 <= POS <= \(1+ \(length BUFFER))." + (let ((buffer-min 1) + (buffer-max (1+ (buffer-size buffer)))) + (cond ((< pos buffer-min) + buffer-min) + ((> pos buffer-max) + buffer-max) + (t + pos)))) + +(defsubst overlay-normalize-begin-end-buffer (beg end &optional buffer) + "BEG and END will be normalized so 1 <= BEG <= END <= \(1+ \(length BUFFER)). + +If BUFFER is nil, the current buffer is assumed. If BEG is +greater than END, exchange their value." + + (if (null buffer) + (setq buffer (current-buffer)) + (check-argument-type 'bufferp buffer)) + + (setq beg (overlay-normalize-pos beg buffer) + end (overlay-normalize-pos end buffer)) + + (when (> beg end) + (setq beg (prog1 end (setq end beg)))) + (values beg end)) + (defun make-overlay (beg end &optional buffer front-advance rear-advance) "Create a new overlay with range BEG to END in BUFFER. If omitted, BUFFER defaults to the current buffer. ＠＠ -76,13 +105,15 ＠＠ The fourth arg FRONT-ADVANCE, if non-nil, makes the front delimiter advance when text is inserted there. The fifth arg REAR-ADVANCE, if non-nil, makes the -rear delimiter advance when text is inserted there." - (if (null buffer) - (setq buffer (current-buffer)) - (check-argument-type 'bufferp buffer)) - (when (> beg end) - (setq beg (prog1 end (setq end beg)))) +rear delimiter advance when text is inserted there. +BEG and END will be normalized so 1 <= BEG <= END <= \(1+ \(length BUFFER)). +If BUFFER is nil, the current buffer is assumed. If BEG is +greater than END, exchange their value." + + (multiple-value-setq + (beg end buffer) + (overlay-normalize-begin-end-buffer beg end buffer)) (let ((overlay (make-extent beg end buffer))) (set-extent-property overlay 'overlay t) (if front-advance ＠＠ -91,19 +122,24 ＠＠ (if rear-advance (set-extent-property overlay 'end-closed t) (set-extent-property overlay 'end-open t)) - overlay)) (defun move-overlay (overlay beg end &optional buffer) "Set the endpoints of OVERLAY to BEG and END in BUFFER. If BUFFER is omitted, leave OVERLAY in the same buffer it inhabits now. If BUFFER is omitted, and OVERLAY is in no buffer, put it in the current -buffer." +buffer. + + +BEG and END will be normalized so 1 <= BEG <= END <= \(1+ \(length BUFFER)). +If BUFFER is nil, the current buffer is assumed. If BEG is +greater than END, exchange their value." + (check-argument-type 'overlayp overlay) (if (null buffer) (setq buffer (extent-object overlay))) - (if (null buffer) - (setq buffer (current-buffer))) + (multiple-value-setq (beg end buffer) + (overlay-normalize-begin-end-buffer beg end buffer)) (check-argument-type 'bufferp buffer) (and (= beg end) (extent-property overlay 'evaporate) ＠＠ -141,24 +177,31 ＠＠ (check-argument-type 'overlayp overlay) (extent-properties overlay)) -(defun overlays-at (pos) +(defun overlays-at (pos &optional buffer) "Return a list of the overlays that contain position POS." - (overlays-in pos pos)) + (overlays-in pos pos buffer)) -(defun overlays-in (beg end) +(defun overlays-in (beg end &optional buffer) "Return a list of the overlays that overlap the region BEG ... END. Overlap means that at least one character is contained within the overlay and also contained within the specified region. Empty overlays are included in the result if they are located at BEG -or between BEG and END." +or between BEG and END. + +BEG and END will be normalized so 1 <= BEG <= END <= \(1+ \(length CURRENT-BUFFER))." + (setq beg (overlay-normalize-pos beg buffer) + end (overlay-normalize-pos end buffer)) (mapcar-extents #'identity nil nil beg end 'all-extents-closed-open 'overlay)) -(defun next-overlay-change (pos) +(defun next-overlay-change (pos &optional buffer) "Return the next position after POS where an overlay starts or ends. -If there are no more overlay boundaries after POS, return (point-max)." - (let ((next (point-max)) +If there are no more overlay boundaries after POS, return (point-max). + +POS will be normalized so 1 <= POS <= \(1+ \(length CURRENT-BUFFER))." + (let ((next (point-max buffer)) tmp) + (setq pos (overlay-normalize-pos pos buffer)) (map-extents (lambda (overlay ignore) (when (or (and (< (setq tmp (extent-start-position overlay)) next) ＠＠ -170,11 +213,14 ＠＠ nil pos nil nil 'all-extents-closed-open 'overlay) next)) -(defun previous-overlay-change (pos) +(defun previous-overlay-change (pos &optional buffer) "Return the previous position before POS where an overlay starts or ends. -If there are no more overlay boundaries before POS, return (point-min)." - (let ((prev (point-min)) +If there are no more overlay boundaries before POS, return (point-min). + +POS will be normalized so 1 <= POS <= \(1+ \(length CURRENT-BUFFER))." + (let ((prev (point-min buffer)) tmp) + (setq pos (overlay-normalize-pos pos buffer)) (map-extents (lambda (overlay ignore) (when (or (and (> (setq tmp (extent-end-position overlay)) prev) ＠＠ -204,9 +250,12 ＠＠ nil) nil nil nil nil 'all-extents-closed-open 'overlay) (cons (nreverse before) (nreverse after)))) + +(defun overlay-recenter (pos &optional buffer) + "Recenter the overlays of the current buffer around position POS. -(defun overlay-recenter (pos) - "Recenter the overlays of the current buffer around position POS." +POS will be normalized so 1 <= POS <= \(1+ \(length CURRENT-BUFFER))." + (setq pos (overlay-normalize-pos pos buffer)) (set (make-local-variable 'xemacs-internal-overlay-center-pos) pos)) (defun overlay-get (overlay prop) -- ¿Dónde estará ahora mi sobrino Yoghurtu Nghé, que tuvo que huir precipitadamente de la aldea por culpa de la escasez de rinocerontes? _______________________________________________ XEmacs-Patches mailing list XEmacs-Patches(a)xemacs.org http://calypso.tux.org/cgi-bin/mailman/listinfo/xemacs-patches