--- replace.el.~1.143.~ Thu May 16 17:58:21 2002 +++ replace.el Sun May 19 00:44:36 2002 @@ -453,6 +453,11 @@ "Arguments to pass to `occur-1' to revert an Occur mode buffer. See `occur-revert-function'.") +(defcustom occur-mode-hook '(font-lock-mode) + "Hooks run when `occur' is called." + :type 'hook + :group 'matching) + (put 'occur-mode 'mode-class 'special) (defun occur-mode () "Major mode for output from \\[occur]. @@ -466,10 +471,9 @@ (setq major-mode 'occur-mode) (setq mode-name "Occur") (make-local-variable 'revert-buffer-function) - (set (make-local-variable 'font-lock-defaults) - '(nil t nil nil nil - (font-lock-fontify-region-function . occur-fontify-region-function))) - (setq revert-buffer-function 'occur-revert-function) + (set (make-local-variable 'font-lock-category-alist) + `((,(make-symbol "occur-match") . bold) + (,(make-symbol "occur-title") . underline))) (set (make-local-variable 'revert-buffer-function) 'occur-revert-function) (make-local-variable 'occur-revert-arguments) (run-hooks 'occur-mode-hook)) @@ -777,6 +781,8 @@ ;; Depropertize the string, and maybe ;; highlight the matches (let ((len (length curstring)) + (match-category (with-current-buffer out-buf + (car (nth 0 font-lock-category-alist)))) (start 0)) (unless keep-props (set-text-properties 0 len nil curstring)) @@ -785,7 +791,7 @@ (add-text-properties (match-beginning 0) (match-end 0) (append - '(occur-match t) + `(occur-match t category ,match-category) (when match-face `(face ,match-face))) curstring) @@ -842,35 +848,12 @@ (append (when title-face `(face ,title-face)) - `(occur-title ,buf)))) + `(occur-title + ,buf category + ,(car (nth 1 font-lock-category-alist)))))) (goto-char (point-min))))))) ;; Return the number of matches globalcount))) - -(defun occur-fontify-on-property (prop face beg end) - (let ((prop-beg (or (and (get-text-property (point) prop) (point)) - (next-single-property-change (point) prop nil end)))) - (when (and prop-beg (not (= prop-beg end))) - (let ((prop-end (next-single-property-change beg prop nil end))) - (when (and prop-end (not (= prop-end end))) - (put-text-property prop-beg prop-end 'face face) - prop-end))))) - -(defun occur-fontify-region-function (beg end &optional verbose) - (when verbose (message "Fontifying...")) - (let ((inhibit-read-only t)) - (save-excursion - (dolist (e `((occur-title . ,list-matching-lines-buffer-name-face) - (occur-match . ,list-matching-lines-face))) - ; (occur-prefix . ,list-matching-lines-prefix-face))) - (goto-char beg) - (let ((change-end nil)) - (while (setq change-end (occur-fontify-on-property (car e) - (cdr e) - (point) - end)) - (goto-char change-end)))))) - (when verbose (message "Fontifying...done"))) ;; It would be nice to use \\[...], but there is no reasonable way --- ibuffer.el.~1.29.~ Mon May 13 01:58:15 2002 +++ ibuffer.el Sun May 19 01:18:51 2002 @@ -36,6 +36,8 @@ (require 'ibuf-macs) (require 'dired)) +(require 'font-lock) + ;;; Compatibility (eval-and-compile (if (fboundp 'window-list) @@ -44,18 +46,7 @@ (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)))) + (nreverse ibuffer-window-list-result))))) (defgroup ibuffer nil "An advanced replacement for `buffer-menu'. @@ -67,7 +58,7 @@ (defcustom ibuffer-formats '((mark modified read-only " " (name 16 16 :left :elide) " " (size 6 -1 :right) - " " (mode 16 16 :right :elide) " " filename) + " " (mode 16 16 :right :elide) " " filename-and-process) (mark " " (name 16 -1) " " filename)) "A list of ways to display buffer lines. @@ -152,7 +143,10 @@ 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." +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") @@ -328,6 +322,8 @@ (regexp :tag "To"))) :group 'ibuffer) +(defvar ibuffer-category-obarray nil) + (defvar ibuffer-mode-map nil) (defvar ibuffer-mode-operate-map nil) (defvar ibuffer-mode-groups-popup nil) @@ -1361,9 +1357,9 @@ 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))) + (let ((ellipsis (propertize ibuffer-eliding-string 'category + (intern "ibuffer-eliding-string" + ibuffer-category-obarray)))) (if (or elide ibuffer-elide-long-columns) `(if (> strlen 5) ,(if from-end-p @@ -1474,8 +1470,16 @@ (put ',sym 'ibuffer-column-summary (cons ret (get ',sym 'ibuffer-column-summary))) ret))) - (lambda (arg sym) - `(insert ,arg)))) + ;; 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,6 +1637,13 @@ dired-directory) "")))) +(define-ibuffer-column filename-and-process (:name "Filename/Process") + (let ((proc (get-buffer-process buffer)) + (filename (ibuffer-make-column-filename buffer mark))) + (if proc + (format "(%s %s) %s" proc (process-status proc) filename) + filename))) + (defun ibuffer-format-column (str width alignment) (let ((left (make-string (/ width 2) ? )) (right (make-string (- width (/ width 2)) ? ))) @@ -1641,52 +1652,23 @@ (: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-buffer-name-category (buf mark) + (cond ((char-equal mark ibuffer-marked-char) + (intern "ibuffer-category-marked" ibuffer-category-obarray)) + ((char-equal mark ibuffer-deletion-char) + (intern "ibuffer-category-deleted" ibuffer-category-obarray)) + (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 (intern (format "ibuffer-category-%d" i) + ibuffer-category-obarray))) + (incf i)))))) (defun ibuffer-insert-buffer-line (buffer mark format) "Insert a line describing BUFFER and MARK using FORMAT." @@ -1898,7 +1880,7 @@ (next-single-property-change (point-min) 'ibuffer-title))) (goto-char (point-min)) - (put-text-property + (add-text-properties (point) (progn (let ((opos (point))) @@ -1922,7 +1904,10 @@ (- min len) align) name)))))) - (put-text-property opos (point) 'ibuffer-title-header t) + (add-text-properties opos (point) `(ibuffer-title-header + t category + ,(intern "ibuffer-title-header" + ibuffer-category-obarray))) (insert "\n") ;; Add the underlines (let ((str (save-excursion @@ -1938,14 +1923,14 @@ str))) (insert "\n")) (point)) - 'ibuffer-title t) + `(ibuffer-title t category ,(intern "ibuffer-title" ibuffer-category-obarray))) ;; 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 + (add-text-properties (point) (progn (insert "\n") @@ -1972,7 +1957,8 @@ align) summary))))))) (point)) - 'ibuffer-summary t))) + `(ibuffer-summary t category ,(intern "ibuffer-summary" + ibuffer-category-obarray))))) (defun ibuffer-update-mode-name () (setq mode-name (format "Ibuffer by %s" (if ibuffer-sorting-mode @@ -2080,9 +2066,12 @@ (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 "))) + `(ibuffer-filter-group-name + ,name + category ,(intern "ibuffer-filter-group-name" ibuffer-category-obarray) + 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,7 +2158,7 @@ ;;;###autoload (defun ibuffer (&optional other-window-p name qualifiers noselect - shrink filter-groups) + shrink filter-groups formats) "Begin using `ibuffer' to edit a list of buffers. Type 'h' after entering ibuffer for more information. @@ -2182,7 +2171,10 @@ 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'." +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,8 +2192,6 @@ (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)) @@ -2211,6 +2201,8 @@ (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,12 +2398,25 @@ ;; 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 'ibuffer-category-obarray) (make-vector 17 0)) + + (set (make-local-variable 'font-lock-category-alist) + (list + (cons (intern "ibuffer-title" ibuffer-category-obarray) + ibuffer-title-face) + (cons (intern "ibuffer-category-marked" ibuffer-category-obarray) + ibuffer-marked-face) + (cons (intern "ibuffer-category-deleted" ibuffer-category-obarray) + ibuffer-deletion-face) + (cons (intern "ibuffer-filter-group-name" ibuffer-category-obarray) + ibuffer-filter-group-name-face) + (cons (intern "ibuffer-eliding-string" ibuffer-category-obarray) + 'bold))) + (dotimes (i (length ibuffer-fontification-alist)) + (push (cons (intern (format "ibuffer-category-%d" i) ibuffer-category-obarray) + (nth 2 (nth i ibuffer-fontification-alist))) + font-lock-category-alist)) (set (make-local-variable 'revert-buffer-function) #'ibuffer-update) (set (make-local-variable 'ibuffer-sorting-mode)