/[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.23 by walters, Mon May 13 05:59:48 2002 UTC revision 1.23.2.1 by miles, Fri Apr 4 06:20:06 2003 UTC
# Line 1  Line 1 
1  ;;; ibuf-ext.el --- extensions for ibuffer  ;;; ibuf-ext.el --- extensions for ibuffer
2    
3  ;; Copyright (C) 2000, 2001, 2002 Free Software Foundation, Inc.  ;; Copyright (C) 2000, 2001, 2002 Free Software Foundation, Inc.
4    
5  ;; Author: Colin Walters <walters@verbum.org>  ;; Author: Colin Walters <walters@verbum.org>
6    ;; Maintainer: John Paul Wallington <jpw@gnu.org>
7  ;; Created: 2 Dec 2001  ;; Created: 2 Dec 2001
8  ;; Keywords: buffer, convenience  ;; Keywords: buffer, convenience
9    
# Line 46  Line 47 
47        (setq alist (delete entry alist)))        (setq alist (delete entry alist)))
48      alist))      alist))
49    
50    ;; borrowed from Gnus
51    (defun ibuffer-remove-duplicates (list)
52      "Return a copy of LIST with duplicate elements removed."
53      (let ((new nil)
54            (tail list))
55        (while tail
56          (or (member (car tail) new)
57              (setq new (cons (car tail) new)))
58          (setq tail (cdr tail)))
59        (nreverse new)))
60    
61  (defun ibuffer-split-list (ibuffer-split-list-fn ibuffer-split-list-elts)  (defun ibuffer-split-list (ibuffer-split-list-fn ibuffer-split-list-elts)
62    (let ((hip-crowd nil)    (let ((hip-crowd nil)
63          (lamers nil))          (lamers nil))
64      (dolist (ibuffer-split-list-elt ibuffer-split-list-elts)      (dolist (ibuffer-split-list-elt ibuffer-split-list-elts)
65        (if (funcall ibuffer-split-list-fn ibuffer-split-list-elt)        (if (funcall ibuffer-split-list-fn ibuffer-split-list-elt)
66            (push ibuffer-split-list-elt hip-crowd)            (push ibuffer-split-list-elt hip-crowd)
67          (push ibuffer-split-list-elt lamers)))          (push ibuffer-split-list-elt lamers)))
68      ;; Too bad Emacs Lisp doesn't have multiple values.      ;; Too bad Emacs Lisp doesn't have multiple values.
# Line 76  regardless of any active filters in this Line 88  regardless of any active filters in this
88    
89  (defvar ibuffer-tmp-hide-regexps nil  (defvar ibuffer-tmp-hide-regexps nil
90    "A list of regexps which should match buffer names to not show.")    "A list of regexps which should match buffer names to not show.")
91      
92  (defvar ibuffer-tmp-show-regexps nil  (defvar ibuffer-tmp-show-regexps nil
93    "A list of regexps which should match buffer names to always show.")    "A list of regexps which should match buffer names to always show.")
94    
# Line 91  Do not set this variable directly!  Use Line 103  Do not set this variable directly!  Use
103                                      ((or (mode . message-mode)                                      ((or (mode . message-mode)
104                                           (mode . mail-mode)                                           (mode . mail-mode)
105                                           (mode . gnus-group-mode)                                           (mode . gnus-group-mode)
106                                           (mode . gnus-summary-mode)                                           (mode . gnus-summary-mode)
107                                           (mode . gnus-article-mode))))                                           (mode . gnus-article-mode))))
108                                     ("programming"                                     ("programming"
109                                      ((or (mode . emacs-lisp-mode)                                      ((or (mode . emacs-lisp-mode)
110                                           (mode . cperl-mode)                                           (mode . cperl-mode)
111                                           (mode . c-mode)                                           (mode . c-mode)
112                                           (mode . java-mode)                                           (mode . java-mode)
113                                           (mode . idl-mode)                                           (mode . idl-mode)
114                                           (mode . lisp-mode)))))                                           (mode . lisp-mode)))))
115                                      
116    "An alist of filter qualifiers to switch between.    "An alist of filter qualifiers to switch between.
117    
118  This variable should look like ((\"STRING\" QUALIFIERS)  This variable should look like ((\"STRING\" QUALIFIERS)
# Line 144  to this variable." Line 156  to this variable."
156    :group 'ibuffer)    :group 'ibuffer)
157    
158  (defvar ibuffer-cached-filter-formats nil)  (defvar ibuffer-cached-filter-formats nil)
159  (defvar ibuffer-compiled-filter-formats nil)    (defvar ibuffer-compiled-filter-formats nil)
160    
161  (defvar ibuffer-filter-groups nil  (defvar ibuffer-filter-groups nil
162    "A list like ((\"NAME\" ((SYMBOL . QUALIFIER) ...) ...) which groups buffers.    "A list like ((\"NAME\" ((SYMBOL . QUALIFIER) ...) ...) which groups buffers.
# Line 158  The QUALIFIER should be the same as QUAL Line 170  The QUALIFIER should be the same as QUAL
170    :group 'ibuffer)    :group 'ibuffer)
171    
172  (defcustom ibuffer-saved-filter-groups nil  (defcustom ibuffer-saved-filter-groups nil
                                     
173    "An alist of filtering groups to switch between.    "An alist of filtering groups to switch between.
174    
175  This variable should look like ((\"STRING\" QUALIFIERS)  This variable should look like ((\"STRING\" QUALIFIERS)
# Line 189  functions `ibuffer-switch-to-saved-filte Line 200  functions `ibuffer-switch-to-saved-filte
200  (defcustom ibuffer-save-with-custom t  (defcustom ibuffer-save-with-custom t
201    "If non-nil, then use Custom to save interactively changed variables.    "If non-nil, then use Custom to save interactively changed variables.
202  Currently, this only applies to `ibuffer-saved-filters' and  Currently, this only applies to `ibuffer-saved-filters' and
203  `ibuffer-saved-filter-groups."  `ibuffer-saved-filter-groups'."
204    :type 'boolean    :type 'boolean
205    :group 'ibuffer)    :group 'ibuffer)
206    
# Line 204  Currently, this only applies to `ibuffer Line 215  Currently, this only applies to `ibuffer
215              (not              (not
216               (ibuffer-buf-matches-predicates buf ibuffer-maybe-show-predicates)))               (ibuffer-buf-matches-predicates buf ibuffer-maybe-show-predicates)))
217          (or ibuffer-view-ibuffer          (or ibuffer-view-ibuffer
218              (and ibuffer-buf              (and ibuffer-buf
219                   (not (eq ibuffer-buf buf))))                   (not (eq ibuffer-buf buf))))
220          (or          (or
221           (ibuffer-included-in-filters-p buf ibuffer-filtering-qualifiers)           (ibuffer-included-in-filters-p buf ibuffer-filtering-qualifiers)
# Line 256  With numeric ARG, enable auto-update if Line 267  With numeric ARG, enable auto-update if
267      (if (assq 'mode ibuffer-filtering-qualifiers)      (if (assq 'mode ibuffer-filtering-qualifiers)
268          (setq ibuffer-filtering-qualifiers          (setq ibuffer-filtering-qualifiers
269                (ibuffer-delete-alist 'mode ibuffer-filtering-qualifiers))                (ibuffer-delete-alist 'mode ibuffer-filtering-qualifiers))
270        (ibuffer-push-filter (cons 'mode        (ibuffer-push-filter (cons 'mode
271                                  (with-current-buffer buf                                  (with-current-buffer buf
272                                    major-mode)))))                                    major-mode)))))
273    (ibuffer-update nil t))    (ibuffer-update nil t))
# Line 272  With numeric ARG, enable auto-update if Line 283  With numeric ARG, enable auto-update if
283  ;;;###autoload  ;;;###autoload
284  (defun ibuffer-toggle-filter-group ()  (defun ibuffer-toggle-filter-group ()
285    "Toggle the display status of the filter group on this line."    "Toggle the display status of the filter group on this line."
286    (interactive)    (interactive)
287    (ibuffer-toggle-filter-group-1 (point)))    (ibuffer-toggle-filter-group-1 (point)))
288    
289  (defun ibuffer-toggle-filter-group-1 (posn)      (defun ibuffer-toggle-filter-group-1 (posn)
290    (let ((name (get-text-property posn 'ibuffer-filter-group-name)))    (let ((name (get-text-property posn 'ibuffer-filter-group-name)))
291      (unless (stringp name)      (unless (stringp name)
292        (error "No filtering group name present"))        (error "No filtering group name present"))
# Line 544  To evaluate a form without viewing the b Line 555  To evaluate a form without viewing the b
555          (mapcar (lambda (mode)          (mapcar (lambda (mode)
556                    (cons (format "%s" mode) `((mode . ,mode))))                    (cons (format "%s" mode) `((mode . ,mode))))
557                  (let ((modes                  (let ((modes
558                         (delete-duplicates                         (ibuffer-remove-duplicates
559                          (mapcar (lambda (buf) (with-current-buffer buf major-mode))                          (mapcar (lambda (buf) (with-current-buffer buf major-mode))
560                                  (buffer-list)))))                                  (buffer-list)))))
561                    (if ibuffer-view-ibuffer                    (if ibuffer-view-ibuffer
# Line 645  See also `ibuffer-kill-filter-group'." Line 656  See also `ibuffer-kill-filter-group'."
656                 #'kill-line arg)))                 #'kill-line arg)))
657    
658  (defun ibuffer-insert-filter-group-before (newgroup group)  (defun ibuffer-insert-filter-group-before (newgroup group)
659    (let ((pos (or (position group (mapcar #'car ibuffer-filter-groups)    (let* ((found nil)
660                             :test #'equal)           (pos (let ((groups (mapcar #'car ibuffer-filter-groups))
661                   (length ibuffer-filter-groups))))                      (res 0))
662      (cond ((<= pos 0)                  (while groups
663             (push newgroup ibuffer-filter-groups))                    (if (equal (car groups) group)
664            ((= pos (length ibuffer-filter-groups))                        (setq found t
665                                groups nil)
666                        (incf res)
667                        (setq groups (cdr groups))))
668                    res)))
669        (cond ((not found)
670             (setq ibuffer-filter-groups (nconc ibuffer-filter-groups (list newgroup))))             (setq ibuffer-filter-groups (nconc ibuffer-filter-groups (list newgroup))))
671              ((zerop pos)
672               (push newgroup ibuffer-filter-groups))
673            (t            (t
674             (let ((cell (nthcdr pos ibuffer-filter-groups)))             (let ((cell (nthcdr pos ibuffer-filter-groups)))
675               (setf (cdr cell) (cons (car cell) (cdr cell)))               (setf (cdr cell) (cons (car cell) (cdr cell)))
# Line 669  See also `ibuffer-kill-filter-group'." Line 687  See also `ibuffer-kill-filter-group'."
687  ;;;###autoload  ;;;###autoload
688  (defun ibuffer-yank-filter-group (name)  (defun ibuffer-yank-filter-group (name)
689    "Yank the last killed filter group before group named NAME."    "Yank the last killed filter group before group named NAME."
690    (interactive (list (progn    (interactive (list (ibuffer-read-filter-group-name
691                         (unless ibuffer-filter-group-kill-ring                          "Yank filter group before group: ")))
692                           (error "ibuffer-filter-group-kill-ring is empty"))    (unless ibuffer-filter-group-kill-ring
693                         (ibuffer-read-filter-group-name      (error "The Ibuffer filter group kill-ring is empty"))
                         "Yank filter group before group: "))))  
694    (save-excursion    (save-excursion
695      (ibuffer-forward-line 0)      (ibuffer-forward-line 0)
696      (ibuffer-insert-filter-group-before (pop ibuffer-filter-group-kill-ring)      (ibuffer-insert-filter-group-before (pop ibuffer-filter-group-kill-ring)
# Line 681  See also `ibuffer-kill-filter-group'." Line 698  See also `ibuffer-kill-filter-group'."
698    (ibuffer-update nil t))    (ibuffer-update nil t))
699    
700  ;;;###autoload  ;;;###autoload
701  (defun ibuffer-save-filter-groups (name groups)  (defun ibuffer-save-filter-groups (name groups)
702    "Save all active filter groups GROUPS as NAME.    "Save all active filter groups GROUPS as NAME.
703  They are added to `ibuffer-saved-filter-groups'.  Interactively,  They are added to `ibuffer-saved-filter-groups'.  Interactively,
704  prompt for NAME, and use the current filters."  prompt for NAME, and use the current filters."
# Line 757  be a complex filter like (OR [name: foo] Line 774  be a complex filter like (OR [name: foo]
774  turned into two separate filters [name: foo] and [mode: bar-mode]."  turned into two separate filters [name: foo] and [mode: bar-mode]."
775    (interactive)    (interactive)
776    (when (null ibuffer-filtering-qualifiers)    (when (null ibuffer-filtering-qualifiers)
777      (error "No filters in effect"))        (error "No filters in effect"))
778    (let ((lim (pop ibuffer-filtering-qualifiers)))    (let ((lim (pop ibuffer-filtering-qualifiers)))
779      (case (car lim)      (case (car lim)
780        (or        (or
# Line 903  of replacing the current filters." Line 920  of replacing the current filters."
920      (concat "Filter: " (mapconcat #'ibuffer-format-qualifier      (concat "Filter: " (mapconcat #'ibuffer-format-qualifier
921                                    (cdr (assq filter ibuffer-filter-groups))                                    (cdr (assq filter ibuffer-filter-groups))
922                                    " ") "\n")))                                    " ") "\n")))
923      
924  (defun ibuffer-format-qualifier (qualifier)  (defun ibuffer-format-qualifier (qualifier)
925    (if (eq (car-safe qualifier) 'not)    (if (eq (car-safe qualifier) 'not)
926        (concat " [NOT" (ibuffer-format-qualifier-1 (cdr qualifier)) "]")        (concat " [NOT" (ibuffer-format-qualifier-1 (cdr qualifier)) "]")
# Line 921  of replacing the current filters." Line 938  of replacing the current filters."
938         (unless qualifier         (unless qualifier
939           (error "Ibuffer: bad qualifier %s" qualifier))           (error "Ibuffer: bad qualifier %s" qualifier))
940         (concat " [" (cadr type) ": " (format "%s]" (cdr qualifier)))))))         (concat " [" (cadr type) ": " (format "%s]" (cdr qualifier)))))))
941      
942    
943    (defun ibuffer-list-buffer-modes ()
944      "Create an alist of buffer modes currently in use.
945    The list returned will be of the form (\"MODE-NAME\" . MODE-SYMBOL)."
946      (let ((bufs (buffer-list))
947            (modes)
948            (this-mode))
949        (while bufs
950          (setq this-mode
951                (with-current-buffer
952                    (car bufs)
953                  major-mode)
954                bufs (cdr bufs))
955          (add-to-list
956           'modes
957           `(,(symbol-name this-mode) .
958             ,this-mode)))
959        modes))
960    
961    
962  ;;; Extra operation definitions  ;;; Extra operation definitions
963    
964  ;;;###autoload (autoload 'ibuffer-filter-by-mode "ibuf-ext.el")  ;;;###autoload (autoload 'ibuffer-filter-by-mode "ibuf-ext.el")
965  (define-ibuffer-filter mode  (define-ibuffer-filter mode
966    "Toggle current view to buffers with major mode QUALIFIER."    "Toggle current view to buffers with major mode QUALIFIER."
967    (:description "major mode"    (:description "major mode"
968     :reader     :reader
# Line 942  of replacing the current filters." Line 979  of replacing the current filters."
979                           "")))))                           "")))))
980    (eq qualifier (with-current-buffer buf major-mode)))    (eq qualifier (with-current-buffer buf major-mode)))
981    
982    ;;;###autoload (autoload 'ibuffer-filter-by-used-mode "ibuf-ext.el")
983    (define-ibuffer-filter used-mode
984      "Toggle current view to buffers with major mode QUALIFIER.
985    Called interactively, this function allows selection of modes
986    currently used by buffers."
987      (:description "major mode in use"
988                    :reader
989                    (intern
990                     (completing-read "Filter by major mode: "
991                                      (ibuffer-list-buffer-modes)
992                                      nil
993                                      t
994                                      (let ((buf (ibuffer-current-buffer)))
995                                        (if (and buf (buffer-live-p buf))
996                                            (with-current-buffer buf
997                                              (symbol-name major-mode))
998                                          "")))))
999      (eq qualifier (with-current-buffer buf major-mode)))
1000    
1001  ;;;###autoload (autoload 'ibuffer-filter-by-name "ibuf-ext.el")  ;;;###autoload (autoload 'ibuffer-filter-by-name "ibuf-ext.el")
1002  (define-ibuffer-filter name  (define-ibuffer-filter name
1003    "Toggle current view to buffers with name matching QUALIFIER."    "Toggle current view to buffers with name matching QUALIFIER."
1004    (:description "buffer name"    (:description "buffer name"
1005     :reader (read-from-minibuffer "Filter by name (regexp): "))     :reader (read-from-minibuffer "Filter by name (regexp): "))
# Line 958  of replacing the current filters." Line 1014  of replacing the current filters."
1014      (string-match qualifier it)))      (string-match qualifier it)))
1015    
1016  ;;;###autoload (autoload 'ibuffer-filter-by-size-gt  "ibuf-ext.el")  ;;;###autoload (autoload 'ibuffer-filter-by-size-gt  "ibuf-ext.el")
1017  (define-ibuffer-filter size-gt  (define-ibuffer-filter size-gt
1018    "Toggle current view to buffers with size greater than QUALIFIER."    "Toggle current view to buffers with size greater than QUALIFIER."
1019    (:description "size greater than"    (:description "size greater than"
1020     :reader     :reader
# Line 967  of replacing the current filters." Line 1023  of replacing the current filters."
1023       qualifier))       qualifier))
1024    
1025  ;;;###autoload (autoload 'ibuffer-filter-by-size-lt  "ibuf-ext.el")  ;;;###autoload (autoload 'ibuffer-filter-by-size-lt  "ibuf-ext.el")
1026  (define-ibuffer-filter size-lt  (define-ibuffer-filter size-lt
1027     "Toggle current view to buffers with size less than QUALIFIER."     "Toggle current view to buffers with size less than QUALIFIER."
1028    (:description "size less than"    (:description "size less than"
1029     :reader     :reader
# Line 1093  Ordering is lexicographic." Line 1149  Ordering is lexicographic."
1149  (defun ibuffer-add-to-tmp-hide (regexp)  (defun ibuffer-add-to-tmp-hide (regexp)
1150    "Add REGEXP to `ibuffer-tmp-hide-regexps'.    "Add REGEXP to `ibuffer-tmp-hide-regexps'.
1151  This means that buffers whose name matches REGEXP will not be shown  This means that buffers whose name matches REGEXP will not be shown
1152  for this ibuffer session."  for this Ibuffer session."
1153    (interactive    (interactive
1154     (list     (list
1155      (read-from-minibuffer "Never show buffers matching: "      (read-from-minibuffer "Never show buffers matching: "
# Line 1104  for this ibuffer session." Line 1160  for this ibuffer session."
1160  (defun ibuffer-add-to-tmp-show (regexp)  (defun ibuffer-add-to-tmp-show (regexp)
1161    "Add REGEXP to `ibuffer-tmp-show-regexps'.    "Add REGEXP to `ibuffer-tmp-show-regexps'.
1162  This means that buffers whose name matches REGEXP will always be shown  This means that buffers whose name matches REGEXP will always be shown
1163  for this ibuffer session."  for this Ibuffer session."
1164    (interactive    (interactive
1165     (list     (list
1166      (read-from-minibuffer "Always show buffers matching: "      (read-from-minibuffer "Always show buffers matching: "
# Line 1182  to move by.  The default is `ibuffer-mar Line 1238  to move by.  The default is `ibuffer-mar
1238    "View the differences between this buffer and its associated file.    "View the differences between this buffer and its associated file.
1239  This requires the external program \"diff\" to be in your `exec-path'."  This requires the external program \"diff\" to be in your `exec-path'."
1240    (interactive)    (interactive)
1241    (let* ((buf (ibuffer-current-buffer))    (let ((buf (ibuffer-current-buffer)))
          (buf-filename (with-current-buffer buf  
                          buffer-file-name)))  
1242      (unless (buffer-live-p buf)      (unless (buffer-live-p buf)
1243        (error "Buffer %s has been killed" buf))        (error "Buffer %s has been killed" buf))
1244      (unless buf-filename      (diff-buffer-with-file buf)))
       (error "Buffer %s has no associated file" buf))  
     (let ((diff-buf (get-buffer-create "*Ibuffer-diff*")))  
       (with-current-buffer diff-buf  
         (setq buffer-read-only nil)  
         (erase-buffer))  
       (let ((tempfile (make-temp-file "ibuffer-diff-")))  
         (unwind-protect  
             (progn  
               (with-current-buffer buf  
                 (write-region (point-min) (point-max) tempfile nil 'nomessage))  
               (if (zerop  
                    (apply #'call-process "diff" nil diff-buf nil  
                           (append  
                            (when (and (boundp 'ediff-custom-diff-options)  
                                       (stringp ediff-custom-diff-options))  
                              (list ediff-custom-diff-options))  
                            (list buf-filename tempfile))))  
                   (message "No differences found")  
                 (progn  
                   (with-current-buffer diff-buf  
                     (goto-char (point-min))  
                     (if (fboundp 'diff-mode)  
                         (diff-mode)  
                       (fundamental-mode)))  
                   (display-buffer diff-buf))))  
           (when (file-exists-p tempfile)  
             (delete-file tempfile)))))  
       nil))  
1245    
1246  ;;;###autoload  ;;;###autoload
1247  (defun ibuffer-copy-filename-as-kill (&optional arg)  (defun ibuffer-copy-filename-as-kill (&optional arg)
1248    "Copy filenames of marked buffers into the kill ring.    "Copy filenames of marked buffers into the kill ring.
1249    
1250  The names are separated by a space.  The names are separated by a space.
1251  If a buffer has no filename, it is ignored.  If a buffer has no filename, it is ignored.
 With a zero prefix arg, use the complete pathname of each marked file.  
   
 You can then feed the file name(s) to other commands with C-y.  
1252    
1253   [ This docstring shamelessly stolen from the  With no prefix arg, use the filename sans its directory of each marked file.
1254   `dired-copy-filename-as-kill' in \"dired-x\". ]"  With a zero prefix arg, use the complete filename of each marked file.
1255    ;; Add to docstring later:  With \\[universal-argument], use the filename of each marked file relative
1256    ;; With C-u, use the relative pathname of each marked file.  to `ibuffer-default-directory' iff non-nil, otherwise `default-directory'.
1257    (interactive "P")  
1258    (if (= (ibuffer-count-marked-lines) 0)  You can then feed the file name(s) to other commands with \\[yank]."
1259      (interactive "p")
1260      (if (zerop (ibuffer-count-marked-lines))
1261        (message "No buffers marked; use 'm' to mark a buffer")        (message "No buffers marked; use 'm' to mark a buffer")
1262      (let ((ibuffer-copy-filename-as-kill-result "")      (let ((ibuffer-copy-filename-as-kill-result "")
1263            (type (cond ((eql arg 0)            (type (cond ((zerop arg)
1264                         'full)                         'full)
1265                        ;; ((eql arg 4)                        ((= arg 4)
1266                        ;;  'relative)                         'relative)
1267                        (t                        (t
1268                         'name))))                         'name))))
1269        (ibuffer-map-marked-lines        (ibuffer-map-marked-lines
# Line 1249  You can then feed the file name(s) to ot Line 1275  You can then feed the file name(s) to ot
1275                                 (case type                                 (case type
1276                                   (full                                   (full
1277                                    name)                                    name)
1278                                     (relative
1279                                      (file-relative-name
1280                                       name (or ibuffer-default-directory
1281                                                default-directory)))
1282                                   (t                                   (t
1283                                    (file-name-nondirectory name)))                                    (file-name-nondirectory name)))
1284                               ""))                               ""))
1285                           " "))))                           " "))))
1286        (push ibuffer-copy-filename-as-kill-result kill-ring))))        (kill-new ibuffer-copy-filename-as-kill-result))))
1287    
1288  (defun ibuffer-mark-on-buffer (func &optional ibuffer-mark-on-buffer-mark group)  (defun ibuffer-mark-on-buffer (func &optional ibuffer-mark-on-buffer-mark group)
1289    (let ((count    (let ((count

Legend:
Removed from v.1.23  
changed lines
  Added in v.1.23.2.1

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