[Emacs-diffs] Changes to emacs/lisp/ibuf-ext.el

[Colin Walters]

Index: emacs/lisp/ibuf-ext.el
diff -c emacs/lisp/ibuf-ext.el:1.15 emacs/lisp/ibuf-ext.el:1.16
*** emacs/lisp/ibuf-ext.el:1.15 Wed Apr 24 19:27:02 2002
--- emacs/lisp/ibuf-ext.el      Thu Apr 25 15:03:55 2002
***************
*** 146,158 ****
  (defvar ibuffer-cached-filter-formats nil)
  (defvar ibuffer-compiled-filter-formats nil)  
  
! (defvar ibuffer-filtering-groups nil
    "A list like ((\"NAME\" ((SYMBOL . QUALIFIER) ...) ...) which groups 
buffers.
! See also `ibuffer-filtering-alist'.")
  
! (defvar ibuffer-hidden-filtering-groups nil
    "A list of filtering groups which are currently hidden.")
  
  (defcustom ibuffer-old-time 72
    "The number of hours before a buffer is considered \"old\"."
    :type '(choice (const :tag "72 hours (3 days)" 72)
--- 146,196 ----
  (defvar ibuffer-cached-filter-formats nil)
  (defvar ibuffer-compiled-filter-formats nil)  
  
! (defvar ibuffer-filter-groups nil
    "A list like ((\"NAME\" ((SYMBOL . QUALIFIER) ...) ...) which groups 
buffers.
! The SYMBOL should be one from `ibuffer-filtering-alist'.
! The QUALIFIER should be the same as QUALIFIER in
! `ibuffer-filtering-qualifiers'.")
  
! (defcustom ibuffer-show-empty-filter-groups t
!   "If non-nil, then show the names of filter groups which are empty."
!   :type 'boolean
!   :group 'ibuffer)
! 
! (defcustom ibuffer-saved-filter-groups
!   '(("gnus"
!      ((or (mode . message-mode)
!         (mode . mail-mode)
!         (mode . gnus-group-mode)
!         (mode . gnus-summary-mode) 
!         (mode . gnus-article-mode))))
!     ("programming"
!      ((or (mode . emacs-lisp-mode)
!         (mode . cperl-mode)
!         (mode . c-mode)
!         (mode . java-mode) 
!         (mode . idl-mode)
!         (mode . lisp-mode)))))
!                                 
!   "An alist of filtering groups to switch between.
! 
! This variable should look like ((\"STRING\" QUALIFIERS)
!                                 (\"STRING\" QUALIFIERS) ...), where
! QUALIFIERS is a list of the same form as
! `ibuffer-filtering-qualifiers'.
! 
! See also the variables `ibuffer-filter-groups',
! `ibuffer-filtering-qualifiers', `ibuffer-filtering-alist', and the
! functions `ibuffer-switch-to-saved-filter-group',
! `ibuffer-save-filter-group'."
!   :type '(repeat sexp)
!   :group 'ibuffer)
! 
! (defvar ibuffer-hidden-filter-groups nil
    "A list of filtering groups which are currently hidden.")
  
+ (defvar ibuffer-filter-group-kill-ring nil)
+ 
  (defcustom ibuffer-old-time 72
    "The number of hours before a buffer is considered \"old\"."
    :type '(choice (const :tag "72 hours (3 days)" 72)
***************
*** 163,169 ****
  
  (defcustom ibuffer-save-with-custom t
    "If non-nil, then use Custom to save interactively changed variables.
! Currently, this only applies to `ibuffer-saved-filters'."
    :type 'boolean
    :group 'ibuffer)
  
--- 201,208 ----
  
  (defcustom ibuffer-save-with-custom t
    "If non-nil, then use Custom to save interactively changed variables.
! Currently, this only applies to `ibuffer-saved-filters' and
! `ibuffer-saved-filter-groups."
    :type 'boolean
    :group 'ibuffer)
  
***************
*** 253,262 ****
    (let ((name (get-text-property posn 'ibuffer-filter-group-name)))
      (unless (stringp name)
        (error "No filtering group name present"))
!     (if (member name ibuffer-hidden-filtering-groups)
!       (setq ibuffer-hidden-filtering-groups
!             (delete name ibuffer-hidden-filtering-groups))
!       (push name ibuffer-hidden-filtering-groups))
      (ibuffer-update nil t)))
  
  ;;;###autoload
--- 292,301 ----
    (let ((name (get-text-property posn 'ibuffer-filter-group-name)))
      (unless (stringp name)
        (error "No filtering group name present"))
!     (if (member name ibuffer-hidden-filter-groups)
!       (setq ibuffer-hidden-filter-groups
!             (delete name ibuffer-hidden-filter-groups))
!       (push name ibuffer-hidden-filter-groups))
      (ibuffer-update nil t)))
  
  ;;;###autoload
***************
*** 478,491 ****
                   (cdr filter))))))))))
  
  (defun ibuffer-generate-filter-groups (bmarklist)
!   (let ((filtering-group-alist (append ibuffer-filtering-groups
                                       (list (cons "Default" nil)))))
! ;;     (dolist (hidden ibuffer-hidden-filtering-groups)
! ;;       (setq filtering-group-alist (ibuffer-delete-alist
! ;;                               hidden filtering-group-alist)))
!     (let ((vec (make-vector (length filtering-group-alist) nil))
          (i 0))
!       (dolist (filtergroup filtering-group-alist)
        (let ((filterset (cdr filtergroup)))
          (multiple-value-bind (hip-crowd lamers)
              (ibuffer-split-list (lambda (bufmark)
--- 517,530 ----
                   (cdr filter))))))))))
  
  (defun ibuffer-generate-filter-groups (bmarklist)
!   (let ((filter-group-alist (append ibuffer-filter-groups
                                       (list (cons "Default" nil)))))
! ;;     (dolist (hidden ibuffer-hidden-filter-groups)
! ;;       (setq filter-group-alist (ibuffer-delete-alist
! ;;                               hidden filter-group-alist)))
!     (let ((vec (make-vector (length filter-group-alist) nil))
          (i 0))
!       (dolist (filtergroup filter-group-alist)
        (let ((filterset (cdr filtergroup)))
          (multiple-value-bind (hip-crowd lamers)
              (ibuffer-split-list (lambda (bufmark)
***************
*** 497,503 ****
            (setq bmarklist lamers))))
        (let ((ret nil))
        (dotimes (j i ret)
!         (push (cons (car (nth j filtering-group-alist))
                      (aref vec j))
                ret))))))
  
--- 536,542 ----
            (setq bmarklist lamers))))
        (let ((ret nil))
        (dotimes (j i ret)
!         (push (cons (car (nth j filter-group-alist))
                      (aref vec j))
                ret))))))
  
***************
*** 507,529 ****
    (interactive "sName for filtering group: ")
    (when (null ibuffer-filtering-qualifiers)
      (error "No filters in effect"))
!   (push (cons name ibuffer-filtering-qualifiers) ibuffer-filtering-groups)
    (ibuffer-filter-disable))
  
  ;;;###autoload
  (defun ibuffer-pop-filter-group ()
    "Remove the first filtering group."
    (interactive)
!   (when (null ibuffer-filtering-groups)
      (error "No filtering groups active"))
!   (pop ibuffer-filtering-groups)
    (ibuffer-update nil t))
  
  ;;;###autoload
  (defun ibuffer-jump-to-filter-group (name)
    "Move point to the filter group whose name is NAME."
    (interactive (list nil))
!   (let ((table (ibuffer-current-filter-groups)))
      (when (interactive-p)
        (setq name (completing-read "Jump to filter group: " table nil t)))
      (ibuffer-aif (assoc name table)
--- 546,603 ----
    (interactive "sName for filtering group: ")
    (when (null ibuffer-filtering-qualifiers)
      (error "No filters in effect"))
!   (push (cons name ibuffer-filtering-qualifiers) ibuffer-filter-groups)
    (ibuffer-filter-disable))
  
  ;;;###autoload
+ (defun ibuffer-set-filter-groups-by-mode ()
+   "Set the current filter groups to filter by mode."
+   (interactive)
+   (setq ibuffer-filter-groups
+       (mapcar (lambda (mode)
+                 (cons (format "%s" mode) `((mode . ,mode))))
+               (delete-duplicates
+                (mapcar (lambda (buf) (with-current-buffer buf major-mode))
+                        (buffer-list)))))
+   (ibuffer-update nil t))
+ 
+ ;;;###autoload
  (defun ibuffer-pop-filter-group ()
    "Remove the first filtering group."
    (interactive)
!   (when (null ibuffer-filter-groups)
      (error "No filtering groups active"))
!   (pop ibuffer-filter-groups)
!   (ibuffer-update nil t))
! 
! ;;;###autoload
! (defun ibuffer-clear-filter-groups ()
!   "Remove all filtering groups."
!   (interactive)
!   (setq ibuffer-filter-groups nil)
    (ibuffer-update nil t))
  
