/[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.15 by walters, Wed Apr 24 23:27:02 2002 UTC revision 1.16 by walters, Thu Apr 25 19:03:55 2002 UTC
# Line 146  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  (defvar ibuffer-filter-groups nil
150    "A list like ((\"NAME\" ((SYMBOL . QUALIFIER) ...) ...) which groups buffers.    "A list like ((\"NAME\" ((SYMBOL . QUALIFIER) ...) ...) which groups buffers.
151  See also `ibuffer-filtering-alist'.")  The SYMBOL should be one from `ibuffer-filtering-alist'.
152    The QUALIFIER should be the same as QUALIFIER in
153    `ibuffer-filtering-qualifiers'.")
154    
155  (defvar ibuffer-hidden-filtering-groups nil  (defcustom ibuffer-show-empty-filter-groups t
156      "If non-nil, then show the names of filter groups which are empty."
157      :type 'boolean
158      :group 'ibuffer)
159    
160    (defcustom ibuffer-saved-filter-groups
161      '(("gnus"
162         ((or (mode . message-mode)
163              (mode . mail-mode)
164              (mode . gnus-group-mode)
165              (mode . gnus-summary-mode)
166              (mode . gnus-article-mode))))
167        ("programming"
168         ((or (mode . emacs-lisp-mode)
169              (mode . cperl-mode)
170              (mode . c-mode)
171              (mode . java-mode)
172              (mode . idl-mode)
173              (mode . lisp-mode)))))
174                                      
175      "An alist of filtering groups to switch between.
176    
177    This variable should look like ((\"STRING\" QUALIFIERS)
178                                    (\"STRING\" QUALIFIERS) ...), where
179    QUALIFIERS is a list of the same form as
180    `ibuffer-filtering-qualifiers'.
181    
182    See also the variables `ibuffer-filter-groups',
183    `ibuffer-filtering-qualifiers', `ibuffer-filtering-alist', and the
184    functions `ibuffer-switch-to-saved-filter-group',
185    `ibuffer-save-filter-group'."
186      :type '(repeat sexp)
187      :group 'ibuffer)
188    
189    (defvar ibuffer-hidden-filter-groups nil
190    "A list of filtering groups which are currently hidden.")    "A list of filtering groups which are currently hidden.")
191    
192    (defvar ibuffer-filter-group-kill-ring nil)
193    
194  (defcustom ibuffer-old-time 72  (defcustom ibuffer-old-time 72
195    "The number of hours before a buffer is considered \"old\"."    "The number of hours before a buffer is considered \"old\"."
196    :type '(choice (const :tag "72 hours (3 days)" 72)    :type '(choice (const :tag "72 hours (3 days)" 72)
# Line 163  See also `ibuffer-filtering-alist'.") Line 201  See also `ibuffer-filtering-alist'.")
201    
202  (defcustom ibuffer-save-with-custom t  (defcustom ibuffer-save-with-custom t
203    "If non-nil, then use Custom to save interactively changed variables.    "If non-nil, then use Custom to save interactively changed variables.
204  Currently, this only applies to `ibuffer-saved-filters'."  Currently, this only applies to `ibuffer-saved-filters' and
205    `ibuffer-saved-filter-groups."
206    :type 'boolean    :type 'boolean
207    :group 'ibuffer)    :group 'ibuffer)
208    
# Line 253  With numeric ARG, enable auto-update if Line 292  With numeric ARG, enable auto-update if
292    (let ((name (get-text-property posn 'ibuffer-filter-group-name)))    (let ((name (get-text-property posn 'ibuffer-filter-group-name)))
293      (unless (stringp name)      (unless (stringp name)
294        (error "No filtering group name present"))        (error "No filtering group name present"))
295      (if (member name ibuffer-hidden-filtering-groups)      (if (member name ibuffer-hidden-filter-groups)
296          (setq ibuffer-hidden-filtering-groups          (setq ibuffer-hidden-filter-groups
297                (delete name ibuffer-hidden-filtering-groups))                (delete name ibuffer-hidden-filter-groups))
298        (push name ibuffer-hidden-filtering-groups))        (push name ibuffer-hidden-filter-groups))
299      (ibuffer-update nil t)))      (ibuffer-update nil t)))
300    
301  ;;;###autoload  ;;;###autoload
# Line 478  To evaluate a form without viewing the b Line 517  To evaluate a form without viewing the b
517                     (cdr filter))))))))))                     (cdr filter))))))))))
518    
519  (defun ibuffer-generate-filter-groups (bmarklist)  (defun ibuffer-generate-filter-groups (bmarklist)
520    (let ((filtering-group-alist (append ibuffer-filtering-groups    (let ((filter-group-alist (append ibuffer-filter-groups
521                                         (list (cons "Default" nil)))))                                         (list (cons "Default" nil)))))
522  ;;     (dolist (hidden ibuffer-hidden-filtering-groups)  ;;     (dolist (hidden ibuffer-hidden-filter-groups)
523  ;;       (setq filtering-group-alist (ibuffer-delete-alist  ;;       (setq filter-group-alist (ibuffer-delete-alist
524  ;;                                 hidden filtering-group-alist)))  ;;                                 hidden filter-group-alist)))
525      (let ((vec (make-vector (length filtering-group-alist) nil))      (let ((vec (make-vector (length filter-group-alist) nil))
526            (i 0))            (i 0))
527        (dolist (filtergroup filtering-group-alist)        (dolist (filtergroup filter-group-alist)
528          (let ((filterset (cdr filtergroup)))          (let ((filterset (cdr filtergroup)))
529            (multiple-value-bind (hip-crowd lamers)            (multiple-value-bind (hip-crowd lamers)
530                (ibuffer-split-list (lambda (bufmark)                (ibuffer-split-list (lambda (bufmark)
# Line 497  To evaluate a form without viewing the b Line 536  To evaluate a form without viewing the b
536              (setq bmarklist lamers))))              (setq bmarklist lamers))))
537        (let ((ret nil))        (let ((ret nil))
538          (dotimes (j i ret)          (dotimes (j i ret)
539            (push (cons (car (nth j filtering-group-alist))            (push (cons (car (nth j filter-group-alist))
540                        (aref vec j))                        (aref vec j))
541                  ret))))))                  ret))))))
542    
# Line 507  To evaluate a form without viewing the b Line 546  To evaluate a form without viewing the b
546    (interactive "sName for filtering group: ")    (interactive "sName for filtering group: ")
547    (when (null ibuffer-filtering-qualifiers)    (when (null ibuffer-filtering-qualifiers)
548      (error "No filters in effect"))      (error "No filters in effect"))
549    (push (cons name ibuffer-filtering-qualifiers) ibuffer-filtering-groups)    (push (cons name ibuffer-filtering-qualifiers) ibuffer-filter-groups)
550    (ibuffer-filter-disable))    (ibuffer-filter-disable))
551    
552  ;;;###autoload  ;;;###autoload
553    (defun ibuffer-set-filter-groups-by-mode ()
554      "Set the current filter groups to filter by mode."
555      (interactive)
556      (setq ibuffer-filter-groups
557            (mapcar (lambda (mode)
558                      (cons (format "%s" mode) `((mode . ,mode))))
559                    (delete-duplicates
560                     (mapcar (lambda (buf) (with-current-buffer buf major-mode))
561                             (buffer-list)))))
562      (ibuffer-update nil t))
563    
564    ;;;###autoload
565  (defun ibuffer-pop-filter-group ()  (defun ibuffer-pop-filter-group ()
566    "Remove the first filtering group."    "Remove the first filtering group."
567    (interactive)    (interactive)
568    (when (null ibuffer-filtering-groups)    (when (null ibuffer-filter-groups)
569      (error "No filtering groups active"))      (error "No filtering groups active"))
570    (pop ibuffer-filtering-groups)    (pop ibuffer-filter-groups)
571      (ibuffer-update nil t))
572    
573    ;;;###autoload
574    (defun ibuffer-clear-filter-groups ()
575      "Remove all filtering groups."
576      (interactive)
577      (setq ibuffer-filter-groups nil)
578    (ibuffer-update nil t))    (ibuffer-update nil t))
579    
580    (defun ibuffer-current-filter-groups-with-position ()
581      (save-excursion
582        (goto-char (point-min))
583        (let ((pos nil)
584              (result nil))
585          (while (and (not (eobp))
586                      (setq pos (next-single-property-change
587                                 (point) 'ibuffer-filter-group-name)))
588            (goto-char pos)
589            (push (cons (get-text-property (point) 'ibuffer-filter-group-name)
590                        pos)
591                  result)
592            (goto-char (next-single-property-change
593                        pos 'ibuffer-filter-group-name)))
594          (nreverse result))))
595    
596  ;;;###autoload  ;;;###autoload
597  (defun ibuffer-jump-to-filter-group (name)  (defun ibuffer-jump-to-filter-group (name)
598    "Move point to the filter group whose name is NAME."    "Move point to the filter group whose name is NAME."
599    (interactive (list nil))    (interactive (list nil))
600    (let ((table (ibuffer-current-filter-groups)))    (let ((table (ibuffer-current-filter-groups-with-position)))
601      (when (interactive-p)      (when (interactive-p)
602        (setq name (completing-read "Jump to filter group: " table nil t)))        (setq name (completing-read "Jump to filter group: " table nil t)))
603      (ibuffer-aif (assoc name table)      (ibuffer-aif (assoc name table)
# Line 531  To evaluate a form without viewing the b Line 605  To evaluate a form without viewing the b
605        (error "No filter group with name %s" name))))        (error "No filter group with name %s" name))))
606    
607  ;;;###autoload  ;;;###autoload
608    (defun ibuffer-kill-filter-group (name)
609      "Delete the filtering group named NAME."
610      (interactive (list nil))
611      (when (interactive-p)
612        (setq name (completing-read "Kill filter group: "
613                                    ibuffer-filter-groups nil t)))
614      (ibuffer-aif (assoc name ibuffer-filter-groups)
615          (setq ibuffer-filter-groups (ibuffer-delete-alist
616                                       name ibuffer-filter-groups))
617        (error "No filter group with name \"%s\"" name))
618      (ibuffer-update nil t))
619    
620    ;;;###autoload
621    (defun ibuffer-kill-line (&optional arg)
622      (interactive "P")
623      (ibuffer-aif (save-excursion
624                     (ibuffer-forward-line 0)
625                     (get-text-property (point) 'ibuffer-filter-group-name))
626          (progn
627            (when (equal it "Default")
628              (error "Can't kill default filtering group"))
629            (push (assoc it ibuffer-filter-groups) ibuffer-filter-group-kill-ring)
630            (ibuffer-kill-filter-group it))
631          (funcall (if (interactive-p) #'call-interactively #'funcall)
632                   #'kill-line arg)))
633    
634    ;;;###autoload
635    (defun ibuffer-yank (&optional arg)
636      (interactive "P")
637      (unless ibuffer-filter-group-kill-ring
638        (error "ibuffer-filter-group-kill-ring is empty"))
639      (save-excursion
640        (ibuffer-forward-line 0)
641        (let* ((last-killed (pop ibuffer-filter-group-kill-ring))
642               (all-groups ibuffer-filter-groups)
643               (cur (or (get-text-property (point) 'ibuffer-filter-group-name)
644                        (get-text-property (point) 'ibuffer-filter-group)
645                        (last all-groups)))
646               (pos (or (position cur (mapcar #'car all-groups) :test #'equal)
647                        (1- (length all-groups)))))
648          (cond ((= pos 0)
649                 (push last-killed ibuffer-filter-groups))
650                ((= pos (1- (length all-groups)))
651                 (nconc ibuffer-filter-groups (list last-killed)))
652                (t
653                 (let ((cell (nthcdr pos ibuffer-filter-groups)))
654                   (setf (cdr cell) (cons (car cell) (cdr cell)))
655                   (setf (car cell) last-killed))))))
656      (ibuffer-update nil t))
657    
658    ;;;###autoload
659    (defun ibuffer-save-filter-groups (name groups)
660      "Save all active filter groups GROUPS as NAME.
661    They are added to `ibuffer-saved-filter-groups'.  Interactively,
662    prompt for NAME, and use the current filters."
663      (interactive
664       (if (null ibuffer-filter-groups)
665           (error "No filter groups active")
666         (list
667          (read-from-minibuffer "Save current filter groups as: ")
668          ibuffer-filter-groups)))
669      (ibuffer-aif (assoc name ibuffer-saved-filter-groups)
670          (setcdr it groups)
671        (push (list name groups) ibuffer-saved-filter-groups))
672      (ibuffer-maybe-save-stuff)
673      (ibuffer-update-mode-name))
674    
675    ;;;###autoload
676    (defun ibuffer-delete-saved-filter-groups (name)
677      "Delete saved filter groups with NAME.
678    They are removed from `ibuffer-saved-filter-groups'."
679      (interactive
680       (list
681        (if (null ibuffer-saved-filter-groups)
682            (error "No saved filters")
683          (completing-read "Delete saved filters: "
684                           ibuffer-saved-filter-groups nil t))))
685      (setq ibuffer-saved-filter-groups
686            (ibuffer-delete-alist name ibuffer-saved-filter-groups))
687      (ibuffer-maybe-save-stuff)
688      (ibuffer-update nil t))
689    
690    ;;;###autoload
691    (defun ibuffer-switch-to-saved-filter-groups (name)
692      "Set this buffer's filter groups to saved version with NAME.
693    The value from `ibuffer-saved-filters' is used.
694    If prefix argument ADD is non-nil, then add the saved filters instead
695    of replacing the current filters."
696      (interactive
697       (list
698        (if (null ibuffer-saved-filter-groups)
699            (error "No saved filters")
700          (completing-read "Switch to saved filter group: "
701                           ibuffer-saved-filter-groups nil t))))
702      (setq ibuffer-filter-groups (assoc name ibuffer-saved-filter-groups))
703      (ibuffer-update nil t))
704    
705    ;;;###autoload
706  (defun ibuffer-filter-disable ()  (defun ibuffer-filter-disable ()
707    "Disable all filters currently in effect in this buffer."    "Disable all filters currently in effect in this buffer."
708    (interactive)    (interactive)
# Line 633  filter into parts." Line 805  filter into parts."
805                ibuffer-filtering-qualifiers))))                ibuffer-filtering-qualifiers))))
806    (ibuffer-update nil t))    (ibuffer-update nil t))
807    
808  (defun ibuffer-maybe-save-saved-filters ()  (defun ibuffer-maybe-save-stuff ()
809    (when ibuffer-save-with-custom    (when ibuffer-save-with-custom
810      (if (fboundp 'customize-save-variable)      (if (fboundp 'customize-save-variable)
811          (progn          (progn
812            (customize-save-variable 'ibuffer-saved-filters            (customize-save-variable 'ibuffer-saved-filters
813                                     ibuffer-saved-filters))                                     ibuffer-saved-filters)
814              (customize-save-variable 'ibuffer-saved-filter-groups
815                                       ibuffer-saved-filter-groups))
816        (message "Not saved permanently: Customize not available"))))        (message "Not saved permanently: Customize not available"))))
817    
818  ;;;###autoload  ;;;###autoload
# Line 654  Interactively, prompt for NAME, and use Line 828  Interactively, prompt for NAME, and use
828    (ibuffer-aif (assoc name ibuffer-saved-filters)    (ibuffer-aif (assoc name ibuffer-saved-filters)
829        (setcdr it filters)        (setcdr it filters)
830      (push (list name filters) ibuffer-saved-filters))      (push (list name filters) ibuffer-saved-filters))
831    (ibuffer-maybe-save-saved-filters)    (ibuffer-maybe-save-stuff)
832    (ibuffer-update-mode-name))    (ibuffer-update-mode-name))
833    
834  ;;;###autoload  ;;;###autoload
# Line 668  Interactively, prompt for NAME, and use Line 842  Interactively, prompt for NAME, and use
842                         ibuffer-saved-filters nil t))))                         ibuffer-saved-filters nil t))))
843    (setq ibuffer-saved-filters    (setq ibuffer-saved-filters
844          (ibuffer-delete-alist name ibuffer-saved-filters))          (ibuffer-delete-alist name ibuffer-saved-filters))
845    (ibuffer-maybe-save-saved-filters)    (ibuffer-maybe-save-stuff)
846    (ibuffer-update nil t))    (ibuffer-update nil t))
847    
848  ;;;###autoload  ;;;###autoload
# Line 1048  You can then feed the file name(s) to ot Line 1222  You can then feed the file name(s) to ot
1222                           " "))))                           " "))))
1223        (push ibuffer-copy-filename-as-kill-result kill-ring))))        (push ibuffer-copy-filename-as-kill-result kill-ring))))
1224    
1225  (defun ibuffer-mark-on-buffer (func)  (defun ibuffer-mark-on-buffer (func &optional ibuffer-mark-on-buffer-mark group)
1226    (let ((count    (let ((count
1227           (ibuffer-map-lines           (ibuffer-map-lines
1228            #'(lambda (buf mark)            #'(lambda (buf mark)
1229                (when (funcall func buf)                (when (funcall func buf)
1230                  (ibuffer-set-mark-1 ibuffer-marked-char)                  (ibuffer-set-mark-1 (or ibuffer-mark-on-buffer-mark
1231                  t)))))                                          ibuffer-marked-char))
1232                    t))
1233              nil
1234              group)))
1235      (ibuffer-redisplay t)      (ibuffer-redisplay t)
1236      (message "Marked %s buffers" count)))      (message "Marked %s buffers" count)))
1237    

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

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