comparison lisp/ibuffer.el @ 45687:434d9f56eab8

(ibuffer-category-alist): Delete. (ibuffer-get-category): Delete. (ibuffer-compile-make-eliding-form): Use `font-lock-face' instead of categories. (ibuffer-compile-format): Don't treat `name' category specially. (ibuffer-column name): Use `font-lock-face'. (filename-and-process): Ditto. (ibuffer-buffer-name-category): Renamed to `ibuffer-buffer-name-face'. Don't use categories. (ibuffer-update-title-and-summary): Use `font-lock-face'. (ibuffer-insert-filter-group): Ditto. (ibuffer-mode): Don't set up categories.

45686:25d73d0e2b98

(define-key ibuffer-mode-groups-popup [kill-filter-group]
      '(menu-item "Kill filter group"
		  ibuffer-kill-line
		  :enable (and (featurep 'ibuf-ext) ibuffer-filter-groups)))
(define-key  ibuffer-mode-groups-popup [yank-filter-group]
      '(menu-item "Yank last killed filter group"
		  ibuffer-yank
		  :enable (and (featurep 'ibuf-ext) ibuffer-filter-group-kill-ring)))
 
(defvar ibuffer-name-map nil)

(defvar ibuffer-delete-window-on-quit nil
  "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.

Note: You most likely do not want to modify this variable directly;

		max -1
		align :left
		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
		  `(concat ,ellipsis
			   (substring ,strvar

				    `(insert
				      (let ((ret ,arg))
					(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)))
		   (maxcompform `(> strlen ,(if (integerp max)
						max

(define-ibuffer-column name (:inline t
			     :props
			     ('mouse-face 'highlight 'keymap ibuffer-name-map
	                      'ibuffer-name-column t
 			      'help-echo "mouse-1: mark this buffer\nmouse-2: select this buffer\nmouse-3: operate on this buffer"))
  (buffer-name))
  
(define-ibuffer-column size (:inline t)
  (format "%s" (buffer-size)))

(define-ibuffer-column mode (:inline t

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

    (case alignment
      (:right (concat left right str))
      (: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."
  (assert (eq major-mode 'ibuffer-mode))
  (let ((beg (point)))

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

   (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

  (buffer-disable-undo)
  (setq truncate-lines ibuffer-truncate-lines)
  ;; 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)
       ibuffer-default-sorting-mode)
  (set (make-local-variable 'ibuffer-sorting-reversep)

45687:434d9f56eab8

(define-key ibuffer-mode-groups-popup [kill-filter-group]
      '(menu-item "Kill filter group"
		  ibuffer-kill-line
		  :enable (and (featurep 'ibuf-ext) ibuffer-filter-groups)))
(define-key ibuffer-mode-groups-popup [yank-filter-group]
      '(menu-item "Yank last killed filter group"
		  ibuffer-yank
		  :enable (and (featurep 'ibuf-ext) ibuffer-filter-group-kill-ring)))
 
(defvar ibuffer-name-map nil)

(defvar ibuffer-delete-window-on-quit nil
  "Whether or not to delete the window upon exiting `ibuffer'.")

(defvar ibuffer-did-modification nil)

(defvar ibuffer-sorting-functions-alist nil
  "An alist of functions which describe how to sort buffers.

Note: You most likely do not want to modify this variable directly;

		max -1
		align :left
		elide nil))
	(list sym min max align elide)))
    form))
  
(defun ibuffer-compile-make-eliding-form (strvar elide from-end-p)
  (let ((ellipsis (propertize ibuffer-eliding-string 'font-lock-face 'bold)))
    (if (or elide ibuffer-elide-long-columns)
	`(if (> strlen 5)
	     ,(if from-end-p
		  `(concat ,ellipsis
			   (substring ,strvar

				    `(insert
				      (let ((ret ,arg))
					(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)))
		   (maxcompform `(> strlen ,(if (integerp max)
						max

(define-ibuffer-column name (:inline t
			     :props
			     ('mouse-face 'highlight 'keymap ibuffer-name-map
	                      'ibuffer-name-column t
 			      'help-echo "mouse-1: mark this buffer\nmouse-2: select this buffer\nmouse-3: operate on this buffer"))
  (propertize (buffer-name) 'font-lock-face (ibuffer-buffer-name-face buffer mark)))
  
(define-ibuffer-column size (:inline t)
  (format "%s" (buffer-size)))

(define-ibuffer-column mode (:inline t

(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))
			    'font-lock-face 'italic)
		filename)
      filename)))

(defun ibuffer-format-column (str width alignment)
  (let ((left (make-string (/ width 2) ? ))

    (case alignment
      (:right (concat left right str))
      (:center (concat left str right))
      (t (concat str left right)))))

(defun ibuffer-buffer-name-face (buf mark)
  (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 (nth 1 e))))
	       (setq level (car e)
		     result (nth 2 e))))))))

(defun ibuffer-insert-buffer-line (buffer mark format)
  "Insert a line describing BUFFER and MARK using FORMAT."
  (assert (eq major-mode 'ibuffer-mode))
  (let ((beg (point)))

				    ?-
				  ? ))
			    str)))
	 (insert "\n"))
       (point))
     `(ibuffer-title t font-lock-face ,ibuffer-title-face))
    ;; 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)

   (progn
     (insert "[ " display-name " ]")
     (point))
   `(ibuffer-filter-group-name
     ,name
     font-lock-face ,ibuffer-filter-group-name-face
     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

  (buffer-disable-undo)
  (setq truncate-lines ibuffer-truncate-lines)
  ;; 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 'revert-buffer-function)
       #'ibuffer-update)
  (set (make-local-variable 'ibuffer-sorting-mode)
       ibuffer-default-sorting-mode)
  (set (make-local-variable 'ibuffer-sorting-reversep)