+ (defun ibuffer-current-filter-groups-with-position ()
+   (save-excursion
+     (goto-char (point-min))
+     (let ((pos nil)
+         (result nil))
+       (while (and (not (eobp))
+                 (setq pos (next-single-property-change
+                            (point) 'ibuffer-filter-group-name)))
+       (goto-char pos)
+       (push (cons (get-text-property (point) 'ibuffer-filter-group-name)
+                   pos)
+             result)
+       (goto-char (next-single-property-change
+                   pos 'ibuffer-filter-group-name)))
+       (nreverse result))))
+ 
  ;;;###autoload
  (defun ibuffer-jump-to-filter-group (name)
    "Move point to the filter group whose name is NAME."
    (interactive (list nil))
!   (let ((table (ibuffer-current-filter-groups-with-position)))
      (when (interactive-p)
        (setq name (completing-read "Jump to filter group: " table nil t)))
      (ibuffer-aif (assoc name table)
***************
*** 531,536 ****
--- 605,708 ----
        (error "No filter group with name %s" name))))
  
  ;;;###autoload
+ (defun ibuffer-kill-filter-group (name)
+   "Delete the filtering group named NAME."
+   (interactive (list nil))
+   (when (interactive-p)
+     (setq name (completing-read "Kill filter group: "
+                               ibuffer-filter-groups nil t)))
+   (ibuffer-aif (assoc name ibuffer-filter-groups)
+       (setq ibuffer-filter-groups (ibuffer-delete-alist
+                                  name ibuffer-filter-groups))
+     (error "No filter group with name \"%s\"" name))
+   (ibuffer-update nil t))
+ 
+ ;;;###autoload
+ (defun ibuffer-kill-line (&optional arg)
+   (interactive "P")
+   (ibuffer-aif (save-excursion
+                (ibuffer-forward-line 0)
+                (get-text-property (point) 'ibuffer-filter-group-name))
+       (progn
+       (when (equal it "Default")
+         (error "Can't kill default filtering group"))
+       (push (assoc it ibuffer-filter-groups) ibuffer-filter-group-kill-ring)
+       (ibuffer-kill-filter-group it))
+       (funcall (if (interactive-p) #'call-interactively #'funcall)
+              #'kill-line arg)))
+ 
+ ;;;###autoload
+ (defun ibuffer-yank (&optional arg)
+   (interactive "P")
+   (unless ibuffer-filter-group-kill-ring
+     (error "ibuffer-filter-group-kill-ring is empty"))
+   (save-excursion
+     (ibuffer-forward-line 0)
+     (let* ((last-killed (pop ibuffer-filter-group-kill-ring))
+          (all-groups ibuffer-filter-groups)
+          (cur (or (get-text-property (point) 'ibuffer-filter-group-name)
+                   (get-text-property (point) 'ibuffer-filter-group)
+                   (last all-groups)))
+          (pos (or (position cur (mapcar #'car all-groups) :test #'equal)
+                   (1- (length all-groups)))))
+       (cond ((= pos 0)
+            (push last-killed ibuffer-filter-groups))
+           ((= pos (1- (length all-groups)))
+            (nconc ibuffer-filter-groups (list last-killed)))
+           (t
+            (let ((cell (nthcdr pos ibuffer-filter-groups)))
+              (setf (cdr cell) (cons (car cell) (cdr cell)))
+              (setf (car cell) last-killed))))))
+   (ibuffer-update nil t))
+ 
+ ;;;###autoload
+ (defun ibuffer-save-filter-groups (name groups) 
+   "Save all active filter groups GROUPS as NAME.
+ They are added to `ibuffer-saved-filter-groups'.  Interactively,
+ prompt for NAME, and use the current filters."
+   (interactive
+    (if (null ibuffer-filter-groups)
+        (error "No filter groups active")
+      (list
+       (read-from-minibuffer "Save current filter groups as: ")
+       ibuffer-filter-groups)))
+   (ibuffer-aif (assoc name ibuffer-saved-filter-groups)
+       (setcdr it groups)
+     (push (list name groups) ibuffer-saved-filter-groups))
+   (ibuffer-maybe-save-stuff)
+   (ibuffer-update-mode-name))
+ 
+ ;;;###autoload
+ (defun ibuffer-delete-saved-filter-groups (name)
+   "Delete saved filter groups with NAME.
+ They are removed from `ibuffer-saved-filter-groups'."
+   (interactive
+    (list
+     (if (null ibuffer-saved-filter-groups)
+       (error "No saved filters")
+       (completing-read "Delete saved filters: "
+                      ibuffer-saved-filter-groups nil t))))
+   (setq ibuffer-saved-filter-groups
+       (ibuffer-delete-alist name ibuffer-saved-filter-groups))
+   (ibuffer-maybe-save-stuff)
+   (ibuffer-update nil t))
+ 
+ ;;;###autoload
+ (defun ibuffer-switch-to-saved-filter-groups (name)
+   "Set this buffer's filter groups to saved version with NAME.
+ The value from `ibuffer-saved-filters' is used.
+ If prefix argument ADD is non-nil, then add the saved filters instead
+ of replacing the current filters."
+   (interactive
+    (list
+     (if (null ibuffer-saved-filter-groups)
+       (error "No saved filters")
+       (completing-read "Switch to saved filter group: "
+                      ibuffer-saved-filter-groups nil t))))
+   (setq ibuffer-filter-groups (assoc name ibuffer-saved-filter-groups))
+   (ibuffer-update nil t))
+ 
+ ;;;###autoload
  (defun ibuffer-filter-disable ()
    "Disable all filters currently in effect in this buffer."
    (interactive)
***************
*** 633,644 ****
              ibuffer-filtering-qualifiers))))
    (ibuffer-update nil t))
  
! (defun ibuffer-maybe-save-saved-filters ()
    (when ibuffer-save-with-custom
      (if (fboundp 'customize-save-variable)
        (progn
          (customize-save-variable 'ibuffer-saved-filters
!                                  ibuffer-saved-filters))
        (message "Not saved permanently: Customize not available"))))
  
  ;;;###autoload
--- 805,818 ----
              ibuffer-filtering-qualifiers))))
    (ibuffer-update nil t))
  
! (defun ibuffer-maybe-save-stuff ()
    (when ibuffer-save-with-custom
      (if (fboundp 'customize-save-variable)
        (progn
          (customize-save-variable 'ibuffer-saved-filters
!                                  ibuffer-saved-filters)
!         (customize-save-variable 'ibuffer-saved-filter-groups
!                                  ibuffer-saved-filter-groups))
        (message "Not saved permanently: Customize not available"))))
  
  ;;;###autoload
***************
*** 654,660 ****
    (ibuffer-aif (assoc name ibuffer-saved-filters)
        (setcdr it filters)
      (push (list name filters) ibuffer-saved-filters))
!   (ibuffer-maybe-save-saved-filters)
    (ibuffer-update-mode-name))
  
  ;;;###autoload
--- 828,834 ----
    (ibuffer-aif (assoc name ibuffer-saved-filters)
        (setcdr it filters)
      (push (list name filters) ibuffer-saved-filters))
!   (ibuffer-maybe-save-stuff)
    (ibuffer-update-mode-name))
  
  ;;;###autoload
***************
*** 668,674 ****
                       ibuffer-saved-filters nil t))))
    (setq ibuffer-saved-filters
        (ibuffer-delete-alist name ibuffer-saved-filters))
!   (ibuffer-maybe-save-saved-filters)
    (ibuffer-update nil t))
  
  ;;;###autoload
--- 842,848 ----
                       ibuffer-saved-filters nil t))))
    (setq ibuffer-saved-filters
        (ibuffer-delete-alist name ibuffer-saved-filters))
!   (ibuffer-maybe-save-stuff)
    (ibuffer-update nil t))
  
  ;;;###autoload
***************
*** 1048,1060 ****
                         " "))))
        (push ibuffer-copy-filename-as-kill-result kill-ring))))
  
! (defun ibuffer-mark-on-buffer (func)
    (let ((count
         (ibuffer-map-lines
          #'(lambda (buf mark)
              (when (funcall func buf)
!               (ibuffer-set-mark-1 ibuffer-marked-char)
!               t)))))
      (ibuffer-redisplay t)
      (message "Marked %s buffers" count)))
  
--- 1222,1237 ----
                         " "))))
        (push ibuffer-copy-filename-as-kill-result kill-ring))))
  
! (defun ibuffer-mark-on-buffer (func &optional ibuffer-mark-on-buffer-mark 
group)
    (let ((count
         (ibuffer-map-lines
          #'(lambda (buf mark)
              (when (funcall func buf)
!               (ibuffer-set-mark-1 (or ibuffer-mark-on-buffer-mark
!                                       ibuffer-marked-char))
!               t))
!         nil
!         group)))
      (ibuffer-redisplay t)
      (message "Marked %s buffers" count)))