[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] Changes to emacs/lisp/bs.el,v
|
From: |
Juanma Barranquero |
|
Subject: |
[Emacs-diffs] Changes to emacs/lisp/bs.el,v |
|
Date: |
Tue, 16 Oct 2007 10:38:53 +0000 |
CVSROOT: /sources/emacs
Module name: emacs
Changes by: Juanma Barranquero <lektu> 07/10/16 10:38:53
Index: bs.el
===================================================================
RCS file: /sources/emacs/emacs/lisp/bs.el,v
retrieving revision 1.36
retrieving revision 1.37
diff -u -b -r1.36 -r1.37
--- bs.el 11 Oct 2007 16:09:34 -0000 1.36
+++ bs.el 16 Oct 2007 10:38:53 -0000 1.37
@@ -158,7 +158,7 @@
("" 2 2 left " ")
("File" 12 12 left bs--get-file-name)
("" 2 2 left " "))
- "*List specifying the layout of a Buffer Selection Menu buffer.
+ "List specifying the layout of a Buffer Selection Menu buffer.
Each entry specifies a column and is a list of the form of:
\(HEADER MINIMUM-LENGTH MAXIMUM-LENGTH ALIGNMENT FUN-OR-STRING)
@@ -180,12 +180,7 @@
(defun bs--make-header-match-string ()
"Return a regexp matching the first line of a Buffer Selection Menu buffer."
- (let ((res "^\\(")
- (ele bs-attributes-list))
- (while ele
- (setq res (concat res (car (car ele)) " *"))
- (setq ele (cdr ele)))
- (concat res "$\\)")))
+ (concat "^\\(" (mapconcat #'car bs-attributes-list " *") " *$\\)"))
;; Font-Lock-Settings
(defvar bs-mode-font-lock-keywords
@@ -206,7 +201,7 @@
"Default font lock expressions for Buffer Selection Menu.")
(defcustom bs-max-window-height 20
- "*Maximal window height of Buffer Selection Menu."
+ "Maximal window height of Buffer Selection Menu."
:group 'bs-appearance
:type 'integer)
@@ -224,7 +219,7 @@
that must always be shown regardless of the configuration.")
(defcustom bs-must-always-show-regexp nil
- "*Regular expression for specifying buffers to show always.
+ "Regular expression for specifying buffers to show always.
A buffer whose name matches this regular expression will
be shown regardless of current configuration of Buffer Selection Menu."
:group 'bs
@@ -246,7 +241,7 @@
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.
+ "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
width is bounded by `bs-maximal-buffer-name-column'.
@@ -255,7 +250,7 @@
:type 'integer)
(defcustom bs-minimal-buffer-name-column 15
- "*Minimum column width for buffer names.
+ "Minimum 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 minimal
width is bounded by `bs-minimal-buffer-name-column'.
@@ -272,7 +267,7 @@
("files-and-scratch" "^\\*scratch\\*$" nil nil bs-visits-non-file
bs-sort-buffer-interns-are-last)
("all-intern-last" nil nil nil nil bs-sort-buffer-interns-are-last))
- "*List of all configurations you can use in the Buffer Selection Menu.
+ "List of all configurations you can use in the Buffer Selection Menu.
A configuration describes which buffers appear in Buffer Selection Menu
and also the order of buffers. A configuration is a list with
six elements. The first element is a string and describes the configuration.
@@ -284,7 +279,7 @@
:type '(repeat sexp))
(defcustom bs-default-configuration "files"
- "*Name of default configuration used by the Buffer Selection Menu.
+ "Name of default configuration used by the Buffer Selection Menu.
\\<bs-mode-map>
Will be changed using key \\[bs-select-next-configuration].
Must be a string used in `bs-configurations' for naming a configuration."
@@ -292,7 +287,7 @@
:type 'string)
(defcustom bs-alternative-configuration "all"
- "*Name of configuration used when calling `bs-show' with \
+ "Name of configuration used when calling `bs-show' with \
\\[universal-argument] as prefix key.
Must be a string used in `bs-configurations' for naming a configuration."
:group 'bs
@@ -303,7 +298,7 @@
Must be a string used in `bs-configurations' for naming a configuration.")
(defcustom bs-cycle-configuration-name nil
- "*Name of configuration used when cycling through the buffer list.
+ "Name of configuration used when cycling through the buffer list.
A value of nil means to use current configuration `bs-default-configuration'.
Must be a string used in `bs-configurations' for naming a configuration."
:group 'bs
@@ -311,32 +306,32 @@
string))
(defcustom bs-string-show-always "+"
- "*String added in column 1 indicating a buffer will always be shown."
+ "String added in column 1 indicating a buffer will always be shown."
:group 'bs-appearance
:type 'string)
(defcustom bs-string-show-never "-"
- "*String added in column 1 indicating a buffer will never be shown."
+ "String added in column 1 indicating a buffer will never be shown."
:group 'bs-appearance
:type 'string)
(defcustom bs-string-current "."
- "*String added in column 1 indicating the current buffer."
+ "String added in column 1 indicating the current buffer."
:group 'bs-appearance
:type 'string)
(defcustom bs-string-current-marked "#"
- "*String added in column 1 indicating the current buffer when it is marked."
+ "String added in column 1 indicating the current buffer when it is marked."
:group 'bs-appearance
:type 'string)
(defcustom bs-string-marked ">"
- "*String added in column 1 indicating a marked buffer."
+ "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."
+ "String added in column 1 indicating an unmarked buffer."
:group 'bs-appearance
:type 'string)
@@ -390,7 +385,7 @@
("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.
+ "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.
@@ -425,7 +420,7 @@
This is an element of `bs-sort-functions'.")
(defcustom bs-default-sort-name "by nothing"
- "*Name of default sort behavior.
+ "Name of default sort behavior.
Must be \"by nothing\" or a string used in `bs-sort-functions' for
naming a sort behavior. Default is \"by nothing\" which means no sorting."
:group 'bs
@@ -445,7 +440,6 @@
(defvar bs--window-config-coming-from nil
"Window configuration before starting Buffer Selection Menu.")
-(make-variable-frame-local 'bs--window-config-coming-from)
(defvar bs--intern-show-never "^ \\|\\*buffer-selection\\*"
"Regular expression specifying which buffers never to show.
@@ -529,27 +523,27 @@
(setq sort-description (or sort-description bs--current-sort-function)
list (or list (buffer-list)))
(let ((result nil))
- (while list
- (let* ((buffername (buffer-name (car list)))
- (int-show-never (string-match bs--intern-show-never buffername))
+ (dolist (buf list)
+ (let* ((buffername (buffer-name buf))
+ (int-show-never (string-match-p bs--intern-show-never buffername))
(ext-show-never (and bs-dont-show-regexp
- (string-match bs-dont-show-regexp
+ (string-match-p bs-dont-show-regexp
buffername)))
(extern-must-show (or (and bs-must-always-show-regexp
- (string-match
+ (string-match-p
bs-must-always-show-regexp
buffername))
(and bs-must-show-regexp
- (string-match bs-must-show-regexp
+ (string-match-p bs-must-show-regexp
buffername))))
(extern-show-never-from-fun (and bs-dont-show-function
(funcall bs-dont-show-function
- (car list))))
+ buf)))
(extern-must-show-from-fun (and bs-must-show-function
(funcall bs-must-show-function
- (car list))))
- (show-flag (buffer-local-value 'bs-buffer-show-mark (car list))))
- (if (or (eq show-flag 'always)
+ buf)))
+ (show-flag (buffer-local-value 'bs-buffer-show-mark buf)))
+ (when (or (eq show-flag 'always)
(and (or bs--show-all (not (eq show-flag 'never)))
(not int-show-never)
(or bs--show-all
@@ -557,14 +551,12 @@
extern-must-show-from-fun
(and (not ext-show-never)
(not extern-show-never-from-fun)))))
- (setq result (cons (car list)
- result)))
- (setq list (cdr list))))
+ (setq result (cons buf result)))))
(setq result (reverse result))
;; The current buffer which was the start point of bs should be an element
;; of result list, so that we can leave with space and be back in the
;; buffer we started bs-show.
- (if (and bs--buffer-coming-from
+ (when (and bs--buffer-coming-from
(buffer-live-p bs--buffer-coming-from)
(not (memq bs--buffer-coming-from result)))
(setq result (cons bs--buffer-coming-from result)))
@@ -587,7 +579,7 @@
SORT-DESCRIPTION is an element of `bs-sort-functions'."
(let ((line (1+ (count-lines 1 (point)))))
(bs-show-in-buffer (bs-buffer-list nil sort-description))
- (if keep-line-p
+ (when keep-line-p
(goto-line line))
(beginning-of-line)))
@@ -602,9 +594,9 @@
point)
(save-excursion
(goto-char (point-min))
- (if (search-forward-regexp regexp nil t)
- (setq point (- (point) 1))))
- (if point
+ (when (search-forward-regexp regexp nil t)
+ (setq point (1- (point)))))
+ (when point
(goto-char point))))
(defun bs--current-config-message ()
@@ -614,7 +606,23 @@
(format "Show buffer by configuration %S"
bs-current-configuration)))
-(defun bs-mode ()
+(defun bs--track-window-changes (frame)
+ "Track window changes to refresh the buffer list.
+Used from `window-size-change-functions'."
+ (let ((win (get-buffer-window "*buffer-selection*" frame)))
+ (when win
+ (with-selected-window win
+ (bs-refresh)
+ (bs--set-window-height)))))
+
+(defun bs--remove-hooks ()
+ "Remove `bs--track-window-changes' and auxiliary hooks."
+ (remove-hook 'window-size-change-functions 'bs--track-window-changes)
+ ;; Remove itself
+ (remove-hook 'kill-buffer-hook 'bs--remove-hooks t)
+ (remove-hook 'change-major-mode-hook 'bs--remove-hooks t))
+
+(define-derived-mode bs-mode nil "Buffer-Selection-Menu"
"Major mode for editing a subset of Emacs' buffers.
\\<bs-mode-map>
Aside from two header lines each line describes one buffer.
@@ -647,27 +655,27 @@
to show always.
\\[bs-visit-tags-table] -- call `visit-tags-table' on current line's buffer.
\\[bs-help] -- display this help text."
- (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
+ (setq 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))
+ (add-hook 'window-size-change-functions 'bs--track-window-changes)
+ (add-hook 'kill-buffer-hook 'bs--remove-hooks nil t)
+ (add-hook 'change-major-mode-hook 'bs--remove-hooks nil t))
(defun bs--restore-window-config ()
"Restore window configuration on the current frame."
(when bs--window-config-coming-from
+ (let ((frame (selected-frame)))
+ (unwind-protect
(set-window-configuration bs--window-config-coming-from)
+ (select-frame frame)))
(setq bs--window-config-coming-from nil)))
(defun bs-kill ()
@@ -705,7 +713,7 @@
(beginning-of-line)
(let ((line (+ (- bs-header-lines-length)
(count-lines 1 (point)))))
- (if (< line 0)
+ (when (< line 0)
(error "You are on a header row"))
(nth line bs-current-list)))
@@ -736,17 +744,16 @@
(bury-buffer (current-buffer))
(bs--restore-window-config)
(switch-to-buffer buffer)
- (if bs--marked-buffers
+ (when bs--marked-buffers
;; Some marked buffers for selection
(let* ((all (delq buffer bs--marked-buffers))
(height (/ (1- (frame-height)) (1+ (length all)))))
(delete-other-windows)
(switch-to-buffer buffer)
- (while all
+ (dolist (buf all)
(split-window nil height)
(other-window 1)
- (switch-to-buffer (car all))
- (setq all (cdr all)))
+ (switch-to-buffer buf))
;; goto window we have started bs.
(other-window 1)))))
@@ -912,11 +919,10 @@
(delete-region (point) (save-excursion
(end-of-line)
(if (eobp) (point) (1+ (point)))))
- (if (eobp)
- (progn
+ (when (eobp)
(backward-delete-char 1)
(beginning-of-line)
- (recenter -1)))
+ (recenter -1))
(bs--set-window-height)))
(defun bs-delete-backward ()
@@ -945,7 +951,7 @@
bs--current-sort-function)))
(save-excursion
(goto-char (point-min))
- (if (and (nth 2 sort-description)
+ (when (and (nth 2 sort-description)
(search-forward-regexp (nth 2 sort-description) nil t))
(let ((inhibit-read-only t))
(put-text-property (match-beginning 0)
@@ -983,10 +989,8 @@
(defun bs--nth-wrapper (count fun &rest args)
"Call COUNT times function FUN with arguments ARGS."
- (setq count (or count 1))
- (while (> count 0)
- (apply fun args)
- (setq count (1- count))))
+ (dotimes (i (or count 1))
+ (apply fun args)))
(defun bs-up (arg)
"Move cursor vertically up ARG lines in Buffer Selection Menu."
@@ -1026,7 +1030,7 @@
(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)))
+ (string-match-p "^\\*" (buffer-name b2)))
;; ----------------------------------------------------------------------
;; Configurations:
@@ -1108,7 +1112,7 @@
(length (length list))
pos)
(while (and assocs (not pos))
- (if (string= (car (car assocs)) start-name)
+ (when (string= (car (car assocs)) start-name)
(setq pos (- length (length assocs))))
(setq assocs (cdr assocs)))
(setq pos (1+ pos))
@@ -1151,10 +1155,9 @@
(erase-buffer)
(setq bs--name-entry-length name-entry-length)
(bs--show-header)
- (while list
- (bs--insert-one-entry (car list))
- (insert "\n")
- (setq list (cdr list)))
+ (dolist (buffer list)
+ (bs--insert-one-entry buffer)
+ (insert "\n"))
(delete-backward-char 1)
(bs--set-window-height)
(bs--goto-current-buffer)
@@ -1348,27 +1351,21 @@
and evaluates corresponding string. Inserts string in current buffer;
normally *buffer-selection*."
(let ((string "")
- (columns bs-attributes-list)
(to-much 0)
(apply-args (append (list bs--buffer-coming-from bs-current-list))))
(save-excursion
- (while columns
(set-buffer buffer)
- (let ((min (bs--get-value (nth 1 (car columns))))
- ;;(max (bs--get-value (nth 2 (car columns)))) refered no more
- (align (nth 3 (car columns)))
- (fun (nth 4 (car columns)))
- (val nil)
- new-string)
- (setq val (bs--get-value fun apply-args))
- (setq new-string (bs--format-aux val align (- min to-much)))
+ (dolist (column bs-attributes-list)
+ (let* ((min (bs--get-value (nth 1 column)))
+ (new-string (bs--format-aux (bs--get-value (nth 4 column) ; fun
+ apply-args)
+ (nth 3 column) ; align
+ (- min to-much)))
+ (len (length new-string)))
(setq string (concat string new-string))
- (if (> (length new-string) min)
- (setq to-much (- (length new-string) min)))
- ) ; let
- (setq columns (cdr columns))))
- (insert string)
- string))
+ (when (> len min)
+ (setq to-much (- len min))))))
+ (insert string)))
(defun bs--format-aux (string align len)
"Pad STRING to length LEN with alignment ALIGN.
@@ -1382,28 +1379,26 @@
(defun bs--show-header ()
"Insert header for Buffer Selection Menu in current buffer."
- (dolist (string (bs--create-header))
- (insert string "\n")))
+ (insert (bs--create-header-line #'identity)
+ "\n"
+ (bs--create-header-line (lambda (title)
+ (make-string (length title) ?-)))
+ "\n"))
(defun bs--get-name-length ()
"Return value of `bs--name-entry-length'."
bs--name-entry-length)
-(defun bs--create-header ()
- "Return all header lines used in Buffer Selection Menu as a list of strings."
- (list (mapconcat (lambda (column)
- (bs--format-aux (bs--get-value (car column))
- (nth 3 column) ; align
- (bs--get-value (nth 1 column))))
- bs-attributes-list
- "")
+(defun bs--create-header-line (col)
+ "Generate a line for the header.
+COL is called for each column in `bs-attributes-list' as a
+function of one argument, the string heading for the column."
(mapconcat (lambda (column)
- (let ((length (length (bs--get-value (car column)))))
- (bs--format-aux (make-string length ?-)
+ (bs--format-aux (funcall col (bs--get-value (car column)))
(nth 3 column) ; align
- (bs--get-value (nth 1 column)))))
+ (bs--get-value (nth 1 column))))
bs-attributes-list
- "")))
+ ""))
(defun bs--show-with-configuration (name &optional arg)
"Display buffer list of configuration with name NAME.
@@ -1426,12 +1421,12 @@
(active-window (get-window-with-predicate
(lambda (w)
(string= (buffer-name (window-buffer w))
- "*buffer-selection*")))))
+ "*buffer-selection*"))
+ nil (selected-frame))))
(if active-window
(select-window active-window)
- (modify-frame-parameters nil
- (list (cons 'bs--window-config-coming-from
- (current-window-configuration))))
+ (bs--restore-window-config)
+ (setq bs--window-config-coming-from (current-window-configuration))
(when (> (window-height (selected-window)) 7)
(split-window-vertically)
(other-window 1)))
- [Emacs-diffs] Changes to emacs/lisp/bs.el,v, Miles Bader, 2007/10/09
- [Emacs-diffs] Changes to emacs/lisp/bs.el,v, Juanma Barranquero, 2007/10/11
- [Emacs-diffs] Changes to emacs/lisp/bs.el,v,
Juanma Barranquero <=
- [Emacs-diffs] Changes to emacs/lisp/bs.el,v, Miles Bader, 2007/10/19
- [Emacs-diffs] Changes to emacs/lisp/bs.el,v, Miles Bader, 2007/10/27