/[emacs]/emacs/lisp/ibuf-ext.el
ViewVC logotype

Diff of /emacs/lisp/ibuf-ext.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.13 by walters, Sun Apr 14 05:48:09 2002 UTC revision 1.14 by walters, Tue Apr 23 20:35:37 2002 UTC
# Line 46  Line 46 
46        (setq alist (delete entry alist)))        (setq alist (delete entry alist)))
47      alist))      alist))
48    
 (defun ibuffer-depropertize-string (str &optional nocopy)  
   "Return a copy of STR with text properties removed.  
 If optional argument NOCOPY is non-nil, actually modify the string directly."  
   (let ((str (if nocopy  
                  str  
                (copy-sequence str))))  
     (set-text-properties 0 (length str) nil str)  
     str))  
   
49  (defcustom ibuffer-never-show-predicates nil  (defcustom ibuffer-never-show-predicates nil
50    "A list of predicates (a regexp or function) for buffers not to display.    "A list of predicates (a regexp or function) for buffers not to display.
51  If a regexp, then it will be matched against the buffer's name.  If a regexp, then it will be matched against the buffer's name.
# Line 86  Do not set this variable directly!  Use Line 77  Do not set this variable directly!  Use
77    
78  (defvar ibuffer-auto-buffers-changed nil)  (defvar ibuffer-auto-buffers-changed nil)
79    
 (defcustom ibuffer-occur-match-face 'font-lock-warning-face  
   "Face used for displaying matched strings for `ibuffer-do-occur'."  
   :type 'face  
   :group 'ibuffer)  
   
80  (defcustom ibuffer-saved-filters '(("gnus"  (defcustom ibuffer-saved-filters '(("gnus"
81                                      ((or (mode . message-mode)                                      ((or (mode . message-mode)
82                                           (mode . mail-mode)                                           (mode . mail-mode)
# Line 1060  You can then feed the file name(s) to ot Line 1046  You can then feed the file name(s) to ot
1046         (with-current-buffer buf         (with-current-buffer buf
1047           (eq major-mode 'dired-mode)))))           (eq major-mode 'dired-mode)))))
1048    
 ;;; An implementation of multi-buffer `occur'  
   
 (defvar ibuffer-occur-props nil)  
   
 (define-derived-mode ibuffer-occur-mode occur-mode "Ibuffer-Occur"  
   "A special form of Occur mode for multiple buffers.  
 Note this major mode is not meant for interactive use!  
 See also `occur-mode'."  
   (define-key ibuffer-occur-mode-map (kbd "n") 'forward-line)  
   (define-key ibuffer-occur-mode-map (kbd "q") 'bury-buffer)  
   (define-key ibuffer-occur-mode-map (kbd "p") 'previous-line)  
   (define-key ibuffer-occur-mode-map (kbd "RET") 'ibuffer-occur-display-occurence)  
   (define-key ibuffer-occur-mode-map (kbd "f") 'ibuffer-occur-goto-occurence)  
   (define-key ibuffer-occur-mode-map [(mouse-2)] 'ibuffer-occur-mouse-display-occurence)  
   (set (make-local-variable 'revert-buffer-function)  
        #'ibuffer-occur-revert-buffer-function)  
   (set (make-local-variable 'ibuffer-occur-props) nil)  
   (setq buffer-read-only nil)  
   (erase-buffer)  
   (setq buffer-read-only t)  
   (message (concat  
             "Use RET "  
             (if (or (and (< 21 emacs-major-version)  
                          window-system)  
                     (featurep 'mouse))  
                "or mouse-2 ")  
             "to display an occurence.")))  
   
 (defun ibuffer-occur-mouse-display-occurence (e)  
   "Display occurence on this line in another window."  
   (interactive "e")  
   (let* ((occurbuf (save-window-excursion (mouse-select-window e)  
                                           (selected-window)))  
          (target (with-current-buffer occurbuf  
                    (get-text-property (save-excursion  
                                         (mouse-set-point e)  
                                         (point))  
                                       'ibuffer-occur-target))))  
     (unless target  
       (error "No occurence on this line"))  
     (let ((buf (car target))  
           (line (cdr target)))  
       (switch-to-buffer occurbuf)  
       (delete-other-windows)  
       (pop-to-buffer buf)  
       (goto-line line))))  
   
 (defun ibuffer-occur-goto-occurence ()  
   "Switch to the buffer which has the occurence on this line."  
   (interactive)  
   (ibuffer-occur-display-occurence t))  
   
 (defun ibuffer-occur-display-occurence (&optional goto)  
   "Display occurence on this line in another window."  
   (interactive "P")  
   (let ((target (get-text-property (point) 'ibuffer-occur-target)))  
     (unless target  
       (error "No occurence on this line"))  
     (let ((buf (car target))  
           (line (cdr target)))  
       (delete-other-windows)  
       (if goto  
           (switch-to-buffer buf)  
         (pop-to-buffer buf))  
       (goto-line line))))  
   
1049  ;;;###autoload  ;;;###autoload
1050  (defun ibuffer-do-occur (regexp &optional nlines)  (defun ibuffer-do-occur (regexp &optional nlines)
1051    "View lines which match REGEXP in all marked buffers.    "View lines which match REGEXP in all marked buffers.
# Line 1157  defaults to one." Line 1077  defaults to one."
1077      (ibuffer-map-marked-lines      (ibuffer-map-marked-lines
1078       #'(lambda (buf mark)       #'(lambda (buf mark)
1079           (push buf ibuffer-do-occur-bufs)))           (push buf ibuffer-do-occur-bufs)))
1080      (ibuffer-do-occur-1 regexp ibuffer-do-occur-bufs      (occur-1 regexp nlines ibuffer-do-occur-bufs)))
                         (get-buffer-create "*Ibuffer-occur*")  
                         nlines)))  
   
 (defun ibuffer-do-occur-1 (regexp buffers out-buf nlines)  
   (let ((count (ibuffer-occur-engine regexp buffers out-buf nlines)))  
     (if (> count 0)  
         (progn  
           (switch-to-buffer out-buf)  
           (setq buffer-read-only t)  
           (delete-other-windows)  
           (goto-char (point-min))  
           (message "Found %s matches in %s buffers" count (length buffers)))  
       (message "No matches found"))))  
   
   
 (defun ibuffer-occur-revert-buffer-function (ignore-auto noconfirm)  
   "Update the *Ibuffer occur* buffer."  
   (assert (eq major-mode 'ibuffer-occur-mode))  
   (ibuffer-do-occur-1 (car ibuffer-occur-props)  
                       (cadr ibuffer-occur-props)  
                       (current-buffer)  
                       (caddr ibuffer-occur-props)))  
   
 (defun ibuffer-occur-engine (regexp buffers out-buf nlines)  
   (macrolet ((insert-get-point  
               (&rest args)  
               `(progn  
                  (insert ,@args)  
                  (point)))  
              (maybe-put-overlay  
               (over prop value)  
               `(when (ibuffer-use-fontification)  
                  (overlay-put ,over ,prop ,value)))  
              (maybe-ibuffer-propertize  
               (obj &rest args)  
               (let ((objsym (gensym "--maybe-ibuffer-propertize-")))  
                 `(let ((,objsym ,obj))  
                    (if (ibuffer-use-fontification)  
                        (propertize ,objsym ,@args)  
                      ,objsym)))))  
     (with-current-buffer out-buf  
       (ibuffer-occur-mode)  
       (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  
                   (headerpt (with-current-buffer out-buf (point))))  
               (save-excursion  
                 (set-buffer buf)  
                 (save-excursion  
                   (goto-char (point-min)) ;; begin searching in the buffer  
                   (while (not (eobp))  
                     ;; The line we're matching against  
                     (let ((curline (buffer-substring  
                                     (line-beginning-position)  
                                     (line-end-position))))  
                       (when (string-match regexp curline)  
                         (incf c) ;; increment match count  
                         (incf globalcount)  
                         ;; Depropertize the string, and maybe highlight the matches  
                         (setq curline  
                               (progn  
                                 (ibuffer-depropertize-string curline t)  
                                 (when (ibuffer-use-fontification)  
                                   (let ((len (length curline))  
                                         (start 0))  
                                     (while (and (< start len)  
                                                 (string-match regexp curline start))  
                                       (put-text-property (match-beginning 0)  
                                                          (match-end 0)  
                                                          'face ibuffer-occur-match-face  
                                                          curline)  
                                       (setq start (match-end 0)))))  
                                 curline))  
                         ;; Generate the string to insert for this match  
                         (let ((data  
                                (if (= nlines 1)  
                                    ;; The simple display style  
                                    (concat (maybe-ibuffer-propertize  
                                             (format "%-6d:" l)  
                                             'face 'bold)  
                                            curline  
                                            "\n")  
                                  ;; The complex multi-line display style  
                                  (let ((prevlines (nreverse  
                                                    (ibuffer-accumulate-lines (- nlines))))  
                                        (nextlines (ibuffer-accumulate-lines nlines))  
                                        ;; The lack of `flet' seriously sucks.  
                                        (fun #'(lambda (lines)  
                                                 (mapcar  
                                                  #'(lambda (line)  
                                                      (concat "      :" line "\n"))  
                                                  lines))))  
                                    (setq prevlines (funcall fun prevlines))  
                                    (setq nextlines (funcall fun nextlines))  
                                    ;; Yes, I am trying to win the award for the  
                                    ;; most consing.  
                                    (apply #'concat  
                                           (nconc  
                                            prevlines  
                                            (list  
                                             (concat  
                                              (maybe-ibuffer-propertize  
                                               (format "%-6d" l)  
                                               'face 'bold)  
                                              ":"  
                                              curline  
                                              "\n"))  
                                            nextlines))))))  
                           ;; Actually insert the match display data  
                           (with-current-buffer out-buf  
                             (let ((beg (point))  
                                   (end (insert-get-point  
                                         data)))  
                               (unless (= nlines 1)  
                                 (insert "-------\n"))  
                               (put-text-property  
                                beg (1- end) 'ibuffer-occur-target (cons buf l))  
                               (put-text-property  
                                beg (1- end) 'mouse-face 'highlight))))))  
                     ;; On to the next line...  
                     (incf l)  
                     (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)))))  
                     (let ((o (make-overlay beg end)))  
                       (maybe-put-overlay o 'face 'underline)))  
                   (goto-char (point-max)))))))  
         (setq ibuffer-occur-props (list regexp buffers nlines))  
         ;; Return the number of matches  
         globalcount))))  
1081    
1082  (provide 'ibuf-ext)  (provide 'ibuf-ext)
1083    

Legend:
Removed from v.1.13  
changed lines
  Added in v.1.14

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26