comparison lisp/ibuf-ext.el @ 44855:663ebf8868d8

(ibuffer-filtering-groups): Renamed to `ibuffer-filter-groups'. All users updated. (ibuffer-show-empty-filter-groups): New variable. (ibuffer-saved-filter-groups): New variable. (ibuffer-maybe-save-stuff): Renamed from `ibuffer-maybe-save-saved-filters'. Callers updated. Handle `ibuffer-saved-filter-groups'. (ibuffer-hidden-filtering-groups): Renamed to `ibuffer-hidden-filter-groups'. (ibuffer-filter-group-kill-ring): New variable. (ibuffer-save-with-custom): Doc fix. (ibuffer-set-filter-groups-by-mode): New function. (ibuffer-clear-filter-groups): New function. (ibuffer-current-filter-groups-with-position): Renamed from `ibuffer-current-filter-groups'. Callers updated. (ibuffer-kill-filter-group): New function. (ibuffer-kill-line): New function. (ibuffer-yank): New function. (ibuffer-save-filter-groups): New function. (ibuffer-delete-saved-filter-groups): New function. (ibuffer-switch-to-saved-filter-groups): New function. (ibuffer-mark-on-buffer): Add optional arguments for adding a specific mark, and marking on a specific group.

44854:6cd35f994b33

  :group 'ibuffer)

(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)
 		 (const :tag "48 hours (2 days)" 48)

		 (integer :tag "hours"))
  :group 'ibuffer)

(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)

(defun ibuffer-ext-visible-p (buf all &optional ibuffer-buf)
  (or

(defun ibuffer-toggle-filter-group-1 (posn)	
  (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
(defun ibuffer-forward-filter-group (&optional count)
  "Move point forwards by COUNT filtering groups."

	  (funcall (caddr filterdat)
		   buf
		   (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)
				    (ibuffer-included-in-filters-p (car bufmark)
								   filterset))

	    (aset vec i hip-crowd)
	    (incf i)
	    (setq bmarklist lamers))))
      (let ((ret nil))
	(dotimes (j i ret)
	  (push (cons (car (nth j filtering-group-alist))
		      (aref vec j))
		ret))))))

;;;###autoload
(defun ibuffer-filters-to-filter-group (name)
  "Make the current filters into a filtering group."
  (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)
	(goto-char (cdr it))
      (error "No filter group with name %s" name))))

;;;###autoload
(defun ibuffer-filter-disable ()
  "Disable all filters currently in effect in this buffer."
  (interactive)

	  (push (nconc (list 'or first) (cdr second)) ibuffer-filtering-qualifiers)
	(push (list 'or first second)
	      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
(defun ibuffer-save-filters (name filters)
  "Save FILTERS in this buffer with name NAME in `ibuffer-saved-filters'.

      (read-from-minibuffer "Save current filters as: ")
      ibuffer-filtering-qualifiers)))
  (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
(defun ibuffer-delete-saved-filters (name)
  "Delete saved filters with NAME from `ibuffer-saved-filters'."

	(error "No saved filters")
      (completing-read "Delete saved filters: "
		       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
(defun ibuffer-add-saved-filters (name)
  "Add saved filters from `ibuffer-saved-filters' to this buffer's filters."

				  (file-name-nondirectory name)))
			     ""))
			 " "))))
      (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)))

;;;###autoload
(defun ibuffer-mark-by-name-regexp (regexp)

44855:663ebf8868d8

  :group 'ibuffer)

(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)
 		 (const :tag "48 hours (2 days)" 48)

		 (integer :tag "hours"))
  :group 'ibuffer)

(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)

(defun ibuffer-ext-visible-p (buf all &optional ibuffer-buf)
  (or

(defun ibuffer-toggle-filter-group-1 (posn)	
  (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
(defun ibuffer-forward-filter-group (&optional count)
  "Move point forwards by COUNT filtering groups."

	  (funcall (caddr filterdat)
		   buf
		   (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)
				    (ibuffer-included-in-filters-p (car bufmark)
								   filterset))

	    (aset vec i hip-crowd)
	    (incf i)
	    (setq bmarklist lamers))))
      (let ((ret nil))
	(dotimes (j i ret)
	  (push (cons (car (nth j filter-group-alist))
		      (aref vec j))
		ret))))))

;;;###autoload
(defun ibuffer-filters-to-filter-group (name)
  "Make the current filters into a filtering group."
  (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)
	(goto-char (cdr it))
      (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)

	  (push (nconc (list 'or first) (cdr second)) ibuffer-filtering-qualifiers)
	(push (list 'or first second)
	      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
(defun ibuffer-save-filters (name filters)
  "Save FILTERS in this buffer with name NAME in `ibuffer-saved-filters'.

      (read-from-minibuffer "Save current filters as: ")
      ibuffer-filtering-qualifiers)))
  (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
(defun ibuffer-delete-saved-filters (name)
  "Delete saved filters with NAME from `ibuffer-saved-filters'."

	(error "No saved filters")
      (completing-read "Delete saved filters: "
		       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
(defun ibuffer-add-saved-filters (name)
  "Add saved filters from `ibuffer-saved-filters' to this buffer's filters."

				  (file-name-nondirectory name)))
			     ""))
			 " "))))
      (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)))

;;;###autoload
(defun ibuffer-mark-by-name-regexp (regexp)