;;; ibuf-ext.el --- extensions for ibuffer
-;; Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008,
-;; 2009, 2010, 2011, 2012 Free Software Foundation, Inc.
+;; Copyright (C) 2000-2014 Free Software Foundation, Inc.
;; Author: Colin Walters <walters@verbum.org>
;; Maintainer: John Paul Wallington <jpw@gnu.org>
;; Created: 2 Dec 2001
;; Keywords: buffer, convenience
+;; Package: ibuffer
;; This file is part of GNU Emacs.
;;; Commentary:
;; These functions should be automatically loaded when called, but you
-;; can explicity (require 'ibuf-ext) in your ~/.emacs to have them
+;; can explicitly (require 'ibuf-ext) in your ~/.emacs to have them
;; preloaded.
;;; Code:
(eval-when-compile
(require 'ibuf-macs)
- (require 'cl))
+ (require 'cl-lib))
;;; Utility functions
(defun ibuffer-delete-alist (key alist)
(defvar ibuffer-tmp-show-regexps nil
"A list of regexps which should match buffer names to always show.")
-(defvar ibuffer-auto-mode nil
- "If non-nil, Ibuffer auto-mode should be enabled for this buffer.
-Do not set this variable directly! Use the function
-`ibuffer-auto-mode' instead.")
-
(defvar ibuffer-auto-buffers-changed nil)
(defcustom ibuffer-saved-filters '(("gnus"
(ibuffer-included-in-filters-p buf ibuffer-filtering-qualifiers)
(ibuffer-buf-matches-predicates buf ibuffer-always-show-predicates)))))
+;;;###autoload
+(define-minor-mode ibuffer-auto-mode
+ "Toggle use of Ibuffer's auto-update facility (Ibuffer Auto mode).
+With a prefix argument ARG, enable Ibuffer Auto mode if ARG is
+positive, and disable it otherwise. If called from Lisp, enable
+the mode if ARG is omitted or nil."
+ nil nil nil
+ (unless (derived-mode-p 'ibuffer-mode)
+ (error "This buffer is not in Ibuffer mode"))
+ (frame-or-buffer-changed-p 'ibuffer-auto-buffers-changed) ; Initialize state vector
+ (add-hook 'post-command-hook 'ibuffer-auto-update-changed))
+
(defun ibuffer-auto-update-changed ()
(when (frame-or-buffer-changed-p 'ibuffer-auto-buffers-changed)
(dolist (buf (buffer-list))
(derived-mode-p 'ibuffer-mode))
(ibuffer-update nil t)))))))
-;;;###autoload
-(defun ibuffer-auto-mode (&optional arg)
- "Toggle use of Ibuffer's auto-update facility.
-With numeric ARG, enable auto-update if and only if ARG is positive."
- (interactive)
- (unless (derived-mode-p 'ibuffer-mode)
- (error "This buffer is not in Ibuffer mode"))
- (set (make-local-variable 'ibuffer-auto-mode)
- (if arg
- (plusp arg)
- (not ibuffer-auto-mode)))
- (frame-or-buffer-changed-p 'ibuffer-auto-buffers-changed) ; Initialize state vector
- (add-hook 'post-command-hook 'ibuffer-auto-update-changed))
-
;;;###autoload
(defun ibuffer-mouse-filter-by-mode (event)
"Enable or disable filtering by the major mode chosen via mouse."
(defun ibuffer-included-in-filter-p-1 (buf filter)
(not
(not
- (case (car filter)
- (or
+ (pcase (car filter)
+ (`or
(memq t (mapcar #'(lambda (x)
(ibuffer-included-in-filter-p buf x))
(cdr filter))))
- (saved
+ (`saved
(let ((data
(assoc (cdr filter)
ibuffer-saved-filters)))
(unless data
- (ibuffer-filter-disable)
+ (ibuffer-filter-disable t)
(error "Unknown saved filter %s" (cdr filter)))
(ibuffer-included-in-filters-p buf (cadr data))))
- (t
- (let ((filterdat (assq (car filter)
- ibuffer-filtering-alist)))
- ;; filterdat should be like (TYPE DESCRIPTION FUNC)
- ;; just a sanity check
- (unless filterdat
- (ibuffer-filter-disable)
- (error "Undefined filter %s" (car filter)))
- (not
- (not
- (funcall (caddr filterdat)
- buf
- (cdr filter))))))))))
+ (_
+ (pcase-let ((`(,_type ,_desc ,func)
+ (assq (car filter) ibuffer-filtering-alist)))
+ (unless func
+ (ibuffer-filter-disable t)
+ (error "Undefined filter %s" (car filter)))
+ (funcall func buf (cdr filter))))))))
(defun ibuffer-generate-filter-groups (bmarklist &optional noempty nodefault)
(let ((filter-group-alist (if nodefault
(i 0))
(dolist (filtergroup filter-group-alist)
(let ((filterset (cdr filtergroup)))
- (multiple-value-bind (hip-crowd lamers)
- (values-list
+ (cl-multiple-value-bind (hip-crowd lamers)
+ (cl-values-list
(ibuffer-split-list (lambda (bufmark)
(ibuffer-included-in-filters-p (car bufmark)
filterset))
bmarklist))
(aset vec i hip-crowd)
- (incf i)
+ (cl-incf i)
(setq bmarklist lamers))))
(let (ret)
(dotimes (j i ret)
(if (equal (car groups) group)
(setq found t
groups nil)
- (incf res)
+ (cl-incf res)
(setq groups (cdr groups))))
res)))
(cond ((not found)
The value from `ibuffer-saved-filter-groups' is used."
(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))))
+ (cond ((null ibuffer-saved-filter-groups)
+ (error "No saved filters"))
+ ;; `ibuffer-saved-filter-groups' is a user variable that defaults
+ ;; to nil. We assume that with one element in this list the user
+ ;; knows what she wants. See bug#12331.
+ ((null (cdr ibuffer-saved-filter-groups))
+ (caar ibuffer-saved-filter-groups))
+ (t
+ (completing-read "Switch to saved filter group: "
+ ibuffer-saved-filter-groups nil t)))))
(setq ibuffer-filter-groups (cdr (assoc name ibuffer-saved-filter-groups))
ibuffer-hidden-filter-groups nil)
(ibuffer-update nil t))
;;;###autoload
-(defun ibuffer-filter-disable ()
- "Disable all filters currently in effect in this buffer."
+(defun ibuffer-filter-disable (&optional delete-filter-groups)
+ "Disable all filters currently in effect in this buffer.
+With optional arg DELETE-FILTER-GROUPS non-nil, delete all filter
+group definitions by setting `ibuffer-filter-groups' to nil."
(interactive)
- (setq ibuffer-filtering-qualifiers nil
- ibuffer-filter-groups nil)
+ (setq ibuffer-filtering-qualifiers nil)
+ (if delete-filter-groups
+ (setq ibuffer-filter-groups nil))
(let ((buf (ibuffer-current-buffer)))
(ibuffer-update nil t)
(when buf
(when (null ibuffer-filtering-qualifiers)
(error "No filters in effect"))
(let ((lim (pop ibuffer-filtering-qualifiers)))
- (case (car lim)
- (or
+ (pcase (car lim)
+ (`or
(setq ibuffer-filtering-qualifiers (append
(cdr lim)
ibuffer-filtering-qualifiers)))
- (saved
+ (`saved
(let ((data
(assoc (cdr lim)
ibuffer-saved-filters)))
(setq ibuffer-filtering-qualifiers (append
(cadr data)
ibuffer-filtering-qualifiers))))
- (not
+ (`not
(push (cdr lim)
ibuffer-filtering-qualifiers))
- (t
+ (_
(error "Filter type %s is not compound" (car lim)))))
(ibuffer-update nil t))
(ibuffer-format-qualifier-1 qualifier)))
(defun ibuffer-format-qualifier-1 (qualifier)
- (case (car qualifier)
- (saved
+ (pcase (car qualifier)
+ (`saved
(concat " [filter: " (cdr qualifier) "]"))
- (or
+ (`or
(concat " [OR" (mapconcat #'ibuffer-format-qualifier
(cdr qualifier) "") "]"))
- (t
+ (_
(let ((type (assq (car qualifier) ibuffer-filtering-alist)))
(unless qualifier
(error "Ibuffer: bad qualifier %s" qualifier))
(concat " [" (cadr type) ": " (format "%s]" (cdr qualifier)))))))
-(defun ibuffer-list-buffer-modes ()
- "Create an alist of buffer modes currently in use.
-The list returned will be of the form (\"MODE-NAME\" . MODE-SYMBOL)."
- (let ((bufs (buffer-list))
- (modes)
- (this-mode))
- (while bufs
- (setq this-mode (buffer-local-value 'major-mode (car bufs))
- bufs (cdr bufs))
- (add-to-list
- 'modes
- `(,(symbol-name this-mode) .
- ,this-mode)))
- modes))
+(defun ibuffer-list-buffer-modes (&optional include-parents)
+ "Create a completion table of buffer modes currently in use.
+If INCLUDE-PARENTS is non-nil then include parent modes."
+ (let ((modes))
+ (dolist (buf (buffer-list))
+ (let ((this-mode (buffer-local-value 'major-mode buf)))
+ (while (and this-mode (not (memq this-mode modes)))
+ (push this-mode modes)
+ (setq this-mode (and include-parents
+ (get this-mode 'derived-mode-parent))))))
+ (mapcar #'symbol-name modes)))
;;; Extra operation definitions
"Toggle current view to buffers with major mode QUALIFIER."
(:description "major mode"
:reader
- (intern
- (completing-read "Filter by major mode: " obarray
- #'(lambda (e)
- (string-match "-mode$"
- (symbol-name e)))
- t
- (let ((buf (ibuffer-current-buffer)))
- (if (and buf (buffer-live-p buf))
- (symbol-name (buffer-local-value 'major-mode buf))
- "")))))
+ (let* ((buf (ibuffer-current-buffer))
+ (default (if (and buf (buffer-live-p buf))
+ (symbol-name (buffer-local-value
+ 'major-mode buf)))))
+ (intern
+ (completing-read
+ (if default
+ (format "Filter by major mode (default %s): " default)
+ "Filter by major mode: ")
+ obarray
+ #'(lambda (e)
+ (string-match "-mode\\'" (symbol-name e)))
+ t nil nil default))))
(eq qualifier (buffer-local-value 'major-mode buf)))
;;;###autoload (autoload 'ibuffer-filter-by-used-mode "ibuf-ext")
Called interactively, this function allows selection of modes
currently used by buffers."
(:description "major mode in use"
+ :reader
+ (let* ((buf (ibuffer-current-buffer))
+ (default (if (and buf (buffer-live-p buf))
+ (symbol-name (buffer-local-value
+ 'major-mode buf)))))
+ (intern
+ (completing-read
+ (if default
+ (format "Filter by major mode (default %s): " default)
+ "Filter by major mode: ")
+ (ibuffer-list-buffer-modes) nil t nil nil default))))
+ (eq qualifier (buffer-local-value 'major-mode buf)))
+
+;;;###autoload (autoload 'ibuffer-filter-by-derived-mode "ibuf-ext")
+(define-ibuffer-filter derived-mode
+ "Toggle current view to buffers whose major mode inherits from QUALIFIER."
+ (:description "derived mode"
:reader
(intern
- (completing-read "Filter by major mode: "
- (ibuffer-list-buffer-modes)
- nil
- t
- (let ((buf (ibuffer-current-buffer)))
- (if (and buf (buffer-live-p buf))
- (symbol-name (buffer-local-value
- 'major-mode buf))
- "")))))
- (eq qualifier (buffer-local-value 'major-mode buf)))
+ (completing-read "Filter by derived mode: "
+ (ibuffer-list-buffer-modes t)
+ nil t)))
+ (with-current-buffer buf (derived-mode-p qualifier)))
;;;###autoload (autoload 'ibuffer-filter-by-name "ibuf-ext")
(define-ibuffer-filter name
"Toggle current view to buffers with filename matching QUALIFIER."
(:description "filename"
:reader (read-from-minibuffer "Filter by filename (regexp): "))
- (ibuffer-awhen (buffer-local-value 'buffer-file-name buf)
+ (ibuffer-awhen (with-current-buffer buf (ibuffer-buffer-file-name))
(string-match qualifier it)))
;;;###autoload (autoload 'ibuffer-filter-by-size-gt "ibuf-ext")
(setq direction 1))
;; Skip the title
(ibuffer-forward-line 0)
- (let ((opos (point))
- curmark)
+ (let ((opos (point)))
(ibuffer-forward-line direction)
(while (not (or (= (point) opos)
- (eq (setq curmark (ibuffer-current-mark))
- mark)))
+ (eq (ibuffer-current-mark) mark)))
(ibuffer-forward-line direction))
(when (and (= (point) opos)
(not (eq (ibuffer-current-mark) mark)))
(message "No buffers marked; use 'm' to mark a buffer")
(let ((count
(ibuffer-map-marked-lines
- #'(lambda (buf mark)
+ #'(lambda (_buf _mark)
'kill))))
(message "Killed %s lines" count))))
(let (buf-point)
;; Blindly search for our buffer: it is very likely that it is
;; not in a hidden filter group.
- (ibuffer-map-lines #'(lambda (buf marks)
+ (ibuffer-map-lines #'(lambda (buf _marks)
(when (string= (buffer-name buf) name)
(setq buf-point (point))
nil))
(dolist (group ibuffer-hidden-filter-groups)
(ibuffer-jump-to-filter-group group)
(ibuffer-toggle-filter-group)
- (ibuffer-map-lines #'(lambda (buf marks)
+ (ibuffer-map-lines #'(lambda (buf _marks)
(when (string= (buffer-name buf) name)
(setq buf-point (point))
nil))
(error "No buffer with name %s" name)
(goto-char buf-point)))))
-(declare-function diff-sentinel "diff" (code))
+(declare-function diff-sentinel "diff"
+ (code &optional old-temp-file new-temp-file))
(defun ibuffer-diff-buffer-with-file-1 (buffer)
(let ((bufferfile (buffer-local-value 'buffer-file-name buffer))
(format "Buffer %s" (buffer-name buffer)))))
,(shell-quote-argument (or oldtmp old))
,(shell-quote-argument (or newtmp new)))
- " "))
- proc)
+ " ")))
(let ((inhibit-read-only t))
(insert command "\n")
(diff-sentinel
(call-process shell-file-name nil
(current-buffer) nil
- shell-command-switch command)))
- (insert "\n"))))
+ shell-command-switch command))
+ (insert "\n")))))
(sit-for 0)
(when (file-exists-p tempfile)
(delete-file tempfile)))))
(t
'name))))
(ibuffer-map-marked-lines
- #'(lambda (buf mark)
+ #'(lambda (buf _mark)
(setq ibuffer-copy-filename-as-kill-result
(concat ibuffer-copy-filename-as-kill-result
(let ((name (buffer-file-name buf)))
(if name
- (case type
- (full
+ (pcase type
+ (`full
name)
- (relative
+ (`relative
(file-relative-name
name (or ibuffer-default-directory
default-directory)))
- (t
+ (_
(file-name-nondirectory name)))
""))
" "))))
(defun ibuffer-mark-on-buffer (func &optional ibuffer-mark-on-buffer-mark group)
(let ((count
(ibuffer-map-lines
- #'(lambda (buf mark)
+ #'(lambda (buf _mark)
(when (funcall func buf)
(ibuffer-set-mark-1 (or ibuffer-mark-on-buffer-mark
ibuffer-marked-char))
(defun ibuffer-mark-by-mode (mode)
"Mark all buffers whose major mode equals MODE."
(interactive
- (list (intern (completing-read "Mark by major mode: " obarray
- #'(lambda (e)
- ;; kind of a hack...
- (and (fboundp e)
- (string-match "-mode$"
- (symbol-name e))))
- t
- (let ((buf (ibuffer-current-buffer)))
- (if (and buf (buffer-live-p buf))
- (with-current-buffer buf
- (cons (symbol-name major-mode)
- 0))
- ""))))))
+ (let* ((buf (ibuffer-current-buffer))
+ (default (if (and buf (buffer-live-p buf))
+ (symbol-name (buffer-local-value
+ 'major-mode buf)))))
+ (list (intern
+ (completing-read
+ (if default
+ (format "Mark by major mode (default %s): " default)
+ "Mark by major mode: ")
+ (ibuffer-list-buffer-modes) nil t nil nil default)))))
(ibuffer-mark-on-buffer
#'(lambda (buf)
(eq (buffer-local-value 'major-mode buf) mode))))
;;;###autoload
(defun ibuffer-mark-help-buffers ()
- "Mark buffers like *Help*, *Apropos*, *Info*."
+ "Mark buffers whose major mode is in variable `ibuffer-help-buffer-modes'."
(interactive)
(ibuffer-mark-on-buffer
#'(lambda (buf)
(with-current-buffer buf
;; hacked from midnight.el
(when buffer-display-time
- (let* ((tm (current-time))
- (now (+ (* (float (ash 1 16)) (car tm))
- (float (cadr tm)) (* 0.0000001 (caddr tm))))
- (then (+ (* (float (ash 1 16))
- (car buffer-display-time))
- (float (cadr buffer-display-time))
- (* 0.0000001 (caddr buffer-display-time)))))
+ (let* ((now (float-time))
+ (then (float-time buffer-display-time)))
(> (- now then) (* 60 60 ibuffer-old-time))))))))
;;;###autoload
(let ((ibuffer-do-occur-bufs nil))
;; Accumulate a list of marked buffers
(ibuffer-map-marked-lines
- #'(lambda (buf mark)
+ #'(lambda (buf _mark)
(push buf ibuffer-do-occur-bufs)))
(occur-1 regexp nlines ibuffer-do-occur-bufs)))
;; generated-autoload-file: "ibuffer.el"
;; End:
-;; arch-tag: 9af21953-deda-4c30-b76d-f81d9128e76d
;;; ibuf-ext.el ends here
HCoop / bpt / emacs.git / blobdiff