# HG changeset patch # User Richard M. Stallman # Date 1020015979 0 # Node ID 4a1d60fe2473eef9a51e6a629e972d9c3238c802 # Parent 66535b19af6b5cdc0e937d66ebfc3f2c9f1d18d9 (occur-accumulate-lines): Avoid incf and decf. (occur-engine-add-prefix): New function. (occur-engine): Avoid using macrolet, incf and decf. Use occur-engine-add-prefix instead. Rename `l' to `lines' and `c' to `matches'. (occur-engine, occur-mode-mouse-goto) (occur-mode-find-occurrence, occur-mode-goto-occurrence) (occur-mode-goto-occurrence-other-window) (occur-mode-display-occurrence): A position is just a marker, not a list. (occur-revert-arguments): Renamed from occur-revert-properties. All uses changed. diff -r 66535b19af6b -r 4a1d60fe2473 lisp/replace.el --- a/lisp/replace.el Sun Apr 28 13:38:13 2002 +0000 +++ b/lisp/replace.el Sun Apr 28 17:46:19 2002 +0000 @@ -27,9 +27,6 @@ ;;; Code: -(eval-when-compile - (require 'cl)) - (defcustom case-replace t "*Non-nil means `query-replace' should preserve case in replacements." :type 'boolean @@ -449,7 +446,9 @@ map) "Keymap for `occur-mode'.") -(defvar occur-revert-properties nil) +(defvar occur-revert-arguments nil + "Arguments to pass to `occur-1' to revert an Occur mode buffer. +See `occur-revert-function'.") (put 'occur-mode 'mode-class 'special) (defun occur-mode () @@ -470,65 +469,63 @@ (font-lock-unfontify-region-function . occur-unfontify-region-function))) (setq revert-buffer-function 'occur-revert-function) (set (make-local-variable 'revert-buffer-function) 'occur-revert-function) - (make-local-variable 'occur-revert-properties) + (make-local-variable 'occur-revert-arguments) (run-hooks 'occur-mode-hook)) (defun occur-revert-function (ignore1 ignore2) - "Handle `revert-buffer' for *Occur* buffers." - (apply 'occur-1 occur-revert-properties)) + "Handle `revert-buffer' for Occur mode buffers." + (apply 'occur-1 occur-revert-arguments)) (defun occur-mode-mouse-goto (event) "In Occur mode, go to the occurrence whose line you click on." (interactive "e") - (let ((buffer nil) - (pos nil)) + (let (pos) (save-excursion (set-buffer (window-buffer (posn-window (event-end event)))) (save-excursion (goto-char (posn-point (event-end event))) - (let ((props (occur-mode-find-occurrence))) - (setq buffer (car props)) - (setq pos (cdr props))))) - (pop-to-buffer buffer) - (goto-char (marker-position pos)))) + (setq pos (occur-mode-find-occurrence)))) + (pop-to-buffer (marker-buffer pos)) + (goto-char pos))) (defun occur-mode-find-occurrence () - (let ((props (get-text-property (point) 'occur-target))) - (unless props + (let ((pos (get-text-property (point) 'occur-target))) + (unless pos (error "No occurrence on this line")) - (unless (buffer-live-p (car props)) - (error "Buffer in which occurrence was found is deleted")) - props)) + (unless (buffer-live-p (marker-buffer pos)) + (error "Buffer for this occurrence was killed")) + pos)) (defun occur-mode-goto-occurrence () "Go to the occurrence the current line describes." (interactive) - (let ((target (occur-mode-find-occurrence))) - (pop-to-buffer (car target)) - (goto-char (marker-position (cdr target))))) + (let ((pos (occur-mode-find-occurrence))) + (pop-to-buffer (marker-buffer pos)) + (goto-char pos))) (defun occur-mode-goto-occurrence-other-window () "Go to the occurrence the current line describes, in another window." (interactive) - (let ((target (occur-mode-find-occurrence))) - (switch-to-buffer-other-window (car target)) - (goto-char (marker-position (cdr target))))) + (let ((pos (occur-mode-find-occurrence))) + (switch-to-buffer-other-window (marker-buffer pos)) + (goto-char pos))) (defun occur-mode-display-occurrence () "Display in another window the occurrence the current line describes." (interactive) - (let ((target (occur-mode-find-occurrence)) + (let ((pos (occur-mode-find-occurrence)) + window + ;; Bind these to ensure `display-buffer' puts it in another window. same-window-buffer-names - same-window-regexps - window) - (setq window (display-buffer (car target))) + same-window-regexps) + (setq window (display-buffer (marker-buffer pos))) ;; This is the way to set point in the proper window. (save-selected-window (select-window window) - (goto-char (marker-position (cdr target)))))) + (goto-char pos)))) (defun occur-next (&optional n) - "Move to the Nth (default 1) next match in the *Occur* buffer." + "Move to the Nth (default 1) next match in an Occur mode buffer." (interactive "p") (if (not n) (setq n 1)) (let ((r)) @@ -542,7 +539,7 @@ (setq n (1- n))))) (defun occur-prev (&optional n) - "Move to the Nth (default 1) previous match in the *Occur* buffer." + "Move to the Nth (default 1) previous match in an Occur mode buffer." (interactive "p") (if (not n) (setq n 1)) (let ((r)) @@ -587,9 +584,7 @@ (if forwardp (eobp) (bobp)))) - (if forwardp - (decf count) - (incf count)) + (setq count (+ count (if forwardp 1 -1))) (push (funcall (if no-props #'buffer-substring-no-properties @@ -701,125 +696,121 @@ (if (> count 0) (display-buffer occur-buf) (kill-buffer occur-buf))) - (setq occur-revert-properties (list regexp nlines bufs) + (setq occur-revert-arguments (list regexp nlines bufs) buffer-read-only t)))) -;; Most of these are macros becuase if we used `flet', it wouldn't -;; create a closure, so things would blow up at run time. Ugh. :( -(macrolet ((insert-get-point (obj) - `(progn - (insert ,obj) - (point))) - (add-prefix (lines) - `(mapcar - #'(lambda (line) - (concat " :" line "\n")) - ,lines))) - (defun occur-engine (regexp buffers out-buf nlines case-fold-search - title-face prefix-face match-face keep-props) - (with-current-buffer out-buf - (setq buffer-read-only nil) - (let ((globalcount 0)) - ;; Map over all the buffers - (dolist (buf buffers) - (when (buffer-live-p buf) - (let ((c 0) ;; count of matched lines - (l 1) ;; line count - (matchbeg 0) - (matchend 0) - (origpt nil) - (begpt nil) - (endpt nil) - (marker nil) - (curstring "") - (headerpt (with-current-buffer out-buf (point)))) +(defun occur-engine-add-prefix (lines) + (mapcar + #'(lambda (line) + (concat " :" line "\n")) + lines)) + +(defun occur-engine (regexp buffers out-buf nlines case-fold-search + title-face prefix-face match-face keep-props) + (with-current-buffer out-buf + (setq buffer-read-only nil) + (let ((globalcount 0)) + ;; Map over all the buffers + (dolist (buf buffers) + (when (buffer-live-p buf) + (let ((matches 0) ;; count of matched lines + (lines 1) ;; line count + (matchbeg 0) + (matchend 0) + (origpt nil) + (begpt nil) + (endpt nil) + (marker nil) + (curstring "") + (headerpt (with-current-buffer out-buf (point)))) + (save-excursion + (set-buffer buf) (save-excursion - (set-buffer buf) - (save-excursion - (goto-char (point-min)) ;; begin searching in the buffer - (while (not (eobp)) - (setq origpt (point)) - (when (setq endpt (re-search-forward regexp nil t)) - (incf c) ;; increment match count - (incf globalcount) - (setq matchbeg (match-beginning 0) - matchend (match-end 0)) - (setq begpt (save-excursion - (goto-char matchbeg) - (line-beginning-position))) - (incf l (1- (count-lines origpt endpt))) - (setq marker (make-marker)) - (set-marker marker matchbeg) - (setq curstring (buffer-substring begpt - (line-end-position))) - ;; Depropertize the string, and maybe - ;; highlight the matches - (let ((len (length curstring)) - (start 0)) - (unless keep-props - (set-text-properties 0 len nil curstring)) - (while (and (< start len) - (string-match regexp curstring start)) - (add-text-properties (match-beginning 0) - (match-end 0) - (append - '(occur-match t) - (when match-face - `(face ,match-face))) - curstring) - (setq start (match-end 0)))) - ;; Generate the string to insert for this match - (let* ((out-line - (concat - (apply #'propertize (format "%6d:" l) - (append - (when prefix-face - `(face prefix-face)) - '(occur-prefix t))) - curstring - "\n")) - (data - (if (= nlines 0) - ;; The simple display style - out-line - ;; The complex multi-line display - ;; style. Generate a list of lines, - ;; concatenate them all together. - (apply #'concat - (nconc - (add-prefix (nreverse (cdr (occur-accumulate-lines (- (1+ nlines)) t)))) - (list out-line) - (add-prefix (cdr (occur-accumulate-lines (1+ nlines) t)))))))) - ;; Actually insert the match display data - (with-current-buffer out-buf - (let ((beg (point)) - (end (insert-get-point data))) - (unless (= nlines 0) - (insert-get-point "-------\n")) - (add-text-properties - beg (1- end) - `(occur-target ,(cons buf marker) - mouse-face highlight help-echo - "mouse-2: go to this occurrence"))))) - (goto-char endpt)) - (incf l) - ;; On to the next match... - (forward-line 1)))) - (when (not (zerop c)) ;; is the count zero? - (with-current-buffer out-buf - (goto-char headerpt) - (let ((beg (point)) - (end (insert-get-point - (format "%d lines matching \"%s\" in buffer: %s\n" - c regexp (buffer-name buf))))) - (add-text-properties beg end - (append - (when title-face - `(face ,title-face)) - `(occur-title ,buf)))) - (goto-char (point-min))))))) - ;; Return the number of matches - globalcount)))) + (goto-char (point-min)) ;; begin searching in the buffer + (while (not (eobp)) + (setq origpt (point)) + (when (setq endpt (re-search-forward regexp nil t)) + (setq matches (1+ matches)) ;; increment match count + (setq globalcount (1+ globalcount)) + (setq matchbeg (match-beginning 0) + matchend (match-end 0)) + (setq begpt (save-excursion + (goto-char matchbeg) + (line-beginning-position))) + (setq lines (+ lines (1- (count-lines origpt endpt)))) + (setq marker (make-marker)) + (set-marker marker matchbeg) + (setq curstring (buffer-substring begpt + (line-end-position))) + ;; Depropertize the string, and maybe + ;; highlight the matches + (let ((len (length curstring)) + (start 0)) + (unless keep-props + (set-text-properties 0 len nil curstring)) + (while (and (< start len) + (string-match regexp curstring start)) + (add-text-properties (match-beginning 0) + (match-end 0) + (append + '(occur-match t) + (when match-face + `(face ,match-face))) + curstring) + (setq start (match-end 0)))) + ;; Generate the string to insert for this match + (let* ((out-line + (concat + (apply #'propertize (format "%6d:" lines) + (append + (when prefix-face + `(face prefix-face)) + '(occur-prefix t))) + curstring + "\n")) + (data + (if (= nlines 0) + ;; The simple display style + out-line + ;; The complex multi-line display + ;; style. Generate a list of lines, + ;; concatenate them all together. + (apply #'concat + (nconc + (occur-engine-add-prefix (nreverse (cdr (occur-accumulate-lines (- (1+ nlines)) t)))) + (list out-line) + (occur-engine-add-prefix (cdr (occur-accumulate-lines (1+ nlines) t)))))))) + ;; Actually insert the match display data + (with-current-buffer out-buf + (let ((beg (point)) + (end (progn (insert data) (point)))) + (unless (= nlines 0) + (insert "-------\n")) + (add-text-properties + beg (1- end) + `(occur-target ,marker + mouse-face highlight help-echo + "mouse-2: go to this occurrence"))))) + (goto-char endpt)) + (setq lines (1+ lines)) + ;; On to the next match... + (forward-line 1)))) + (when (not (zerop matches)) ;; is the count zero? + (with-current-buffer out-buf + (goto-char headerpt) + (let ((beg (point)) + end) + (insert (format "%d lines matching \"%s\" in buffer: %s\n" + matches regexp (buffer-name buf))) + (setq end (point)) + (add-text-properties beg end + (append + (when title-face + `(face ,title-face)) + `(occur-title ,buf)))) + (goto-char (point-min))))))) + ;; Return the number of matches + globalcount))) (defun occur-fontify-on-property (prop face beg end) (let ((prop-beg (or (and (get-text-property (point) prop) (point))