46 |
(setq alist (delete entry alist))) |
(setq alist (delete entry alist))) |
47 |
alist)) |
alist)) |
48 |
|
|
|
(defun ibuffer-depropertize-string (str &optional nocopy) |
|
|
"Return a copy of STR with text properties removed. |
|
|
If optional argument NOCOPY is non-nil, actually modify the string directly." |
|
|
(let ((str (if nocopy |
|
|
str |
|
|
(copy-sequence str)))) |
|
|
(set-text-properties 0 (length str) nil str) |
|
|
str)) |
|
|
|
|
49 |
(defcustom ibuffer-never-show-predicates nil |
(defcustom ibuffer-never-show-predicates nil |
50 |
"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. |
51 |
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. |
77 |
|
|
78 |
(defvar ibuffer-auto-buffers-changed nil) |
(defvar ibuffer-auto-buffers-changed nil) |
79 |
|
|
|
(defcustom ibuffer-occur-match-face 'font-lock-warning-face |
|
|
"Face used for displaying matched strings for `ibuffer-do-occur'." |
|
|
:type 'face |
|
|
:group 'ibuffer) |
|
|
|
|
80 |
(defcustom ibuffer-saved-filters '(("gnus" |
(defcustom ibuffer-saved-filters '(("gnus" |
81 |
((or (mode . message-mode) |
((or (mode . message-mode) |
82 |
(mode . mail-mode) |
(mode . mail-mode) |
1046 |
(with-current-buffer buf |
(with-current-buffer buf |
1047 |
(eq major-mode 'dired-mode))))) |
(eq major-mode 'dired-mode))))) |
1048 |
|
|
|
;;; An implementation of multi-buffer `occur' |
|
|
|
|
|
(defvar ibuffer-occur-props nil) |
|
|
|
|
|
(define-derived-mode ibuffer-occur-mode occur-mode "Ibuffer-Occur" |
|
|
"A special form of Occur mode for multiple buffers. |
|
|
Note this major mode is not meant for interactive use! |
|
|
See also `occur-mode'." |
|
|
(define-key ibuffer-occur-mode-map (kbd "n") 'forward-line) |
|
|
(define-key ibuffer-occur-mode-map (kbd "q") 'bury-buffer) |
|
|
(define-key ibuffer-occur-mode-map (kbd "p") 'previous-line) |
|
|
(define-key ibuffer-occur-mode-map (kbd "RET") 'ibuffer-occur-display-occurence) |
|
|
(define-key ibuffer-occur-mode-map (kbd "f") 'ibuffer-occur-goto-occurence) |
|
|
(define-key ibuffer-occur-mode-map [(mouse-2)] 'ibuffer-occur-mouse-display-occurence) |
|
|
(set (make-local-variable 'revert-buffer-function) |
|
|
#'ibuffer-occur-revert-buffer-function) |
|
|
(set (make-local-variable 'ibuffer-occur-props) nil) |
|
|
(setq buffer-read-only nil) |
|
|
(erase-buffer) |
|
|
(setq buffer-read-only t) |
|
|
(message (concat |
|
|
"Use RET " |
|
|
(if (or (and (< 21 emacs-major-version) |
|
|
window-system) |
|
|
(featurep 'mouse)) |
|
|
"or mouse-2 ") |
|
|
"to display an occurence."))) |
|
|
|
|
|
(defun ibuffer-occur-mouse-display-occurence (e) |
|
|
"Display occurence on this line in another window." |
|
|
(interactive "e") |
|
|
(let* ((occurbuf (save-window-excursion (mouse-select-window e) |
|
|
(selected-window))) |
|
|
(target (with-current-buffer occurbuf |
|
|
(get-text-property (save-excursion |
|
|
(mouse-set-point e) |
|
|
(point)) |
|
|
'ibuffer-occur-target)))) |
|
|
(unless target |
|
|
(error "No occurence on this line")) |
|
|
(let ((buf (car target)) |
|
|
(line (cdr target))) |
|
|
(switch-to-buffer occurbuf) |
|
|
(delete-other-windows) |
|
|
(pop-to-buffer buf) |
|
|
(goto-line line)))) |
|
|
|
|
|
(defun ibuffer-occur-goto-occurence () |
|
|
"Switch to the buffer which has the occurence on this line." |
|
|
(interactive) |
|
|
(ibuffer-occur-display-occurence t)) |
|
|
|
|
|
(defun ibuffer-occur-display-occurence (&optional goto) |
|
|
"Display occurence on this line in another window." |
|
|
(interactive "P") |
|
|
(let ((target (get-text-property (point) 'ibuffer-occur-target))) |
|
|
(unless target |
|
|
(error "No occurence on this line")) |
|
|
(let ((buf (car target)) |
|
|
(line (cdr target))) |
|
|
(delete-other-windows) |
|
|
(if goto |
|
|
(switch-to-buffer buf) |
|
|
(pop-to-buffer buf)) |
|
|
(goto-line line)))) |
|
|
|
|
1049 |
;;;###autoload |
;;;###autoload |
1050 |
(defun ibuffer-do-occur (regexp &optional nlines) |
(defun ibuffer-do-occur (regexp &optional nlines) |
1051 |
"View lines which match REGEXP in all marked buffers. |
"View lines which match REGEXP in all marked buffers. |
1077 |
(ibuffer-map-marked-lines |
(ibuffer-map-marked-lines |
1078 |
#'(lambda (buf mark) |
#'(lambda (buf mark) |
1079 |
(push buf ibuffer-do-occur-bufs))) |
(push buf ibuffer-do-occur-bufs))) |
1080 |
(ibuffer-do-occur-1 regexp ibuffer-do-occur-bufs |
(occur-1 regexp nlines ibuffer-do-occur-bufs))) |
|
(get-buffer-create "*Ibuffer-occur*") |
|
|
nlines))) |
|
|
|
|
|
(defun ibuffer-do-occur-1 (regexp buffers out-buf nlines) |
|
|
(let ((count (ibuffer-occur-engine regexp buffers out-buf nlines))) |
|
|
(if (> count 0) |
|
|
(progn |
|
|
(switch-to-buffer out-buf) |
|
|
(setq buffer-read-only t) |
|
|
(delete-other-windows) |
|
|
(goto-char (point-min)) |
|
|
(message "Found %s matches in %s buffers" count (length buffers))) |
|
|
(message "No matches found")))) |
|
|
|
|
|
|
|
|
(defun ibuffer-occur-revert-buffer-function (ignore-auto noconfirm) |
|
|
"Update the *Ibuffer occur* buffer." |
|
|
(assert (eq major-mode 'ibuffer-occur-mode)) |
|
|
(ibuffer-do-occur-1 (car ibuffer-occur-props) |
|
|
(cadr ibuffer-occur-props) |
|
|
(current-buffer) |
|
|
(caddr ibuffer-occur-props))) |
|
|
|
|
|
(defun ibuffer-occur-engine (regexp buffers out-buf nlines) |
|
|
(macrolet ((insert-get-point |
|
|
(&rest args) |
|
|
`(progn |
|
|
(insert ,@args) |
|
|
(point))) |
|
|
(maybe-put-overlay |
|
|
(over prop value) |
|
|
`(when (ibuffer-use-fontification) |
|
|
(overlay-put ,over ,prop ,value))) |
|
|
(maybe-ibuffer-propertize |
|
|
(obj &rest args) |
|
|
(let ((objsym (gensym "--maybe-ibuffer-propertize-"))) |
|
|
`(let ((,objsym ,obj)) |
|
|
(if (ibuffer-use-fontification) |
|
|
(propertize ,objsym ,@args) |
|
|
,objsym))))) |
|
|
(with-current-buffer out-buf |
|
|
(ibuffer-occur-mode) |
|
|
(setq buffer-read-only nil) |
|
|
(let ((globalcount 0)) |
|
|
;; Map over all the buffers |
|
|
(dolist (buf buffers) |
|
|
(when (buffer-live-p buf) |
|
|
(let ((c 0) ;; count of matched lines |
|
|
(l 1) ;; line count |
|
|
(headerpt (with-current-buffer out-buf (point)))) |
|
|
(save-excursion |
|
|
(set-buffer buf) |
|
|
(save-excursion |
|
|
(goto-char (point-min)) ;; begin searching in the buffer |
|
|
(while (not (eobp)) |
|
|
;; The line we're matching against |
|
|
(let ((curline (buffer-substring |
|
|
(line-beginning-position) |
|
|
(line-end-position)))) |
|
|
(when (string-match regexp curline) |
|
|
(incf c) ;; increment match count |
|
|
(incf globalcount) |
|
|
;; Depropertize the string, and maybe highlight the matches |
|
|
(setq curline |
|
|
(progn |
|
|
(ibuffer-depropertize-string curline t) |
|
|
(when (ibuffer-use-fontification) |
|
|
(let ((len (length curline)) |
|
|
(start 0)) |
|
|
(while (and (< start len) |
|
|
(string-match regexp curline start)) |
|
|
(put-text-property (match-beginning 0) |
|
|
(match-end 0) |
|
|
'face ibuffer-occur-match-face |
|
|
curline) |
|
|
(setq start (match-end 0))))) |
|
|
curline)) |
|
|
;; Generate the string to insert for this match |
|
|
(let ((data |
|
|
(if (= nlines 1) |
|
|
;; The simple display style |
|
|
(concat (maybe-ibuffer-propertize |
|
|
(format "%-6d:" l) |
|
|
'face 'bold) |
|
|
curline |
|
|
"\n") |
|
|
;; The complex multi-line display style |
|
|
(let ((prevlines (nreverse |
|
|
(ibuffer-accumulate-lines (- nlines)))) |
|
|
(nextlines (ibuffer-accumulate-lines nlines)) |
|
|
;; The lack of `flet' seriously sucks. |
|
|
(fun #'(lambda (lines) |
|
|
(mapcar |
|
|
#'(lambda (line) |
|
|
(concat " :" line "\n")) |
|
|
lines)))) |
|
|
(setq prevlines (funcall fun prevlines)) |
|
|
(setq nextlines (funcall fun nextlines)) |
|
|
;; Yes, I am trying to win the award for the |
|
|
;; most consing. |
|
|
(apply #'concat |
|
|
(nconc |
|
|
prevlines |
|
|
(list |
|
|
(concat |
|
|
(maybe-ibuffer-propertize |
|
|
(format "%-6d" l) |
|
|
'face 'bold) |
|
|
":" |
|
|
curline |
|
|
"\n")) |
|
|
nextlines)))))) |
|
|
;; Actually insert the match display data |
|
|
(with-current-buffer out-buf |
|
|
(let ((beg (point)) |
|
|
(end (insert-get-point |
|
|
data))) |
|
|
(unless (= nlines 1) |
|
|
(insert "-------\n")) |
|
|
(put-text-property |
|
|
beg (1- end) 'ibuffer-occur-target (cons buf l)) |
|
|
(put-text-property |
|
|
beg (1- end) 'mouse-face 'highlight)))))) |
|
|
;; On to the next line... |
|
|
(incf l) |
|
|
(forward-line 1)))) |
|
|
(when (not (zerop c)) ;; is the count zero? |
|
|
(with-current-buffer out-buf |
|
|
(goto-char headerpt) |
|
|
(let ((beg (point)) |
|
|
(end (insert-get-point |
|
|
(format "%d lines matching \"%s\" in buffer %s\n" |
|
|
c regexp (buffer-name buf))))) |
|
|
(let ((o (make-overlay beg end))) |
|
|
(maybe-put-overlay o 'face 'underline))) |
|
|
(goto-char (point-max))))))) |
|
|
(setq ibuffer-occur-props (list regexp buffers nlines)) |
|
|
;; Return the number of matches |
|
|
globalcount)))) |
|
1081 |
|
|
1082 |
(provide 'ibuf-ext) |
(provide 'ibuf-ext) |
1083 |
|
|