/[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.14 by walters, Tue Apr 23 20:35:37 2002 UTC revision 1.15 by walters, Wed Apr 24 23:27:02 2002 UTC
# Line 1  Line 1 
1  ;;; ibuf-ext.el --- extensions for ibuffer -*-byte-compile-dynamic: t;-*-  ;;; 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    
# Line 6  Line 6 
6  ;; Created: 2 Dec 2001  ;; Created: 2 Dec 2001
7  ;; Keywords: buffer, convenience  ;; Keywords: buffer, convenience
8    
9  ;; This file is not currently part of GNU Emacs.  ;; This file is part of GNU Emacs.
10    
11  ;; This program is free software; you can redistribute it and/or  ;; This program is free software; you can redistribute it and/or
12  ;; modify it under the terms of the GNU General Public License as  ;; modify it under the terms of the GNU General Public License as
# Line 46  Line 46 
46        (setq alist (delete entry alist)))        (setq alist (delete entry alist)))
47      alist))      alist))
48    
49    (defun ibuffer-split-list (ibuffer-split-list-fn ibuffer-split-list-elts)
50      (let ((hip-crowd nil)
51            (lamers nil))
52        (dolist (ibuffer-split-list-elt ibuffer-split-list-elts)
53          (if (funcall ibuffer-split-list-fn ibuffer-split-list-elt)
54              (push ibuffer-split-list-elt hip-crowd)
55            (push ibuffer-split-list-elt lamers)))
56        ;; Too bad Emacs Lisp doesn't have multiple values.
57        (list (nreverse hip-crowd) (nreverse lamers))))
58    
59  (defcustom ibuffer-never-show-predicates nil  (defcustom ibuffer-never-show-predicates nil
60    "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.
61  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 136  to this variable." Line 146  to this variable."
146  (defvar ibuffer-cached-filter-formats nil)  (defvar ibuffer-cached-filter-formats nil)
147  (defvar ibuffer-compiled-filter-formats nil)    (defvar ibuffer-compiled-filter-formats nil)  
148    
149    (defvar ibuffer-filtering-groups nil
150      "A list like ((\"NAME\" ((SYMBOL . QUALIFIER) ...) ...) which groups buffers.
151    See also `ibuffer-filtering-alist'.")
152    
153    (defvar ibuffer-hidden-filtering-groups nil
154      "A list of filtering groups which are currently hidden.")
155    
156  (defcustom ibuffer-old-time 72  (defcustom ibuffer-old-time 72
157    "The number of hours before a buffer is considered \"old\"."    "The number of hours before a buffer is considered \"old\"."
158    :type '(choice (const :tag "72 hours (3 days)" 72)    :type '(choice (const :tag "72 hours (3 days)" 72)
# Line 218  With numeric ARG, enable auto-update if Line 235  With numeric ARG, enable auto-update if
235                                    major-mode)))))                                    major-mode)))))
236    (ibuffer-update nil t))    (ibuffer-update nil t))
237    
238    ;;;###autoload
239    (defun ibuffer-mouse-toggle-filter-group (event)
240      "Toggle the display status of the filter group chosen with the mouse."
241      (interactive "e")
242      (ibuffer-toggle-filter-group-1 (save-excursion
243                                       (mouse-set-point event)
244                                       (point))))
245    
246    ;;;###autoload
247    (defun ibuffer-toggle-filter-group ()
248      "Toggle the display status of the filter group on this line."
249      (interactive)
250      (ibuffer-toggle-filter-group-1 (point)))
251    
252    (defun ibuffer-toggle-filter-group-1 (posn)    
253      (let ((name (get-text-property posn 'ibuffer-filter-group-name)))
254        (unless (stringp name)
255          (error "No filtering group name present"))
256        (if (member name ibuffer-hidden-filtering-groups)
257            (setq ibuffer-hidden-filtering-groups
258                  (delete name ibuffer-hidden-filtering-groups))
259          (push name ibuffer-hidden-filtering-groups))
260        (ibuffer-update nil t)))
261    
262    ;;;###autoload
263    (defun ibuffer-forward-filter-group (&optional count)
264      "Move point forwards by COUNT filtering groups."
265      (interactive "P")
266      (unless count
267        (setq count 1))
268      (when (> count 0)
269        (when (get-text-property (point) 'ibuffer-filter-group-name)
270          (goto-char (next-single-property-change
271                      (point) 'ibuffer-filter-group-name
272                      nil (point-max))))
273        (goto-char (next-single-property-change
274                    (point) 'ibuffer-filter-group-name
275                    nil (point-max)))
276        (ibuffer-forward-filter-group (1- count)))
277      (ibuffer-forward-line 0))
278    
279    ;;;###autoload
280    (defun ibuffer-backward-filter-group (&optional count)
281      "Move point backwards by COUNT filtering groups."
282      (interactive "P")
283      (unless count
284        (setq count 1))
285      (when (> count 0)
286        (when (get-text-property (point) 'ibuffer-filter-group-name)
287          (goto-char (previous-single-property-change
288                      (point) 'ibuffer-filter-group-name
289                      nil (point-min))))
290        (goto-char (previous-single-property-change
291                    (point) 'ibuffer-filter-group-name
292                    nil (point-min)))
293        (ibuffer-backward-filter-group (1- count)))
294      (when (= (point) (point-min))
295        (goto-char (point-max))
296        (ibuffer-backward-filter-group 1))
297      (ibuffer-forward-line 0))
298    
299    ;;;###autoload (autoload 'ibuffer-do-shell-command-pipe "ibuf-ext.el")
300  (define-ibuffer-op shell-command-pipe (command)  (define-ibuffer-op shell-command-pipe (command)
301    "Pipe the contents of each marked buffer to shell command COMMAND."    "Pipe the contents of each marked buffer to shell command COMMAND."
302    (:interactive "sPipe to shell command: "    (:interactive "sPipe to shell command: "
# Line 227  With numeric ARG, enable auto-update if Line 306  With numeric ARG, enable auto-update if
306     (point-min) (point-max) command     (point-min) (point-max) command
307     (get-buffer-create "* ibuffer-shell-output*")))     (get-buffer-create "* ibuffer-shell-output*")))
308    
309    ;;;###autoload (autoload 'ibuffer-do-shell-command-pipe-replace "ibuf-ext.el")
310  (define-ibuffer-op shell-command-pipe-replace (command)  (define-ibuffer-op shell-command-pipe-replace (command)
311    "Replace the contents of marked buffers with output of pipe to COMMAND."    "Replace the contents of marked buffers with output of pipe to COMMAND."
312    (:interactive "sPipe to shell command (replace): "    (:interactive "sPipe to shell command (replace): "
# Line 238  With numeric ARG, enable auto-update if Line 318  With numeric ARG, enable auto-update if
318      (shell-command-on-region (point-min) (point-max)      (shell-command-on-region (point-min) (point-max)
319                               command nil t)))                               command nil t)))
320    
321    ;;;###autoload (autoload 'ibuffer-do-shell-command-file "ibuf-ext.el")
322  (define-ibuffer-op shell-command-file (command)  (define-ibuffer-op shell-command-file (command)
323    "Run shell command COMMAND separately on files of marked buffers."    "Run shell command COMMAND separately on files of marked buffers."
324    (:interactive "sShell command on buffer's file: "    (:interactive "sShell command on buffer's file: "
# Line 249  With numeric ARG, enable auto-update if Line 330  With numeric ARG, enable auto-update if
330                                buffer-file-name                                buffer-file-name
331                              (make-temp-file                              (make-temp-file
332                               (substring (buffer-name) 0 (min 10 (length (buffer-name))))))))))                               (substring (buffer-name) 0 (min 10 (length (buffer-name))))))))))
333                              
334    ;;;###autoload (autoload 'ibuffer-do-eval "ibuf-ext.el")
335  (define-ibuffer-op eval (form)  (define-ibuffer-op eval (form)
336    "Evaluate FORM in each of the buffers.    "Evaluate FORM in each of the buffers.
337  Does not display the buffer during evaluation. See  Does not display the buffer during evaluation. See
# Line 259  Does not display the buffer during evalu Line 341  Does not display the buffer during evalu
341     :modifier-p :maybe)     :modifier-p :maybe)
342    (eval form))    (eval form))
343    
344    ;;;###autoload (autoload 'ibuffer-do-view-and-eval "ibuf-ext.el")
345  (define-ibuffer-op view-and-eval (form)  (define-ibuffer-op view-and-eval (form)
346    "Evaluate FORM while displaying each of the marked buffers.    "Evaluate FORM while displaying each of the marked buffers.
347  To evaluate a form without viewing the buffer, see `ibuffer-do-eval'."  To evaluate a form without viewing the buffer, see `ibuffer-do-eval'."
# Line 273  To evaluate a form without viewing the b Line 356  To evaluate a form without viewing the b
356            (eval form))            (eval form))
357        (switch-to-buffer ibuffer-buf))))        (switch-to-buffer ibuffer-buf))))
358    
359    ;;;###autoload (autoload 'ibuffer-do-rename-uniquely "ibuf-ext.el")
360  (define-ibuffer-op rename-uniquely ()  (define-ibuffer-op rename-uniquely ()
361    "Rename marked buffers as with `rename-uniquely'."    "Rename marked buffers as with `rename-uniquely'."
362    (:opstring "renamed"    (:opstring "renamed"
363     :modifier-p t)     :modifier-p t)
364    (rename-uniquely))    (rename-uniquely))
365    
366    ;;;###autoload (autoload 'ibuffer-do-revert "ibuf-ext.el")
367  (define-ibuffer-op revert ()  (define-ibuffer-op revert ()
368    "Revert marked buffers as with `revert-buffer'."    "Revert marked buffers as with `revert-buffer'."
369    (:dangerous t    (:dangerous t
# Line 287  To evaluate a form without viewing the b Line 372  To evaluate a form without viewing the b
372     :modifier-p :maybe)     :modifier-p :maybe)
373    (revert-buffer t t))    (revert-buffer t t))
374    
375    ;;;###autoload (autoload 'ibuffer-do-replace-regexp "ibuf-ext.el")
376  (define-ibuffer-op replace-regexp (from-str to-str)  (define-ibuffer-op replace-regexp (from-str to-str)
377    "Perform a `replace-regexp' in marked buffers."    "Perform a `replace-regexp' in marked buffers."
378    (:interactive    (:interactive
# Line 306  To evaluate a form without viewing the b Line 392  To evaluate a form without viewing the b
392            (replace-match to-str))))            (replace-match to-str))))
393      t))      t))
394    
395    ;;;###autoload (autoload 'ibuffer-do-query-replace "ibuf-ext.el")
396  (define-ibuffer-op query-replace (&rest args)  (define-ibuffer-op query-replace (&rest args)
397    "Perform a `query-replace' in marked buffers."    "Perform a `query-replace' in marked buffers."
398    (:interactive    (:interactive
# Line 321  To evaluate a form without viewing the b Line 408  To evaluate a form without viewing the b
408          (apply #'query-replace args)))          (apply #'query-replace args)))
409      t))      t))
410    
411    ;;;###autoload (autoload 'ibuffer-do-query-replace-regexp "ibuf-ext.el")
412  (define-ibuffer-op query-replace-regexp (&rest args)  (define-ibuffer-op query-replace-regexp (&rest args)
413    "Perform a `query-replace-regexp' in marked buffers."    "Perform a `query-replace-regexp' in marked buffers."
414    (:interactive    (:interactive
# Line 336  To evaluate a form without viewing the b Line 424  To evaluate a form without viewing the b
424          (apply #'query-replace-regexp args)))          (apply #'query-replace-regexp args)))
425      t))      t))
426    
427    ;;;###autoload (autoload 'ibuffer-do-print "ibuf-ext.el")
428  (define-ibuffer-op print ()  (define-ibuffer-op print ()
429    "Print marked buffers as with `print-buffer'."    "Print marked buffers as with `print-buffer'."
430    (:opstring "printed"    (:opstring "printed"
# Line 388  To evaluate a form without viewing the b Line 477  To evaluate a form without viewing the b
477                     buf                     buf
478                     (cdr filter))))))))))                     (cdr filter))))))))))
479    
480    (defun ibuffer-generate-filter-groups (bmarklist)
481      (let ((filtering-group-alist (append ibuffer-filtering-groups
482                                           (list (cons "Default" nil)))))
483    ;;     (dolist (hidden ibuffer-hidden-filtering-groups)
484    ;;       (setq filtering-group-alist (ibuffer-delete-alist
485    ;;                                 hidden filtering-group-alist)))
486        (let ((vec (make-vector (length filtering-group-alist) nil))
487              (i 0))
488          (dolist (filtergroup filtering-group-alist)
489            (let ((filterset (cdr filtergroup)))
490              (multiple-value-bind (hip-crowd lamers)
491                  (ibuffer-split-list (lambda (bufmark)
492                                        (ibuffer-included-in-filters-p (car bufmark)
493                                                                       filterset))
494                                      bmarklist)
495                (aset vec i hip-crowd)
496                (incf i)
497                (setq bmarklist lamers))))
498          (let ((ret nil))
499            (dotimes (j i ret)
500              (push (cons (car (nth j filtering-group-alist))
501                          (aref vec j))
502                    ret))))))
503    
504    ;;;###autoload
505    (defun ibuffer-filters-to-filter-group (name)
506      "Make the current filters into a filtering group."
507      (interactive "sName for filtering group: ")
508      (when (null ibuffer-filtering-qualifiers)
509        (error "No filters in effect"))
510      (push (cons name ibuffer-filtering-qualifiers) ibuffer-filtering-groups)
511      (ibuffer-filter-disable))
512    
513    ;;;###autoload
514    (defun ibuffer-pop-filter-group ()
515      "Remove the first filtering group."
516      (interactive)
517      (when (null ibuffer-filtering-groups)
518        (error "No filtering groups active"))
519      (pop ibuffer-filtering-groups)
520      (ibuffer-update nil t))
521    
522    ;;;###autoload
523    (defun ibuffer-jump-to-filter-group (name)
524      "Move point to the filter group whose name is NAME."
525      (interactive (list nil))
526      (let ((table (ibuffer-current-filter-groups)))
527        (when (interactive-p)
528          (setq name (completing-read "Jump to filter group: " table nil t)))
529        (ibuffer-aif (assoc name table)
530            (goto-char (cdr it))
531          (error "No filter group with name %s" name))))
532    
533  ;;;###autoload  ;;;###autoload
534  (defun ibuffer-filter-disable ()  (defun ibuffer-filter-disable ()
535    "Disable all filters currently in effect in this buffer."    "Disable all filters currently in effect in this buffer."
# Line 511  Interactively, prompt for NAME, and use Line 653  Interactively, prompt for NAME, and use
653        ibuffer-filtering-qualifiers)))        ibuffer-filtering-qualifiers)))
654    (ibuffer-aif (assoc name ibuffer-saved-filters)    (ibuffer-aif (assoc name ibuffer-saved-filters)
655        (setcdr it filters)        (setcdr it filters)
656        (push (list name filters) ibuffer-saved-filters))      (push (list name filters) ibuffer-saved-filters))
657    (ibuffer-maybe-save-saved-filters)    (ibuffer-maybe-save-saved-filters)
658    (ibuffer-update-mode-name))    (ibuffer-update-mode-name))
659    
# Line 575  of replacing the current filters." Line 717  of replacing the current filters."
717        
718  ;;; Extra operation definitions  ;;; Extra operation definitions
719    
720    ;;;###autoload (autoload 'ibuffer-filter-by-mode "ibuf-ext.el")
721  (define-ibuffer-filter mode  (define-ibuffer-filter mode
722    "Toggle current view to buffers with major mode QUALIFIER."    "Toggle current view to buffers with major mode QUALIFIER."
723    (:description "major mode"    (:description "major mode"
# Line 592  of replacing the current filters." Line 735  of replacing the current filters."
735                           "")))))                           "")))))
736    (eq qualifier (with-current-buffer buf major-mode)))    (eq qualifier (with-current-buffer buf major-mode)))
737    
738    ;;;###autoload (autoload 'ibuffer-filter-by-name "ibuf-ext.el")
739  (define-ibuffer-filter name  (define-ibuffer-filter name
740    "Toggle current view to buffers with name matching QUALIFIER."    "Toggle current view to buffers with name matching QUALIFIER."
741    (:description "buffer name"    (:description "buffer name"
742     :reader     :reader (read-from-minibuffer "Filter by name (regexp): "))
    (read-from-minibuffer "Filter by name (regexp): "))  
743    (string-match qualifier (buffer-name buf)))    (string-match qualifier (buffer-name buf)))
744    
745    ;;;###autoload (autoload 'ibuffer-filter-by-filename "ibuf-ext.el")
746  (define-ibuffer-filter filename  (define-ibuffer-filter filename
747    "Toggle current view to buffers with filename matching QUALIFIER."    "Toggle current view to buffers with filename matching QUALIFIER."
748    (:description "filename"    (:description "filename"
749     :reader     :reader (read-from-minibuffer "Filter by filename (regexp): "))
    (read-from-minibuffer "Filter by filename (regexp): "))  
750    (ibuffer-awhen (buffer-file-name buf)    (ibuffer-awhen (buffer-file-name buf)
751      (string-match qualifier it)))      (string-match qualifier it)))
752    
753    ;;;###autoload (autoload 'ibuffer-filter-by-size-gt  "ibuf-ext.el")
754  (define-ibuffer-filter size-gt  (define-ibuffer-filter size-gt
755    "Toggle current view to buffers with size greater than QUALIFIER."    "Toggle current view to buffers with size greater than QUALIFIER."
756    (:description "size greater than"    (:description "size greater than"
# Line 615  of replacing the current filters." Line 759  of replacing the current filters."
759    (> (with-current-buffer buf (buffer-size))    (> (with-current-buffer buf (buffer-size))
760       qualifier))       qualifier))
761    
762    ;;;###autoload (autoload 'ibuffer-filter-by-size-lt  "ibuf-ext.el")
763  (define-ibuffer-filter size-lt  (define-ibuffer-filter size-lt
764     "Toggle current view to buffers with size less than QUALIFIER."     "Toggle current view to buffers with size less than QUALIFIER."
765    (:description "size less than"    (:description "size less than"
# Line 622  of replacing the current filters." Line 767  of replacing the current filters."
767     (string-to-number (read-from-minibuffer "Filter by size less than: ")))     (string-to-number (read-from-minibuffer "Filter by size less than: ")))
768    (< (with-current-buffer buf (buffer-size))    (< (with-current-buffer buf (buffer-size))
769       qualifier))       qualifier))
770      
771    ;;;###autoload (autoload 'ibuffer-filter-by-content "ibuf-ext.el")
772  (define-ibuffer-filter content  (define-ibuffer-filter content
773     "Toggle current view to buffers whose contents match QUALIFIER."     "Toggle current view to buffers whose contents match QUALIFIER."
774    (:description "content"    (:description "content"
775     :reader     :reader (read-from-minibuffer "Filter by content (regexp): "))
    (read-from-minibuffer "Filter by content (regexp): "))  
776    (with-current-buffer buf    (with-current-buffer buf
777      (save-excursion      (save-excursion
778        (goto-char (point-min))        (goto-char (point-min))
779        (re-search-forward qualifier nil t))))        (re-search-forward qualifier nil t))))
780    
781    ;;;###autoload (autoload 'ibuffer-filter-by-predicate "ibuf-ext.el")
782  (define-ibuffer-filter predicate  (define-ibuffer-filter predicate
783     "Toggle current view to buffers for which QUALIFIER returns non-nil."     "Toggle current view to buffers for which QUALIFIER returns non-nil."
784    (:description "predicate"    (:description "predicate"
785     :reader     :reader (read-minibuffer "Filter by predicate (form): "))
    (read-minibuffer "Filter by predicate (form): "))  
786    (with-current-buffer buf    (with-current-buffer buf
787      (eval qualifier)))      (eval qualifier)))
788    
# Line 672  Default sorting modes are: Line 817  Default sorting modes are:
817               "normal"))               "normal"))
818    (ibuffer-redisplay t))    (ibuffer-redisplay t))
819    
820    ;;;###autoload (autoload 'ibuffer-do-sort-by-major-mode "ibuf-ext.el")
821  (define-ibuffer-sorter major-mode  (define-ibuffer-sorter major-mode
822    "Sort the buffers by major modes.    "Sort the buffers by major modes.
823  Ordering is lexicographic."  Ordering is lexicographic."
# Line 685  Ordering is lexicographic." Line 831  Ordering is lexicographic."
831                                    (car b)                                    (car b)
832                                  major-mode)))))                                  major-mode)))))
833    
834    ;;;###autoload (autoload 'ibuffer-do-sort-by-mode-name "ibuf-ext.el")
835  (define-ibuffer-sorter mode-name  (define-ibuffer-sorter mode-name
836    "Sort the buffers by their mode name.    "Sort the buffers by their mode name.
837  Ordering is lexicographic."  Ordering is lexicographic."
# Line 698  Ordering is lexicographic." Line 845  Ordering is lexicographic."
845                       (car b)                       (car b)
846                     mode-name))))                     mode-name))))
847    
848    ;;;###autoload (autoload 'ibuffer-do-sort-by-alphabetic "ibuf-ext.el")
849  (define-ibuffer-sorter alphabetic  (define-ibuffer-sorter alphabetic
850    "Sort the buffers by their names.    "Sort the buffers by their names.
851  Ordering is lexicographic."  Ordering is lexicographic."
# Line 706  Ordering is lexicographic." Line 854  Ordering is lexicographic."
854     (buffer-name (car a))     (buffer-name (car a))
855     (buffer-name (car b))))     (buffer-name (car b))))
856    
857    ;;;###autoload (autoload 'ibuffer-do-sort-by-size "ibuf-ext.el")
858  (define-ibuffer-sorter size  (define-ibuffer-sorter size
859   "Sort the buffers by their size."   "Sort the buffers by their size."
860    (:description "size")    (:description "size")
# Line 1051  You can then feed the file name(s) to ot Line 1200  You can then feed the file name(s) to ot
1200    "View lines which match REGEXP in all marked buffers.    "View lines which match REGEXP in all marked buffers.
1201  Optional argument NLINES says how many lines of context to display: it  Optional argument NLINES says how many lines of context to display: it
1202  defaults to one."  defaults to one."
1203    (interactive    (interactive (occur-read-primary-args))
    (list (let* ((default (car regexp-history))  
                 (input  
                  (read-from-minibuffer  
                   (if default  
                       (format "List lines matching regexp (default `%s'): "  
                               default)  
                     "List lines matching regexp: ")  
                   nil  
                   nil  
                   nil  
                   'regexp-history)))  
            (if (equal input "")  
                default  
              input))  
          current-prefix-arg))  
1204    (if (or (not (integerp nlines))    (if (or (not (integerp nlines))
1205            (< nlines 0))            (< nlines 0))
1206        (setq nlines 1))        (setq nlines 1))

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

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