[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] Changes to emacs/lisp/ibuffer.el
|
From: |
Colin Walters |
|
Subject: |
[Emacs-diffs] Changes to emacs/lisp/ibuffer.el |
|
Date: |
Tue, 21 May 2002 16:59:28 -0400 |
Index: emacs/lisp/ibuffer.el
diff -c emacs/lisp/ibuffer.el:1.29 emacs/lisp/ibuffer.el:1.30
*** emacs/lisp/ibuffer.el:1.29 Mon May 13 02:00:06 2002
--- emacs/lisp/ibuffer.el Tue May 21 16:59:28 2002
***************
*** 36,41 ****
--- 36,43 ----
(require 'ibuf-macs)
(require 'dired))
+ (require 'font-lock)
+
;;; Compatibility
(eval-and-compile
(if (fboundp 'window-list)
***************
*** 44,61 ****
(defun ibuffer-window-list ()
(let ((ibuffer-window-list-result nil))
(walk-windows #'(lambda (win) (push win ibuffer-window-list-result))
'nomini)
! (nreverse ibuffer-window-list-result))))
!
! (cond ((boundp 'global-font-lock-mode)
! (defsubst ibuffer-use-fontification ()
! (when (boundp 'font-lock-mode)
! font-lock-mode)))
! ((boundp 'font-lock-auto-fontify)
! (defsubst ibuffer-use-fontification ()
! font-lock-auto-fontify))
! (t
! (defsubst ibuffer-use-fontification ()
! nil))))
(defgroup ibuffer nil
"An advanced replacement for `buffer-menu'.
--- 46,52 ----
(defun ibuffer-window-list ()
(let ((ibuffer-window-list-result nil))
(walk-windows #'(lambda (win) (push win ibuffer-window-list-result))
'nomini)
! (nreverse ibuffer-window-list-result)))))
(defgroup ibuffer nil
"An advanced replacement for `buffer-menu'.
***************
*** 67,73 ****
(defcustom ibuffer-formats '((mark modified read-only " " (name 16 16 :left
:elide)
" " (size 6 -1 :right)
! " " (mode 16 16 :right :elide) " " filename)
(mark " " (name 16 -1) " " filename))
"A list of ways to display buffer lines.
--- 58,64 ----
(defcustom ibuffer-formats '((mark modified read-only " " (name 16 16 :left
:elide)
" " (size 6 -1 :right)
! " " (mode 16 16 :right :elide) " "
filename-and-process)
(mark " " (name 16 -1) " " filename))
"A list of ways to display buffer lines.
***************
*** 152,158 ****
PRIORITY is an integer, FORM is an arbitrary form to evaluate in the
buffer, and FACE is the face to use for fontification. If the FORM
evaluates to non-nil, then FACE will be put on the buffer name. The
! element with the highest PRIORITY takes precedence."
:type '(repeat
(list (integer :tag "Priority")
(sexp :tag "Test Form")
--- 143,152 ----
PRIORITY is an integer, FORM is an arbitrary form to evaluate in the
buffer, and FACE is the face to use for fontification. If the FORM
evaluates to non-nil, then FACE will be put on the buffer name. The
! element with the highest PRIORITY takes precedence.
!
! If you change this variable, you must kill the ibuffer buffer and
! recreate it for the change to take effect."
:type '(repeat
(list (integer :tag "Priority")
(sexp :tag "Test Form")
***************
*** 756,762 ****
(defvar ibuffer-name-map nil)
(unless ibuffer-name-map
(let ((map (make-sparse-keymap)))
- (set-keymap-parent map ibuffer-mode-map)
(define-key map [(mouse-1)] 'ibuffer-mouse-toggle-mark)
(define-key map [(mouse-2)] 'ibuffer-mouse-visit-buffer)
(define-key map [down-mouse-3] 'ibuffer-mouse-popup-menu)
--- 750,755 ----
***************
*** 765,771 ****
(defvar ibuffer-mode-name-map nil)
(unless ibuffer-mode-name-map
(let ((map (make-sparse-keymap)))
- (set-keymap-parent map ibuffer-mode-map)
(define-key map [(mouse-2)] 'ibuffer-mouse-filter-by-mode)
(define-key map (kbd "RET") 'ibuffer-interactive-filter-by-mode)
(setq ibuffer-mode-name-map map)))
--- 758,763 ----
***************
*** 773,779 ****
(defvar ibuffer-mode-filter-group-map nil)
(unless ibuffer-mode-filter-group-map
(let ((map (make-sparse-keymap)))
- (set-keymap-parent map ibuffer-mode-map)
(define-key map [(mouse-1)] 'ibuffer-mouse-toggle-mark)
(define-key map [(mouse-2)] 'ibuffer-mouse-toggle-filter-group)
(define-key map (kbd "RET") 'ibuffer-toggle-filter-group)
--- 765,770 ----
***************
*** 786,791 ****
--- 777,783 ----
"Whether or not to delete the window upon exiting `ibuffer'.")
(defvar ibuffer-did-modification nil)
+ (defvar ibuffer-category-alist nil)
(defvar ibuffer-sorting-functions-alist nil
"An alist of functions which describe how to sort buffers.
***************
*** 1137,1143 ****
(defsubst ibuffer-map-deletion-lines (func)
(ibuffer-map-on-mark ibuffer-deletion-char func))
! (define-ibuffer-op save ()
"Save marked buffers as with `save-buffer'."
(:complex t
:opstring "saved"
--- 1129,1135 ----
(defsubst ibuffer-map-deletion-lines (func)
(ibuffer-map-on-mark ibuffer-deletion-char func))
! (define-ibuffer-op ibuffer-do-save ()
"Save marked buffers as with `save-buffer'."
(:complex t
:opstring "saved"
***************
*** 1154,1172 ****
(save-buffer))))
t)
! (define-ibuffer-op toggle-modified ()
"Toggle modification flag of marked buffers."
(:opstring "(un)marked as modified"
:modifier-p t)
(set-buffer-modified-p (not (buffer-modified-p))))
! (define-ibuffer-op toggle-read-only ()
"Toggle read only status in marked buffers."
(:opstring "toggled read only status in"
:modifier-p t)
(toggle-read-only))
! (define-ibuffer-op delete ()
"Kill marked buffers as with `kill-this-buffer'."
(:opstring "killed"
:active-opstring "kill"
--- 1146,1164 ----
(save-buffer))))
t)
! (define-ibuffer-op ibuffer-do-toggle-modified ()
"Toggle modification flag of marked buffers."
(:opstring "(un)marked as modified"
:modifier-p t)
(set-buffer-modified-p (not (buffer-modified-p))))
! (define-ibuffer-op ibuffer-do-toggle-read-only ()
"Toggle read only status in marked buffers."
(:opstring "toggled read only status in"
:modifier-p t)
(toggle-read-only))
! (define-ibuffer-op ibuffer-do-delete ()
"Kill marked buffers as with `kill-this-buffer'."
(:opstring "killed"
:active-opstring "kill"
***************
*** 1177,1183 ****
'kill
nil))
! (define-ibuffer-op kill-on-deletion-marks ()
"Kill buffers marked for deletion as with `kill-this-buffer'."
(:opstring "killed"
:active-opstring "kill"
--- 1169,1175 ----
'kill
nil))
! (define-ibuffer-op ibuffer-do-kill-on-deletion-marks ()
"Kill buffers marked for deletion as with `kill-this-buffer'."
(:opstring "killed"
:active-opstring "kill"
***************
*** 1359,1369 ****
elide nil))
(list sym min max align elide)))
form))
(defun ibuffer-compile-make-eliding-form (strvar elide from-end-p)
! (let ((ellipsis (if (ibuffer-use-fontification)
! (propertize ibuffer-eliding-string 'face 'bold)
! ibuffer-eliding-string)))
(if (or elide ibuffer-elide-long-columns)
`(if (> strlen 5)
,(if from-end-p
--- 1351,1364 ----
elide nil))
(list sym min max align elide)))
form))
+
+ (defsubst ibuffer-get-category (name)
+ (cdr (assq name ibuffer-category-alist)))
(defun ibuffer-compile-make-eliding-form (strvar elide from-end-p)
! (let ((ellipsis (propertize ibuffer-eliding-string 'category
! (ibuffer-get-category
! 'ibuffer-category-eliding-string))))
(if (or elide ibuffer-elide-long-columns)
`(if (> strlen 5)
,(if from-end-p
***************
*** 1462,1468 ****
;; generate a call to the column function.
(ibuffer-aif (assq sym ibuffer-inline-columns)
(nth 1 it)
! `(,sym buffer mark)))
;; You're not expected to understand this. Hell, I
;; don't even understand it, and I wrote it five
;; minutes ago.
--- 1457,1463 ----
;; generate a call to the column function.
(ibuffer-aif (assq sym ibuffer-inline-columns)
(nth 1 it)
! `(,sym buffer mark (current-buffer))))
;; You're not expected to understand this. Hell, I
;; don't even understand it, and I wrote it five
;; minutes ago.
***************
*** 1474,1481 ****
(put ',sym 'ibuffer-column-summary
(cons ret (get ',sym
'ibuffer-column-summary)))
ret)))
! (lambda (arg sym)
! `(insert ,arg))))
(mincompform `(< strlen ,(if (integerp min)
min
'min)))
--- 1469,1484 ----
(put ',sym 'ibuffer-column-summary
(cons ret (get ',sym
'ibuffer-column-summary)))
ret)))
! ;; We handle the `name' column specially.
! (if (eq sym 'ibuffer-make-column-name)
! (lambda (arg sym)
! `(let ((pt (point)))
! (insert ,arg)
! (put-text-property pt (point)
! 'category
!
(ibuffer-buffer-name-category buffer mark))))
! (lambda (arg sym)
! `(insert ,arg)))))
(mincompform `(< strlen ,(if (integerp min)
min
'min)))
***************
*** 1633,1638 ****
--- 1636,1652 ----
dired-directory)
""))))
+ (define-ibuffer-column filename-and-process (:name "Filename/Process")
+ (let ((proc (get-buffer-process buffer))
+ (filename (ibuffer-make-column-filename buffer mark ibuffer-buf)))
+ (if proc
+ (concat (propertize (format "(%s %s) " proc (process-status proc))
+ 'category
+ (with-current-buffer ibuffer-buf
+ (ibuffer-get-category 'ibuffer-category-process)))
+ filename)
+ filename)))
+
(defun ibuffer-format-column (str width alignment)
(let ((left (make-string (/ width 2) ? ))
(right (make-string (- width (/ width 2)) ? )))
***************
*** 1641,1692 ****
(:center (concat left str right))
(t (concat str left right)))))
! (defun ibuffer-fontify-region-function (beg end &optional verbose)
! (when verbose (message "Fontifying..."))
! (let ((inhibit-read-only t))
! (save-excursion
! (goto-char beg)
! (beginning-of-line)
! (while (< (point) end)
! (if (get-text-property (point) 'ibuffer-title-header)
! (put-text-property (point) (line-end-position) 'face
ibuffer-title-face)
! (if (get-text-property (point) 'ibuffer-filter-group-name)
! (put-text-property (point) (line-end-position) 'face
! ibuffer-filter-group-name-face)
! (unless (or (get-text-property (point) 'ibuffer-title)
! (get-text-property (point) 'ibuffer-summary))
! (multiple-value-bind (buf mark)
! (get-text-property (point) 'ibuffer-properties)
! (let* ((namebeg (next-single-property-change (point)
'ibuffer-name-column
! nil
(line-end-position)))
! (nameend (next-single-property-change namebeg
'ibuffer-name-column
! nil
(line-end-position))))
! (put-text-property namebeg
! nameend
! 'face
! (cond ((char-equal mark
ibuffer-marked-char)
! ibuffer-marked-face)
! ((char-equal mark
ibuffer-deletion-char)
! ibuffer-deletion-face)
! (t
! (let ((level -1)
! result)
! (dolist (e
ibuffer-fontification-alist result)
! (when (and (> (car e) level)
! (with-current-buffer
buf
! (eval (cadr e))))
! (setq level (car e)
! result
! (if (symbolp (caddr e))
! (if (facep (caddr
e))
! (caddr e)
! (symbol-value
(caddr e))))))))))))))))
! (forward-line 1))))
! (when verbose (message "Fontifying...done")))
!
! (defun ibuffer-unfontify-region-function (beg end)
! (let ((inhibit-read-only t))
! (remove-text-properties beg end '(face nil))))
(defun ibuffer-insert-buffer-line (buffer mark format)
"Insert a line describing BUFFER and MARK using FORMAT."
--- 1655,1676 ----
(:center (concat left str right))
(t (concat str left right)))))
! (defun ibuffer-buffer-name-category (buf mark)
! (cond ((char-equal mark ibuffer-marked-char)
! (ibuffer-get-category 'ibuffer-category-marked))
! ((char-equal mark ibuffer-deletion-char)
! (ibuffer-get-category 'ibuffer-category-deleted))
! (t
! (let ((level -1)
! (i 0)
! result)
! (dolist (e ibuffer-fontification-alist result)
! (when (and (> (car e) level)
! (with-current-buffer buf
! (eval (cadr e))))
! (setq level (car e)
! result (car (nth i font-lock-category-alist))))
! (incf i))))))
(defun ibuffer-insert-buffer-line (buffer mark format)
"Insert a line describing BUFFER and MARK using FORMAT."
***************
*** 1898,1904 ****
(next-single-property-change
(point-min) 'ibuffer-title)))
(goto-char (point-min))
! (put-text-property
(point)
(progn
(let ((opos (point)))
--- 1882,1888 ----
(next-single-property-change
(point-min) 'ibuffer-title)))
(goto-char (point-min))
! (add-text-properties
(point)
(progn
(let ((opos (point)))
***************
*** 1922,1928 ****
(- min len)
align)
name))))))
! (put-text-property opos (point) 'ibuffer-title-header t)
(insert "\n")
;; Add the underlines
(let ((str (save-excursion
--- 1906,1912 ----
(- min len)
align)
name))))))
! (add-text-properties opos (point) `(ibuffer-title-header t))
(insert "\n")
;; Add the underlines
(let ((str (save-excursion
***************
*** 1938,1951 ****
str)))
(insert "\n"))
(point))
! 'ibuffer-title t)
;; Now, insert the summary columns.
(goto-char (point-max))
(if (get-text-property (1- (point-max)) 'ibuffer-summary)
(delete-region (previous-single-property-change
(point-max) 'ibuffer-summary)
(point-max)))
! (put-text-property
(point)
(progn
(insert "\n")
--- 1922,1935 ----
str)))
(insert "\n"))
(point))
! `(ibuffer-title t category ,(ibuffer-get-category
'ibuffer-category-title)))
;; Now, insert the summary columns.
(goto-char (point-max))
(if (get-text-property (1- (point-max)) 'ibuffer-summary)
(delete-region (previous-single-property-change
(point-max) 'ibuffer-summary)
(point-max)))
! (add-text-properties
(point)
(progn
(insert "\n")
***************
*** 1972,1978 ****
align)
summary)))))))
(point))
! 'ibuffer-summary t)))
(defun ibuffer-update-mode-name ()
(setq mode-name (format "Ibuffer by %s" (if ibuffer-sorting-mode
--- 1956,1962 ----
align)
summary)))))))
(point))
! `(ibuffer-summary t))))
(defun ibuffer-update-mode-name ()
(setq mode-name (format "Ibuffer by %s" (if ibuffer-sorting-mode
***************
*** 2080,2088 ****
(progn
(insert "[ " display-name " ]")
(point))
! `(ibuffer-filter-group-name ,name keymap ,ibuffer-mode-filter-group-map
! mouse-face highlight
! help-echo ,(concat filter-string "mouse-1:
toggle marks in this group\nmouse-2: hide/show this filtering group ")))
(insert "\n")
(when bmarklist
(put-text-property
--- 2064,2075 ----
(progn
(insert "[ " display-name " ]")
(point))
! `(ibuffer-filter-group-name
! ,name
! category ,(ibuffer-get-category 'ibuffer-category-filter-group-name)
! keymap ,ibuffer-mode-filter-group-map
! mouse-face highlight
! help-echo ,(concat filter-string "mouse-1: toggle marks in this
group\nmouse-2: hide/show this filtering group ")))
(insert "\n")
(when bmarklist
(put-text-property
***************
*** 2169,2175 ****
;;;###autoload
(defun ibuffer (&optional other-window-p name qualifiers noselect
! shrink filter-groups)
"Begin using `ibuffer' to edit a list of buffers.
Type 'h' after entering ibuffer for more information.
--- 2156,2162 ----
;;;###autoload
(defun ibuffer (&optional other-window-p name qualifiers noselect
! shrink filter-groups formats)
"Begin using `ibuffer' to edit a list of buffers.
Type 'h' after entering ibuffer for more information.
***************
*** 2182,2188 ****
Optional argument SHRINK means shrink the buffer to minimal size. The
special value `onewindow' means always use another window.
Optional argument FILTER-GROUPS is an initial set of filtering
! groups to use; see `ibuffer-filter-groups'."
(interactive "P")
(when ibuffer-use-other-window
(setq other-window-p t))
--- 2169,2178 ----
Optional argument SHRINK means shrink the buffer to minimal size. The
special value `onewindow' means always use another window.
Optional argument FILTER-GROUPS is an initial set of filtering
! groups to use; see `ibuffer-filter-groups'.
! Optional argument FORMATS is the value to use for `ibuffer-formats'.
! If specified, then the variable `ibuffer-formats' will have that value
! locally in this buffer."
(interactive "P")
(when ibuffer-use-other-window
(setq other-window-p t))
***************
*** 2200,2207 ****
(unless (eq major-mode 'ibuffer-mode)
(ibuffer-mode)
(setq need-update t))
- (when (ibuffer-use-fontification)
- (require 'font-lock))
(setq ibuffer-delete-window-on-quit other-window-p)
(when shrink
(setq ibuffer-shrink-to-minimum-size shrink))
--- 2190,2195 ----
***************
*** 2211,2216 ****
--- 2199,2206 ----
(when filter-groups
(require 'ibuf-ext)
(setq ibuffer-filter-groups filter-groups))
+ (when formats
+ (set (make-local-variable 'ibuffer-formats) formats))
(ibuffer-update nil)
;; Skip the group name by default.
(ibuffer-forward-line 0 t)
***************
*** 2406,2417 ****
;; This makes things less ugly for Emacs 21 users with a non-nil
;; `show-trailing-whitespace'.
(setq show-trailing-whitespace nil)
! ;; Dummy font-lock-defaults to make font-lock turn on. We want this
! ;; so we know when to enable ibuffer's internal fontification.
! (set (make-local-variable 'font-lock-defaults)
! '(nil t nil nil nil
! (font-lock-fontify-region-function .
ibuffer-fontify-region-function)
! (font-lock-unfontify-region-function .
ibuffer-unfontify-region-function)))
(set (make-local-variable 'revert-buffer-function)
#'ibuffer-update)
(set (make-local-variable 'ibuffer-sorting-mode)
--- 2396,2425 ----
;; This makes things less ugly for Emacs 21 users with a non-nil
;; `show-trailing-whitespace'.
(setq show-trailing-whitespace nil)
!
! (set (make-local-variable 'font-lock-category-alist) nil)
! (set (make-local-variable 'ibuffer-category-alist) nil)
! (dolist (elt (list
! (cons (make-symbol "ibuffer-category-title")
! ibuffer-title-face)
! (cons (make-symbol "ibuffer-category-marked")
! ibuffer-marked-face)
! (cons (make-symbol "ibuffer-category-deleted")
! ibuffer-deletion-face)
! (cons (make-symbol "ibuffer-category-filter-group-name")
! ibuffer-filter-group-name-face)
! (cons (make-symbol "ibuffer-category-process")
! 'italic)
! (cons (make-symbol "ibuffer-category-eliding-string")
! 'bold)))
! (push (cons (intern (symbol-name (car elt))) (car elt))
ibuffer-category-alist)
! (push elt font-lock-category-alist))
! (let ((i (1- (length ibuffer-fontification-alist))))
! (while (>= i 0)
! (push (cons (make-symbol (format "ibuffer-category-%d" i))
! (nth 2 (nth i ibuffer-fontification-alist)))
! font-lock-category-alist)
! (decf i)))
(set (make-local-variable 'revert-buffer-function)
#'ibuffer-update)
(set (make-local-variable 'ibuffer-sorting-mode)