+(defun Buffer-menu-bury ()
+ "Bury the buffer listed on this line."
+ (interactive)
+ (when (Buffer-menu-no-header)
+ (save-excursion
+ (beginning-of-line)
+ (bury-buffer (Buffer-menu-buffer t))
+ (let ((line (buffer-substring (point) (progn (forward-line 1) (point))))
+ (buffer-read-only nil))
+ (delete-region (point) (progn (forward-line -1) (point)))
+ (goto-char (point-max))
+ (insert line))
+ (message "Buried buffer moved to the end"))))
+
+
+(defun Buffer-menu-view ()
+ "View this line's buffer in View mode."
+ (interactive)
+ (view-buffer (Buffer-menu-buffer t)))
+
+
+(defun Buffer-menu-view-other-window ()
+ "View this line's buffer in View mode in another window."
+ (interactive)
+ (view-buffer-other-window (Buffer-menu-buffer t)))
+\f
+
+(define-key ctl-x-map "\C-b" 'list-buffers)
+
+(defun list-buffers (&optional files-only)
+ "Display a list of names of existing buffers.
+The list is displayed in a buffer named `*Buffer List*'.
+Note that buffers with names starting with spaces are omitted.
+Non-null optional arg FILES-ONLY means mention only file buffers.
+
+For more information, see the function `buffer-menu'."
+ (interactive "P")
+ (display-buffer (list-buffers-noselect files-only)))
+
+(defun Buffer-menu-buffer+size (name size &optional name-props size-props)
+ (if (> (+ (length name) (length size) 2) Buffer-menu-buffer+size-width)
+ (setq name
+ (if (string-match "<[0-9]+>$" name)
+ (concat (substring name 0
+ (- Buffer-menu-buffer+size-width
+ (max (length size) 3)
+ (match-end 0)
+ (- (match-beginning 0))
+ 2))
+ ":" ; narrow ellipsis
+ (match-string 0 name))
+ (concat (substring name 0
+ (- Buffer-menu-buffer+size-width
+ (max (length size) 3)
+ 2))
+ ":"))) ; narrow ellipsis
+ ;; Don't put properties on (buffer-name).
+ (setq name (copy-sequence name)))
+ (add-text-properties 0 (length name) name-props name)
+ (add-text-properties 0 (length size) size-props size)
+ (concat name
+ (make-string (- Buffer-menu-buffer+size-width
+ (length name)
+ (length size))
+ ?\s)
+ size))
+
+(defun Buffer-menu-sort (column)
+ "Sort the buffer menu by COLUMN."
+ (interactive "P")
+ (when column
+ (setq column (prefix-numeric-value column))
+ (if (< column 2) (setq column 2))
+ (if (> column 5) (setq column 5)))
+ (setq Buffer-menu-sort-column column)
+ (let (buffer-read-only l buf m1 m2)
+ (save-excursion
+ (Buffer-menu-beginning)
+ (while (not (eobp))
+ (when (buffer-live-p (setq buf (get-text-property (+ (point) 4) 'buffer)))
+ (setq m1 (char-after)
+ m1 (if (memq m1 '(?> ?D)) m1)
+ m2 (char-after (+ (point) 2))
+ m2 (if (eq m2 ?S) m2))
+ (if (or m1 m2)
+ (push (list buf m1 m2) l)))
+ (forward-line)))
+ (Buffer-menu-revert)
+ (setq buffer-read-only)
+ (save-excursion
+ (Buffer-menu-beginning)
+ (while (not (eobp))
+ (when (setq buf (assq (get-text-property (+ (point) 4) 'buffer) l))
+ (setq m1 (cadr buf)
+ m2 (cadr (cdr buf)))
+ (when m1
+ (delete-char 1)
+ (insert m1)
+ (backward-char 1))
+ (when m2
+ (forward-char 2)
+ (delete-char 1)
+ (insert m2)))
+ (forward-line)))))
+
+(defun Buffer-menu-make-sort-button (name column)
+ (if (equal column Buffer-menu-sort-column) (setq column nil))
+ (propertize name
+ 'help-echo (if column
+ (if Buffer-menu-use-header-line
+ (concat "mouse-2: sort by " (downcase name))
+ (concat "mouse-2, RET: sort by "
+ (downcase name)))
+ (if Buffer-menu-use-header-line
+ "mouse-2: sort by visited order"
+ "mouse-2, RET: sort by visited order"))
+ 'mouse-face 'highlight
+ 'keymap (let ((map (make-sparse-keymap)))
+ (if Buffer-menu-use-header-line
+ (define-key map [header-line mouse-2]
+ `(lambda (e)
+ (interactive "e")
+ (save-window-excursion
+ (if e (mouse-select-window e))
+ (Buffer-menu-sort ,column))))
+ (define-key map [mouse-2]
+ `(lambda (e)
+ (interactive "e")
+ (if e (mouse-select-window e))
+ (Buffer-menu-sort ,column)))
+ (define-key map "\C-m"
+ `(lambda () (interactive)
+ (Buffer-menu-sort ,column))))
+ map)))
+
+(defun list-buffers-noselect (&optional files-only buffer-list)
+ "Create and return a buffer with a list of names of existing buffers.
+The buffer is named `*Buffer List*'.
+Note that buffers with names starting with spaces are omitted.
+Non-null optional arg FILES-ONLY means mention only file buffers.
+
+If BUFFER-LIST is non-nil, it should be a list of buffers;
+it means list those buffers and no others.
+
+For more information, see the function `buffer-menu'."
+ (let* ((old-buffer (current-buffer))
+ (standard-output standard-output)
+ (mode-end (make-string (- Buffer-menu-mode-width 2) ?\s))
+ (header (concat "CRM "
+ (Buffer-menu-buffer+size
+ (Buffer-menu-make-sort-button "Buffer" 2)
+ (Buffer-menu-make-sort-button "Size" 3))
+ " "
+ (Buffer-menu-make-sort-button "Mode" 4) mode-end
+ (Buffer-menu-make-sort-button "File" 5) "\n"))
+ list desired-point)
+ (when Buffer-menu-use-header-line
+ (let ((pos 0))
+ ;; Turn spaces in the header into stretch specs so they work
+ ;; regardless of the header-line face.
+ (while (string-match "[ \t]+" header pos)
+ (setq pos (match-end 0))
+ (put-text-property (match-beginning 0) pos 'display
+ ;; Assume fixed-size chars in the buffer.
+ (list 'space :align-to pos)
+ header)))
+ ;; Try to better align the one-char headers.
+ (put-text-property 0 3 'face 'fixed-pitch header)
+ ;; Add a "dummy" leading space to align the beginning of the header
+ ;; line with the beginning of the text (rather than with the left
+ ;; scrollbar or the left fringe). –-Stef
+ (setq header (concat (propertize " " 'display '(space :align-to 0))
+ header)))
+ (with-current-buffer (get-buffer-create "*Buffer List*")
+ (setq buffer-read-only nil)
+ (erase-buffer)
+ (setq standard-output (current-buffer))
+ (unless Buffer-menu-use-header-line
+ (let ((underline (if (char-displayable-p ?—) ?— ?-)))
+ (insert header
+ (apply 'string
+ (mapcar (lambda (c)
+ (if (memq c '(?\n ?\s)) c underline))
+ header)))))
+ ;; Collect info for every buffer we're interested in.
+ (dolist (buffer (or buffer-list (buffer-list)))
+ (with-current-buffer buffer
+ (let ((name (buffer-name))
+ (file buffer-file-name))
+ (unless (and (not buffer-list)
+ (or
+ ;; Don't mention internal buffers.
+ (and (string= (substring name 0 1) " ") (null file))
+ ;; Maybe don't mention buffers without files.
+ (and files-only (not file))
+ (string= name "*Buffer List*")))
+ ;; Otherwise output info.
+ (let ((mode (concat (format-mode-line mode-name nil nil buffer)
+ (if mode-line-process
+ (format-mode-line mode-line-process
+ nil nil buffer))))
+ (bits (string
+ (if (eq buffer old-buffer) ?. ?\s)
+ ;; Handle readonly status. The output buffer
+ ;; is special cased to appear readonly; it is
+ ;; actually made so at a later date.
+ (if (or (eq buffer standard-output)
+ buffer-read-only)
+ ?% ?\s)
+ ;; Identify modified buffers.
+ (if (buffer-modified-p) ?* ?\s)
+ ;; Space separator.
+ ?\s)))
+ (unless file
+ ;; No visited file. Check local value of
+ ;; list-buffers-directory.
+ (when (and (boundp 'list-buffers-directory)
+ list-buffers-directory)
+ (setq file list-buffers-directory)))
+ (push (list buffer bits name (buffer-size) mode file)
+ list))))))
+ ;; Preserve the original buffer-list ordering, just in case.
+ (setq list (nreverse list))
+ ;; Place the buffers's info in the output buffer, sorted if necessary.
+ (dolist (buffer
+ (if Buffer-menu-sort-column
+ (sort list
+ (if (eq Buffer-menu-sort-column 3)
+ (lambda (a b)
+ (< (nth Buffer-menu-sort-column a)
+ (nth Buffer-menu-sort-column b)))
+ (lambda (a b)
+ (string< (nth Buffer-menu-sort-column a)
+ (nth Buffer-menu-sort-column b)))))
+ list))
+ (if (eq (car buffer) old-buffer)
+ (setq desired-point (point)))
+ (insert (cadr buffer)
+ ;; Put the buffer name into a text property
+ ;; so we don't have to extract it from the text.
+ ;; This way we avoid problems with unusual buffer names.
+ (Buffer-menu-buffer+size (nth 2 buffer)
+ (int-to-string (nth 3 buffer))
+ `(buffer-name ,(nth 2 buffer)
+ buffer ,(car buffer)
+ font-lock-face Buffer-menu-buffer
+ mouse-face highlight
+ help-echo "mouse-2: select this buffer"))
+ " "
+ (if (> (length (nth 4 buffer)) Buffer-menu-mode-width)
+ (substring (nth 4 buffer) 0 Buffer-menu-mode-width)
+ (nth 4 buffer)))
+ (when (nth 5 buffer)
+ (indent-to (+ Buffer-menu-buffer-column Buffer-menu-buffer+size-width
+ Buffer-menu-mode-width 4) 1)
+ (princ (abbreviate-file-name (nth 5 buffer))))
+ (princ "\n"))
+ (Buffer-menu-mode)
+ (when Buffer-menu-use-header-line
+ (setq header-line-format header))
+ ;; DESIRED-POINT doesn't have to be set; it is not when the
+ ;; current buffer is not displayed for some reason.
+ (and desired-point
+ (goto-char desired-point))
+ (setq Buffer-menu-files-only files-only)
+ (set-buffer-modified-p nil)
+ (current-buffer))))
+
+;; arch-tag: e7dfcfc9-6cb2-46e4-bf55-8ef1936d83c6