comparison lisp/bs.el @ 91040:14c4a6aac623

Merge from emacs--devo--0 Patches applied: * emacs--devo--0 (patch 866-879) - Merge multi-tty branch - Update from CVS - Merge from emacs--rel--22 Revision: [e-mail]/emacs--unicode--0--patch-257

91039:eefadc1e1d5e

;;; History:

;;; Code:

(defvar font-lock-verbose)

;; ----------------------------------------------------------------------
;; Globals for customization
;; ----------------------------------------------------------------------

(defgroup bs nil

  "Function for specifying buffers which must be shown.
The function gets one argument - the buffer to test.")

(defvar bs-buffer-sort-function nil
  "Sort function to sort the buffers that appear in Buffer Selection Menu.
The function gets two arguments - the buffers to compare.")

(defcustom bs-maximal-buffer-name-column 45
  "*Maximum column width for buffer names.
The column for buffer names has dynamic width.  The width depends on
maximal and minimal length of names of buffers to show.  The maximal

  "*String added in column 1 indicating a marked buffer."
  :group 'bs-appearance
  :type 'string)

(defcustom bs-string-show-normally  " "
  "*String added in column 1 indicating a unmarked buffer."
  :group 'bs-appearance
  :type 'string)

(defvar bs--name-entry-length 20
  "Maximum length of all displayed buffer names.

    ("by mode"     bs--sort-by-mode     "Mode"   region)
    ("by filename" bs--sort-by-filename "File"   region)
    ("by nothing"  nil                  nil      nil))
  "*List of all possible sorting aspects for Buffer Selection Menu.
You can add a new entry with a call to `bs-define-sort-function'.
Each element is a list of four elements (NAME FUNCTION REGEXP-FOR-SORTING FACE)
NAME specifies the sort order defined by function FUNCTION.
FUNCTION nil means don't sort the buffer list.  Otherwise the functions
must have two parameters - the buffers to compare.
REGEXP-FOR-SORTING is a regular expression which describes the
column title to highlight.
FACE is a face used to fontify the sorted column title.  A value of nil means
don't highlight."

(defun bs-mode ()
  "Major mode for editing a subset of Emacs' buffers.
\\<bs-mode-map>
Aside from two header lines each line describes one buffer.
Move to a line representing the buffer you want to edit and select
buffer by \\[bs-select] or SPC. Abort buffer list with \\[bs-kill].
There are many key commands similar to `Buffer-menu-mode' for
manipulating the buffer list and buffers.
For faster navigation each digit key is a digit argument.

\\[bs-select] or SPACE -- select current line's buffer and other marked buffers.

  (interactive)
  (kill-all-local-variables)
  (use-local-map bs-mode-map)
  (make-local-variable 'font-lock-defaults)
  (make-local-variable 'font-lock-verbose)
  (buffer-disable-undo)
  (setq major-mode 'bs-mode
	mode-name "Buffer-Selection-Menu"
	buffer-read-only t
	truncate-lines t
	font-lock-defaults '(bs-mode-font-lock-keywords t)
	font-lock-verbose nil)
  (run-mode-hooks 'bs-mode-hook))

(defun bs--restore-window-config ()

  (when bs--window-config-coming-from
    (set-window-configuration bs--window-config-coming-from)
    (setq bs--window-config-coming-from nil)))

(defun bs-kill ()
  "Let buffer disappear and reset window-configuration."
  (interactive)
  (bury-buffer (current-buffer))
  (bs--restore-window-config))

(defun bs-abort ()

    (switch-to-buffer-other-frame buffer)))

(defun bs-mouse-select-other-frame (event)
  "Select selected line's buffer in new created frame.
Leave Buffer Selection Menu.
EVENT: a mouse click EVENT."
  (interactive "e")
  (mouse-set-point event)
  (bs-select-other-frame))

(defun bs-mouse-select (event)

    (bs-delete)
    (unless on-last-line-p
      (bs-up 1))))

(defun bs-show-sorted ()
  "Show buffer list sorted by buffer name."
  (interactive)
  (setq bs--current-sort-function
	(bs-next-config-aux (car bs--current-sort-function)
			    bs-sort-functions))
  (bs--redisplay)

  (if (eq (line-end-position) (point-max))
      (goto-line (1+ bs-header-lines-length))
    (forward-line 1)))

(defun bs-visits-non-file (buffer)
  "Return t or nil whether BUFFER visits no file.
A value of t means BUFFER belongs to no file.
A value of nil means BUFFER belongs to a file."
  (not (buffer-file-name buffer)))

(defun bs-sort-buffer-interns-are-last (b1 b2)
  "Function for sorting internal buffers B1 and B2 at the end of all buffers."
  (string-match "^\\*" (buffer-name b2)))

;; ----------------------------------------------------------------------
;; Configurations:
;; ----------------------------------------------------------------------

(defun bs-config-clear ()
  "*Reset all variables which specify a configuration.
These variables are `bs-dont-show-regexp', `bs-must-show-regexp',
`bs-dont-show-function', `bs-must-show-function' and
`bs-buffer-sort-function'."
  (setq bs-dont-show-regexp nil
	bs-must-show-regexp nil

	(t (apply fun args))))

(defun bs--get-marked-string (start-buffer all-buffers)
  "Return a string which describes whether current buffer is marked.
START-BUFFER is the buffer where we started buffer selection.
ALL-BUFFERS is the list of buffer appearing in Buffer Selection Menu.
The result string is one of `bs-string-current', `bs-string-current-marked',
`bs-string-marked', `bs-string-show-normally', `bs-string-show-never', or
`bs-string-show-always'."
  (cond ;; current buffer is the buffer we started buffer selection.
   ((eq (current-buffer) start-buffer)

    bs-string-show-always)))

(defun bs--get-modified-string (start-buffer all-buffers)
  "Return a string which describes whether current buffer is modified.
START-BUFFER is the buffer where we started buffer selection.
ALL-BUFFERS is the list of buffer appearing in Buffer Selection Menu."
  (if (buffer-modified-p) "*" " "))

(defun bs--get-readonly-string (start-buffer all-buffers)
  "Return a string which describes whether current buffer is read only.
START-BUFFER is the buffer where we started buffer selection.
ALL-BUFFERS is the list of buffer appearing in Buffer Selection Menu."
  (if buffer-read-only "%" " "))

(defun bs--get-size-string (start-buffer all-buffers)
  "Return a string which describes the size of current buffer.
START-BUFFER is the buffer where we started buffer selection.
ALL-BUFFERS is the list of buffer appearing in Buffer Selection Menu."
  (int-to-string (buffer-size)))

(defun bs--get-name (start-buffer all-buffers)
  "Return name of current buffer for Buffer Selection Menu.
The name of current buffer gets additional text properties
for mouse highlighting.
START-BUFFER is the buffer where we started buffer selection.
ALL-BUFFERS is the list of buffer appearing in Buffer Selection Menu."
  (propertize (buffer-name)
              'help-echo "mouse-2: select this buffer, mouse-3: select in other frame"
              'mouse-face 'highlight))

(defun bs--get-mode-name (start-buffer all-buffers)
  "Return the name of mode of current buffer for Buffer Selection Menu.
START-BUFFER is the buffer where we started buffer selection.
ALL-BUFFERS is the list of buffer appearing in Buffer Selection Menu."
  mode-name)

(defun bs--get-file-name (start-buffer all-buffers)
  "Return string for column 'File' in Buffer Selection Menu.
This is the variable `buffer-file-name' of current buffer.
If current mode is `dired-mode' or `shell-mode' it returns the
default directory.
START-BUFFER is the buffer where we started buffer selection.
ALL-BUFFERS is the list of buffer appearing in Buffer Selection Menu."
  (propertize (if (member major-mode '(shell-mode dired-mode))
                  default-directory
                (or buffer-file-name ""))
              'mouse-face 'highlight
              'help-echo "mouse-2: select this buffer, mouse-3: select in other frame"))

	(setq columns (cdr columns))))
    (insert string)
    string))

(defun bs--format-aux (string align len)
  "Generate a string with STRING with alignment ALIGN and length LEN.
ALIGN is one of the symbols `left', `middle', or `right'."
  (let* ((width (length string))
         (len (max len width)))
    (format (format "%%%s%ds" (if (eq align 'right) "" "-") len)
            (if (eq align 'middle)
                (concat (make-string (/ (- len width) 2) ?\s) string)
              string))))

(defun bs--show-header ()
  "Insert header for Buffer Selection Menu in current buffer."
  (mapcar '(lambda (string)
	     (insert string "\n"))
	  (bs--create-header)))

(defun bs--get-name-length ()
  "Return value of `bs--name-entry-length'."
  bs--name-entry-length)

;;;###autoload
(defun bs-show (arg)
  "Make a menu of buffers so you can manipulate buffers or the buffer list.
\\<bs-mode-map>
There are many key commands similar to `Buffer-menu-mode' for
manipulating buffer list and buffers itself.
User can move with [up] or [down], select a buffer
by \\[bs-select] or [SPC]\n
Type \\[bs-kill] to leave Buffer Selection Menu without a selection.
Type \\[bs-help] after invocation to get help on commands available.
With prefix argument ARG show a different buffer list.  Function

91040:14c4a6aac623

;;; History:

;;; Code:

;; ----------------------------------------------------------------------
;; Globals for customization
;; ----------------------------------------------------------------------

(defgroup bs nil

  "Function for specifying buffers which must be shown.
The function gets one argument - the buffer to test.")

(defvar bs-buffer-sort-function nil
  "Sort function to sort the buffers that appear in Buffer Selection Menu.
The function gets two arguments - the buffers to compare.
It must return non-nil if the first buffer should sort before the second.")

(defcustom bs-maximal-buffer-name-column 45
  "*Maximum column width for buffer names.
The column for buffer names has dynamic width.  The width depends on
maximal and minimal length of names of buffers to show.  The maximal

  "*String added in column 1 indicating a marked buffer."
  :group 'bs-appearance
  :type 'string)

(defcustom bs-string-show-normally  " "
  "*String added in column 1 indicating an unmarked buffer."
  :group 'bs-appearance
  :type 'string)

(defvar bs--name-entry-length 20
  "Maximum length of all displayed buffer names.

    ("by mode"     bs--sort-by-mode     "Mode"   region)
    ("by filename" bs--sort-by-filename "File"   region)
    ("by nothing"  nil                  nil      nil))
  "*List of all possible sorting aspects for Buffer Selection Menu.
You can add a new entry with a call to `bs-define-sort-function'.
Each element is a list of four elements (NAME FUNCTION REGEXP-FOR-SORTING FACE).
NAME specifies the sort order defined by function FUNCTION.
FUNCTION nil means don't sort the buffer list.  Otherwise the function
must have two parameters - the buffers to compare.
REGEXP-FOR-SORTING is a regular expression which describes the
column title to highlight.
FACE is a face used to fontify the sorted column title.  A value of nil means
don't highlight."

(defun bs-mode ()
  "Major mode for editing a subset of Emacs' buffers.
\\<bs-mode-map>
Aside from two header lines each line describes one buffer.
Move to a line representing the buffer you want to edit and select
buffer by \\[bs-select] or SPC.  Abort buffer list with \\[bs-kill].
There are many key commands similar to `Buffer-menu-mode' for
manipulating the buffer list and buffers.
For faster navigation each digit key is a digit argument.

\\[bs-select] or SPACE -- select current line's buffer and other marked buffers.

  (interactive)
  (kill-all-local-variables)
  (use-local-map bs-mode-map)
  (make-local-variable 'font-lock-defaults)
  (make-local-variable 'font-lock-verbose)
  (make-local-variable 'font-lock-global-modes)
  (buffer-disable-undo)
  (setq major-mode 'bs-mode
	mode-name "Buffer-Selection-Menu"
	buffer-read-only t
	truncate-lines t
	show-trailing-whitespace nil
	font-lock-global-modes '(not bs-mode)
	font-lock-defaults '(bs-mode-font-lock-keywords t)
	font-lock-verbose nil)
  (run-mode-hooks 'bs-mode-hook))

(defun bs--restore-window-config ()

  (when bs--window-config-coming-from
    (set-window-configuration bs--window-config-coming-from)
    (setq bs--window-config-coming-from nil)))

(defun bs-kill ()
  "Let buffer disappear and reset window configuration."
  (interactive)
  (bury-buffer (current-buffer))
  (bs--restore-window-config))

(defun bs-abort ()

    (switch-to-buffer-other-frame buffer)))

(defun bs-mouse-select-other-frame (event)
  "Select selected line's buffer in new created frame.
Leave Buffer Selection Menu.
EVENT: a mouse click event."
  (interactive "e")
  (mouse-set-point event)
  (bs-select-other-frame))

(defun bs-mouse-select (event)

    (bs-delete)
    (unless on-last-line-p
      (bs-up 1))))

(defun bs-show-sorted ()
  "Show buffer list sorted by next sort aspect."
  (interactive)
  (setq bs--current-sort-function
	(bs-next-config-aux (car bs--current-sort-function)
			    bs-sort-functions))
  (bs--redisplay)

  (if (eq (line-end-position) (point-max))
      (goto-line (1+ bs-header-lines-length))
    (forward-line 1)))

(defun bs-visits-non-file (buffer)
  "Return whether BUFFER visits no file.
A value of t means BUFFER belongs to no file.
A value of nil means BUFFER belongs to a file."
  (not (buffer-file-name buffer)))

(defun bs-sort-buffer-interns-are-last (b1 b2)
  "Function for sorting internal buffers at the end of all buffers."
  (string-match "^\\*" (buffer-name b2)))

;; ----------------------------------------------------------------------
;; Configurations:
;; ----------------------------------------------------------------------

(defun bs-config-clear ()
  "Reset all variables which specify a configuration.
These variables are `bs-dont-show-regexp', `bs-must-show-regexp',
`bs-dont-show-function', `bs-must-show-function' and
`bs-buffer-sort-function'."
  (setq bs-dont-show-regexp nil
	bs-must-show-regexp nil

	(t (apply fun args))))

(defun bs--get-marked-string (start-buffer all-buffers)
  "Return a string which describes whether current buffer is marked.
START-BUFFER is the buffer where we started buffer selection.
ALL-BUFFERS is the list of buffers appearing in Buffer Selection Menu.
The result string is one of `bs-string-current', `bs-string-current-marked',
`bs-string-marked', `bs-string-show-normally', `bs-string-show-never', or
`bs-string-show-always'."
  (cond ;; current buffer is the buffer we started buffer selection.
   ((eq (current-buffer) start-buffer)

    bs-string-show-always)))

(defun bs--get-modified-string (start-buffer all-buffers)
  "Return a string which describes whether current buffer is modified.
START-BUFFER is the buffer where we started buffer selection.
ALL-BUFFERS is the list of buffers appearing in Buffer Selection Menu."
  (if (buffer-modified-p) "*" " "))

(defun bs--get-readonly-string (start-buffer all-buffers)
  "Return a string which describes whether current buffer is read only.
START-BUFFER is the buffer where we started buffer selection.
ALL-BUFFERS is the list of buffers appearing in Buffer Selection Menu."
  (if buffer-read-only "%" " "))

(defun bs--get-size-string (start-buffer all-buffers)
  "Return a string which describes the size of current buffer.
START-BUFFER is the buffer where we started buffer selection.
ALL-BUFFERS is the list of buffers appearing in Buffer Selection Menu."
  (int-to-string (buffer-size)))

(defun bs--get-name (start-buffer all-buffers)
  "Return name of current buffer for Buffer Selection Menu.
The name of current buffer gets additional text properties
for mouse highlighting.
START-BUFFER is the buffer where we started buffer selection.
ALL-BUFFERS is the list of buffers appearing in Buffer Selection Menu."
  (propertize (buffer-name)
              'help-echo "mouse-2: select this buffer, mouse-3: select in other frame"
              'mouse-face 'highlight))

(defun bs--get-mode-name (start-buffer all-buffers)
  "Return the name of mode of current buffer for Buffer Selection Menu.
START-BUFFER is the buffer where we started buffer selection.
ALL-BUFFERS is the list of buffers appearing in Buffer Selection Menu."
  mode-name)

(defun bs--get-file-name (start-buffer all-buffers)
  "Return string for column 'File' in Buffer Selection Menu.
This is the variable `buffer-file-name' of current buffer.
If current mode is `dired-mode' or `shell-mode' it returns the
default directory.
START-BUFFER is the buffer where we started buffer selection.
ALL-BUFFERS is the list of buffers appearing in Buffer Selection Menu."
  (propertize (if (member major-mode '(shell-mode dired-mode))
                  default-directory
                (or buffer-file-name ""))
              'mouse-face 'highlight
              'help-echo "mouse-2: select this buffer, mouse-3: select in other frame"))

	(setq columns (cdr columns))))
    (insert string)
    string))

(defun bs--format-aux (string align len)
  "Pad STRING to length LEN with alignment ALIGN.
ALIGN is one of the symbols `left', `middle', or `right'."
  (let* ((width (length string))
         (len (max len width)))
    (format (format "%%%s%ds" (if (eq align 'right) "" "-") len)
            (if (eq align 'middle)
                (concat (make-string (/ (- len width) 2) ?\s) string)
              string))))

(defun bs--show-header ()
  "Insert header for Buffer Selection Menu in current buffer."
  (dolist (string (bs--create-header))
    (insert string "\n")))

(defun bs--get-name-length ()
  "Return value of `bs--name-entry-length'."
  bs--name-entry-length)

;;;###autoload
(defun bs-show (arg)
  "Make a menu of buffers so you can manipulate buffers or the buffer list.
\\<bs-mode-map>
There are many key commands similar to `Buffer-menu-mode' for
manipulating the buffer list and the buffers themselves.
User can move with [up] or [down], select a buffer
by \\[bs-select] or [SPC]\n
Type \\[bs-kill] to leave Buffer Selection Menu without a selection.
Type \\[bs-help] after invocation to get help on commands available.
With prefix argument ARG show a different buffer list.  Function