aboutsummaryrefslogtreecommitdiffstats
path: root/lisp
diff options
context:
space:
mode:
authorJuanma Barranquero2007-10-16 10:40:02 +0000
committerJuanma Barranquero2007-10-16 10:40:02 +0000
commite749f5762b6c8a7e531918a3c0e771609d1ba016 (patch)
tree555faeeb089b1e26e8ab9d925639c2063b260173 /lisp
parent11fb4bdbbdab3e17e020d9ed4a6c754cdfb89167 (diff)
downloademacs-e749f5762b6c8a7e531918a3c0e771609d1ba016.tar.gz
emacs-e749f5762b6c8a7e531918a3c0e771609d1ba016.zip
(bs--make-header-match-string, bs-show-in-buffer, bs--nth-wrapper): Simplify.
(bs-select, bs--insert-one-entry): Simplify. Use `when'. (bs-buffer-list): Simplify. Use `when'. Use `string-match-p'. (bs-sort-buffer-interns-are-last): Use `string-match-p'. (bs-attributes-list, bs-max-window-height, bs-must-always-show-regexp, bs-maximal-buffer-name-column, bs-minimal-buffer-name-column, bs-configurations, bs-default-configuration, bs-alternative-configuration, bs-cycle-configuration-name, bs-string-show-always, bs-string-show-never, bs-string-current, bs-string-current-marked, bs-string-marked, bs-string-show-normally, bs-sort-functions, bs-default-sort-name): Remove * in docstrings. (bs--redisplay, bs--goto-current-buffer, bs--current-buffer, bs-delete, bs-apply-sort-faces, bs-next-config-aux): Use `when'. (bs--window-config-coming-from): Revert 2006-11-09 change. (bs--restore-window-config): Keep the selected frame. (bs--track-window-changes, bs--remove-hooks): New functions. (bs-mode): Use `define-derived-mode'. Set hook to track window changes. (bs--create-header): Remove. (bs--create-header-line): New function, based on `bs--create-header'. (bs--show-header): Use `bs--create-header-line'. (bs--show-with-configuration): Revert 2006-11-09 change. Don't reuse window unless it is visible on the selected frame. Restore window configuration (possibly in a different frame) before creating any window.
Diffstat (limited to 'lisp')
-rw-r--r--lisp/ChangeLog28
-rw-r--r--lisp/bs.el283
2 files changed, 167 insertions, 144 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 17135a37a33..69919bdec0f 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,31 @@
12007-10-16 Juanma Barranquero <lekktu@gmail.com>
2
3 * bs.el (bs--make-header-match-string, bs-show-in-buffer)
4 (bs--nth-wrapper): Simplify.
5 (bs-select, bs--insert-one-entry): Simplify. Use `when'.
6 (bs-buffer-list): Simplify. Use `when'. Use `string-match-p'.
7 (bs-sort-buffer-interns-are-last): Use `string-match-p'.
8 (bs-attributes-list, bs-max-window-height, bs-must-always-show-regexp)
9 (bs-maximal-buffer-name-column, bs-minimal-buffer-name-column)
10 (bs-configurations, bs-default-configuration)
11 (bs-alternative-configuration, bs-cycle-configuration-name)
12 (bs-string-show-always, bs-string-show-never, bs-string-current)
13 (bs-string-current-marked, bs-string-marked, bs-string-show-normally)
14 (bs-sort-functions, bs-default-sort-name): Remove * in docstrings.
15 (bs--redisplay, bs--goto-current-buffer, bs--current-buffer, bs-delete)
16 (bs-apply-sort-faces, bs-next-config-aux): Use `when'.
17 (bs--window-config-coming-from): Revert 2006-11-09 change.
18 (bs--restore-window-config): Keep the selected frame.
19 (bs--track-window-changes, bs--remove-hooks): New functions.
20 (bs-mode): Use `define-derived-mode'. Set hook to track window changes.
21 (bs--create-header): Remove.
22 (bs--create-header-line): New function, based on `bs--create-header'.
23 (bs--show-header): Use `bs--create-header-line'.
24 (bs--show-with-configuration): Revert 2006-11-09 change.
25 Don't reuse window unless it is visible on the selected frame.
26 Restore window configuration (possibly in a different frame)
27 before creating any window.
28
12007-10-16 Glenn Morris <rgm@gnu.org> 292007-10-16 Glenn Morris <rgm@gnu.org>
2 30
3 * simple.el (blink-matching-open): Don't report false errors with 31 * simple.el (blink-matching-open): Don't report false errors with
diff --git a/lisp/bs.el b/lisp/bs.el
index 6390bd2dd81..bb2dbae83c0 100644
--- a/lisp/bs.el
+++ b/lisp/bs.el
@@ -158,7 +158,7 @@
158 ("" 2 2 left " ") 158 ("" 2 2 left " ")
159 ("File" 12 12 left bs--get-file-name) 159 ("File" 12 12 left bs--get-file-name)
160 ("" 2 2 left " ")) 160 ("" 2 2 left " "))
161 "*List specifying the layout of a Buffer Selection Menu buffer. 161 "List specifying the layout of a Buffer Selection Menu buffer.
162Each entry specifies a column and is a list of the form of: 162Each entry specifies a column and is a list of the form of:
163\(HEADER MINIMUM-LENGTH MAXIMUM-LENGTH ALIGNMENT FUN-OR-STRING) 163\(HEADER MINIMUM-LENGTH MAXIMUM-LENGTH ALIGNMENT FUN-OR-STRING)
164 164
@@ -180,12 +180,7 @@ return a string representing the column's value."
180 180
181(defun bs--make-header-match-string () 181(defun bs--make-header-match-string ()
182 "Return a regexp matching the first line of a Buffer Selection Menu buffer." 182 "Return a regexp matching the first line of a Buffer Selection Menu buffer."
183 (let ((res "^\\(") 183 (concat "^\\(" (mapconcat #'car bs-attributes-list " *") " *$\\)"))
184 (ele bs-attributes-list))
185 (while ele
186 (setq res (concat res (car (car ele)) " *"))
187 (setq ele (cdr ele)))
188 (concat res "$\\)")))
189 184
190;; Font-Lock-Settings 185;; Font-Lock-Settings
191(defvar bs-mode-font-lock-keywords 186(defvar bs-mode-font-lock-keywords
@@ -206,7 +201,7 @@ return a string representing the column's value."
206 "Default font lock expressions for Buffer Selection Menu.") 201 "Default font lock expressions for Buffer Selection Menu.")
207 202
208(defcustom bs-max-window-height 20 203(defcustom bs-max-window-height 20
209 "*Maximal window height of Buffer Selection Menu." 204 "Maximal window height of Buffer Selection Menu."
210 :group 'bs-appearance 205 :group 'bs-appearance
211 :type 'integer) 206 :type 'integer)
212 207
@@ -224,7 +219,7 @@ it is reset to nil. Use `bs-must-always-show-regexp' to specify buffers
224that must always be shown regardless of the configuration.") 219that must always be shown regardless of the configuration.")
225 220
226(defcustom bs-must-always-show-regexp nil 221(defcustom bs-must-always-show-regexp nil
227 "*Regular expression for specifying buffers to show always. 222 "Regular expression for specifying buffers to show always.
228A buffer whose name matches this regular expression will 223A buffer whose name matches this regular expression will
229be shown regardless of current configuration of Buffer Selection Menu." 224be shown regardless of current configuration of Buffer Selection Menu."
230 :group 'bs 225 :group 'bs
@@ -246,7 +241,7 @@ The function gets two arguments - the buffers to compare.
246It must return non-nil if the first buffer should sort before the second.") 241It must return non-nil if the first buffer should sort before the second.")
247 242
248(defcustom bs-maximal-buffer-name-column 45 243(defcustom bs-maximal-buffer-name-column 45
249 "*Maximum column width for buffer names. 244 "Maximum column width for buffer names.
250The column for buffer names has dynamic width. The width depends on 245The column for buffer names has dynamic width. The width depends on
251maximal and minimal length of names of buffers to show. The maximal 246maximal and minimal length of names of buffers to show. The maximal
252width is bounded by `bs-maximal-buffer-name-column'. 247width is bounded by `bs-maximal-buffer-name-column'.
@@ -255,7 +250,7 @@ See also `bs-minimal-buffer-name-column'."
255 :type 'integer) 250 :type 'integer)
256 251
257(defcustom bs-minimal-buffer-name-column 15 252(defcustom bs-minimal-buffer-name-column 15
258 "*Minimum column width for buffer names. 253 "Minimum column width for buffer names.
259The column for buffer names has dynamic width. The width depends on 254The column for buffer names has dynamic width. The width depends on
260maximal and minimal length of names of buffers to show. The minimal 255maximal and minimal length of names of buffers to show. The minimal
261width is bounded by `bs-minimal-buffer-name-column'. 256width is bounded by `bs-minimal-buffer-name-column'.
@@ -272,7 +267,7 @@ See also `bs-maximal-buffer-name-column'."
272 ("files-and-scratch" "^\\*scratch\\*$" nil nil bs-visits-non-file 267 ("files-and-scratch" "^\\*scratch\\*$" nil nil bs-visits-non-file
273 bs-sort-buffer-interns-are-last) 268 bs-sort-buffer-interns-are-last)
274 ("all-intern-last" nil nil nil nil bs-sort-buffer-interns-are-last)) 269 ("all-intern-last" nil nil nil nil bs-sort-buffer-interns-are-last))
275 "*List of all configurations you can use in the Buffer Selection Menu. 270 "List of all configurations you can use in the Buffer Selection Menu.
276A configuration describes which buffers appear in Buffer Selection Menu 271A configuration describes which buffers appear in Buffer Selection Menu
277and also the order of buffers. A configuration is a list with 272and also the order of buffers. A configuration is a list with
278six elements. The first element is a string and describes the configuration. 273six elements. The first element is a string and describes the configuration.
@@ -284,7 +279,7 @@ By setting these variables you define a configuration."
284 :type '(repeat sexp)) 279 :type '(repeat sexp))
285 280
286(defcustom bs-default-configuration "files" 281(defcustom bs-default-configuration "files"
287 "*Name of default configuration used by the Buffer Selection Menu. 282 "Name of default configuration used by the Buffer Selection Menu.
288\\<bs-mode-map> 283\\<bs-mode-map>
289Will be changed using key \\[bs-select-next-configuration]. 284Will be changed using key \\[bs-select-next-configuration].
290Must be a string used in `bs-configurations' for naming a configuration." 285Must be a string used in `bs-configurations' for naming a configuration."
@@ -292,7 +287,7 @@ Must be a string used in `bs-configurations' for naming a configuration."
292 :type 'string) 287 :type 'string)
293 288
294(defcustom bs-alternative-configuration "all" 289(defcustom bs-alternative-configuration "all"
295 "*Name of configuration used when calling `bs-show' with \ 290 "Name of configuration used when calling `bs-show' with \
296\\[universal-argument] as prefix key. 291\\[universal-argument] as prefix key.
297Must be a string used in `bs-configurations' for naming a configuration." 292Must be a string used in `bs-configurations' for naming a configuration."
298 :group 'bs 293 :group 'bs
@@ -303,7 +298,7 @@ Must be a string used in `bs-configurations' for naming a configuration."
303Must be a string used in `bs-configurations' for naming a configuration.") 298Must be a string used in `bs-configurations' for naming a configuration.")
304 299
305(defcustom bs-cycle-configuration-name nil 300(defcustom bs-cycle-configuration-name nil
306 "*Name of configuration used when cycling through the buffer list. 301 "Name of configuration used when cycling through the buffer list.
307A value of nil means to use current configuration `bs-default-configuration'. 302A value of nil means to use current configuration `bs-default-configuration'.
308Must be a string used in `bs-configurations' for naming a configuration." 303Must be a string used in `bs-configurations' for naming a configuration."
309 :group 'bs 304 :group 'bs
@@ -311,32 +306,32 @@ Must be a string used in `bs-configurations' for naming a configuration."
311 string)) 306 string))
312 307
313(defcustom bs-string-show-always "+" 308(defcustom bs-string-show-always "+"
314 "*String added in column 1 indicating a buffer will always be shown." 309 "String added in column 1 indicating a buffer will always be shown."
315 :group 'bs-appearance 310 :group 'bs-appearance
316 :type 'string) 311 :type 'string)
317 312
318(defcustom bs-string-show-never "-" 313(defcustom bs-string-show-never "-"
319 "*String added in column 1 indicating a buffer will never be shown." 314 "String added in column 1 indicating a buffer will never be shown."
320 :group 'bs-appearance 315 :group 'bs-appearance
321 :type 'string) 316 :type 'string)
322 317
323(defcustom bs-string-current "." 318(defcustom bs-string-current "."
324 "*String added in column 1 indicating the current buffer." 319 "String added in column 1 indicating the current buffer."
325 :group 'bs-appearance 320 :group 'bs-appearance
326 :type 'string) 321 :type 'string)
327 322
328(defcustom bs-string-current-marked "#" 323(defcustom bs-string-current-marked "#"
329 "*String added in column 1 indicating the current buffer when it is marked." 324 "String added in column 1 indicating the current buffer when it is marked."
330 :group 'bs-appearance 325 :group 'bs-appearance
331 :type 'string) 326 :type 'string)
332 327
333(defcustom bs-string-marked ">" 328(defcustom bs-string-marked ">"
334 "*String added in column 1 indicating a marked buffer." 329 "String added in column 1 indicating a marked buffer."
335 :group 'bs-appearance 330 :group 'bs-appearance
336 :type 'string) 331 :type 'string)
337 332
338(defcustom bs-string-show-normally " " 333(defcustom bs-string-show-normally " "
339 "*String added in column 1 indicating an unmarked buffer." 334 "String added in column 1 indicating an unmarked buffer."
340 :group 'bs-appearance 335 :group 'bs-appearance
341 :type 'string) 336 :type 'string)
342 337
@@ -390,7 +385,7 @@ A value of `always' means to show buffer regardless of the configuration.")
390 ("by mode" bs--sort-by-mode "Mode" region) 385 ("by mode" bs--sort-by-mode "Mode" region)
391 ("by filename" bs--sort-by-filename "File" region) 386 ("by filename" bs--sort-by-filename "File" region)
392 ("by nothing" nil nil nil)) 387 ("by nothing" nil nil nil))
393 "*List of all possible sorting aspects for Buffer Selection Menu. 388 "List of all possible sorting aspects for Buffer Selection Menu.
394You can add a new entry with a call to `bs-define-sort-function'. 389You can add a new entry with a call to `bs-define-sort-function'.
395Each element is a list of four elements (NAME FUNCTION REGEXP-FOR-SORTING FACE). 390Each element is a list of four elements (NAME FUNCTION REGEXP-FOR-SORTING FACE).
396NAME specifies the sort order defined by function FUNCTION. 391NAME specifies the sort order defined by function FUNCTION.
@@ -425,7 +420,7 @@ The new sort aspect will be inserted into list `bs-sort-functions'."
425This is an element of `bs-sort-functions'.") 420This is an element of `bs-sort-functions'.")
426 421
427(defcustom bs-default-sort-name "by nothing" 422(defcustom bs-default-sort-name "by nothing"
428 "*Name of default sort behavior. 423 "Name of default sort behavior.
429Must be \"by nothing\" or a string used in `bs-sort-functions' for 424Must be \"by nothing\" or a string used in `bs-sort-functions' for
430naming a sort behavior. Default is \"by nothing\" which means no sorting." 425naming a sort behavior. Default is \"by nothing\" which means no sorting."
431 :group 'bs 426 :group 'bs
@@ -445,7 +440,6 @@ defined by current configuration `bs-current-configuration'.")
445 440
446(defvar bs--window-config-coming-from nil 441(defvar bs--window-config-coming-from nil
447 "Window configuration before starting Buffer Selection Menu.") 442 "Window configuration before starting Buffer Selection Menu.")
448(make-variable-frame-local 'bs--window-config-coming-from)
449 443
450(defvar bs--intern-show-never "^ \\|\\*buffer-selection\\*" 444(defvar bs--intern-show-never "^ \\|\\*buffer-selection\\*"
451 "Regular expression specifying which buffers never to show. 445 "Regular expression specifying which buffers never to show.
@@ -529,45 +523,43 @@ a special function. SORT-DESCRIPTION is an element of `bs-sort-functions'."
529 (setq sort-description (or sort-description bs--current-sort-function) 523 (setq sort-description (or sort-description bs--current-sort-function)
530 list (or list (buffer-list))) 524 list (or list (buffer-list)))
531 (let ((result nil)) 525 (let ((result nil))
532 (while list 526 (dolist (buf list)
533 (let* ((buffername (buffer-name (car list))) 527 (let* ((buffername (buffer-name buf))
534 (int-show-never (string-match bs--intern-show-never buffername)) 528 (int-show-never (string-match-p bs--intern-show-never buffername))
535 (ext-show-never (and bs-dont-show-regexp 529 (ext-show-never (and bs-dont-show-regexp
536 (string-match bs-dont-show-regexp 530 (string-match-p bs-dont-show-regexp
537 buffername))) 531 buffername)))
538 (extern-must-show (or (and bs-must-always-show-regexp 532 (extern-must-show (or (and bs-must-always-show-regexp
539 (string-match 533 (string-match-p
540 bs-must-always-show-regexp 534 bs-must-always-show-regexp
541 buffername)) 535 buffername))
542 (and bs-must-show-regexp 536 (and bs-must-show-regexp
543 (string-match bs-must-show-regexp 537 (string-match-p bs-must-show-regexp
544 buffername)))) 538 buffername))))
545 (extern-show-never-from-fun (and bs-dont-show-function 539 (extern-show-never-from-fun (and bs-dont-show-function
546 (funcall bs-dont-show-function 540 (funcall bs-dont-show-function
547 (car list)))) 541 buf)))
548 (extern-must-show-from-fun (and bs-must-show-function 542 (extern-must-show-from-fun (and bs-must-show-function
549 (funcall bs-must-show-function 543 (funcall bs-must-show-function
550 (car list)))) 544 buf)))
551 (show-flag (buffer-local-value 'bs-buffer-show-mark (car list)))) 545 (show-flag (buffer-local-value 'bs-buffer-show-mark buf)))
552 (if (or (eq show-flag 'always) 546 (when (or (eq show-flag 'always)
553 (and (or bs--show-all (not (eq show-flag 'never))) 547 (and (or bs--show-all (not (eq show-flag 'never)))
554 (not int-show-never) 548 (not int-show-never)
555 (or bs--show-all 549 (or bs--show-all
556 extern-must-show 550 extern-must-show
557 extern-must-show-from-fun 551 extern-must-show-from-fun
558 (and (not ext-show-never) 552 (and (not ext-show-never)
559 (not extern-show-never-from-fun))))) 553 (not extern-show-never-from-fun)))))
560 (setq result (cons (car list) 554 (setq result (cons buf result)))))
561 result)))
562 (setq list (cdr list))))
563 (setq result (reverse result)) 555 (setq result (reverse result))
564 ;; The current buffer which was the start point of bs should be an element 556 ;; The current buffer which was the start point of bs should be an element
565 ;; of result list, so that we can leave with space and be back in the 557 ;; of result list, so that we can leave with space and be back in the
566 ;; buffer we started bs-show. 558 ;; buffer we started bs-show.
567 (if (and bs--buffer-coming-from 559 (when (and bs--buffer-coming-from
568 (buffer-live-p bs--buffer-coming-from) 560 (buffer-live-p bs--buffer-coming-from)
569 (not (memq bs--buffer-coming-from result))) 561 (not (memq bs--buffer-coming-from result)))
570 (setq result (cons bs--buffer-coming-from result))) 562 (setq result (cons bs--buffer-coming-from result)))
571 ;; sorting 563 ;; sorting
572 (if (and sort-description 564 (if (and sort-description
573 (nth 1 sort-description)) 565 (nth 1 sort-description))
@@ -587,8 +579,8 @@ If KEEP-LINE-P is non-nil the point will stay on current line.
587SORT-DESCRIPTION is an element of `bs-sort-functions'." 579SORT-DESCRIPTION is an element of `bs-sort-functions'."
588 (let ((line (1+ (count-lines 1 (point))))) 580 (let ((line (1+ (count-lines 1 (point)))))
589 (bs-show-in-buffer (bs-buffer-list nil sort-description)) 581 (bs-show-in-buffer (bs-buffer-list nil sort-description))
590 (if keep-line-p 582 (when keep-line-p
591 (goto-line line)) 583 (goto-line line))
592 (beginning-of-line))) 584 (beginning-of-line)))
593 585
594(defun bs--goto-current-buffer () 586(defun bs--goto-current-buffer ()
@@ -602,10 +594,10 @@ actually the line which begins with character in `bs-string-current' or
602 point) 594 point)
603 (save-excursion 595 (save-excursion
604 (goto-char (point-min)) 596 (goto-char (point-min))
605 (if (search-forward-regexp regexp nil t) 597 (when (search-forward-regexp regexp nil t)
606 (setq point (- (point) 1)))) 598 (setq point (1- (point)))))
607 (if point 599 (when point
608 (goto-char point)))) 600 (goto-char point))))
609 601
610(defun bs--current-config-message () 602(defun bs--current-config-message ()
611 "Return a string describing the current `bs-mode' configuration." 603 "Return a string describing the current `bs-mode' configuration."
@@ -614,7 +606,23 @@ actually the line which begins with character in `bs-string-current' or
614 (format "Show buffer by configuration %S" 606 (format "Show buffer by configuration %S"
615 bs-current-configuration))) 607 bs-current-configuration)))
616 608
617(defun bs-mode () 609(defun bs--track-window-changes (frame)
610 "Track window changes to refresh the buffer list.
611Used from `window-size-change-functions'."
612 (let ((win (get-buffer-window "*buffer-selection*" frame)))
613 (when win
614 (with-selected-window win
615 (bs-refresh)
616 (bs--set-window-height)))))
617
618(defun bs--remove-hooks ()
619 "Remove `bs--track-window-changes' and auxiliary hooks."
620 (remove-hook 'window-size-change-functions 'bs--track-window-changes)
621 ;; Remove itself
622 (remove-hook 'kill-buffer-hook 'bs--remove-hooks t)
623 (remove-hook 'change-major-mode-hook 'bs--remove-hooks t))
624
625(define-derived-mode bs-mode nil "Buffer-Selection-Menu"
618 "Major mode for editing a subset of Emacs' buffers. 626 "Major mode for editing a subset of Emacs' buffers.
619\\<bs-mode-map> 627\\<bs-mode-map>
620Aside from two header lines each line describes one buffer. 628Aside from two header lines each line describes one buffer.
@@ -647,27 +655,27 @@ available Buffer Selection Menu configuration.
647to show always. 655to show always.
648\\[bs-visit-tags-table] -- call `visit-tags-table' on current line's buffer. 656\\[bs-visit-tags-table] -- call `visit-tags-table' on current line's buffer.
649\\[bs-help] -- display this help text." 657\\[bs-help] -- display this help text."
650 (interactive)
651 (kill-all-local-variables)
652 (use-local-map bs-mode-map)
653 (make-local-variable 'font-lock-defaults) 658 (make-local-variable 'font-lock-defaults)
654 (make-local-variable 'font-lock-verbose) 659 (make-local-variable 'font-lock-verbose)
655 (make-local-variable 'font-lock-global-modes) 660 (make-local-variable 'font-lock-global-modes)
656 (buffer-disable-undo) 661 (buffer-disable-undo)
657 (setq major-mode 'bs-mode 662 (setq buffer-read-only t
658 mode-name "Buffer-Selection-Menu"
659 buffer-read-only t
660 truncate-lines t 663 truncate-lines t
661 show-trailing-whitespace nil 664 show-trailing-whitespace nil
662 font-lock-global-modes '(not bs-mode) 665 font-lock-global-modes '(not bs-mode)
663 font-lock-defaults '(bs-mode-font-lock-keywords t) 666 font-lock-defaults '(bs-mode-font-lock-keywords t)
664 font-lock-verbose nil) 667 font-lock-verbose nil)
665 (run-mode-hooks 'bs-mode-hook)) 668 (add-hook 'window-size-change-functions 'bs--track-window-changes)
669 (add-hook 'kill-buffer-hook 'bs--remove-hooks nil t)
670 (add-hook 'change-major-mode-hook 'bs--remove-hooks nil t))
666 671
667(defun bs--restore-window-config () 672(defun bs--restore-window-config ()
668 "Restore window configuration on the current frame." 673 "Restore window configuration on the current frame."
669 (when bs--window-config-coming-from 674 (when bs--window-config-coming-from
670 (set-window-configuration bs--window-config-coming-from) 675 (let ((frame (selected-frame)))
676 (unwind-protect
677 (set-window-configuration bs--window-config-coming-from)
678 (select-frame frame)))
671 (setq bs--window-config-coming-from nil))) 679 (setq bs--window-config-coming-from nil)))
672 680
673(defun bs-kill () 681(defun bs-kill ()
@@ -705,8 +713,8 @@ Raise an error if not on a buffer line."
705 (beginning-of-line) 713 (beginning-of-line)
706 (let ((line (+ (- bs-header-lines-length) 714 (let ((line (+ (- bs-header-lines-length)
707 (count-lines 1 (point))))) 715 (count-lines 1 (point)))))
708 (if (< line 0) 716 (when (< line 0)
709 (error "You are on a header row")) 717 (error "You are on a header row"))
710 (nth line bs-current-list))) 718 (nth line bs-current-list)))
711 719
712(defun bs--update-current-line () 720(defun bs--update-current-line ()
@@ -736,19 +744,18 @@ Leave Buffer Selection Menu."
736 (bury-buffer (current-buffer)) 744 (bury-buffer (current-buffer))
737 (bs--restore-window-config) 745 (bs--restore-window-config)
738 (switch-to-buffer buffer) 746 (switch-to-buffer buffer)
739 (if bs--marked-buffers 747 (when bs--marked-buffers
740 ;; Some marked buffers for selection 748 ;; Some marked buffers for selection
741 (let* ((all (delq buffer bs--marked-buffers)) 749 (let* ((all (delq buffer bs--marked-buffers))
742 (height (/ (1- (frame-height)) (1+ (length all))))) 750 (height (/ (1- (frame-height)) (1+ (length all)))))
743 (delete-other-windows) 751 (delete-other-windows)
744 (switch-to-buffer buffer) 752 (switch-to-buffer buffer)
745 (while all 753 (dolist (buf all)
746 (split-window nil height) 754 (split-window nil height)
747 (other-window 1) 755 (other-window 1)
748 (switch-to-buffer (car all)) 756 (switch-to-buffer buf))
749 (setq all (cdr all))) 757 ;; goto window we have started bs.
750 ;; goto window we have started bs. 758 (other-window 1)))))
751 (other-window 1)))))
752 759
753(defun bs-select-other-window () 760(defun bs-select-other-window ()
754 "Select current line's buffer by `switch-to-buffer-other-window'. 761 "Select current line's buffer by `switch-to-buffer-other-window'.
@@ -912,11 +919,10 @@ WHAT is a value of nil, `never', or `always'."
912 (delete-region (point) (save-excursion 919 (delete-region (point) (save-excursion
913 (end-of-line) 920 (end-of-line)
914 (if (eobp) (point) (1+ (point))))) 921 (if (eobp) (point) (1+ (point)))))
915 (if (eobp) 922 (when (eobp)
916 (progn 923 (backward-delete-char 1)
917 (backward-delete-char 1) 924 (beginning-of-line)
918 (beginning-of-line) 925 (recenter -1))
919 (recenter -1)))
920 (bs--set-window-height))) 926 (bs--set-window-height)))
921 927
922(defun bs-delete-backward () 928(defun bs-delete-backward ()
@@ -945,14 +951,14 @@ Default is `bs--current-sort-function'."
945 bs--current-sort-function))) 951 bs--current-sort-function)))
946 (save-excursion 952 (save-excursion
947 (goto-char (point-min)) 953 (goto-char (point-min))
948 (if (and (nth 2 sort-description) 954 (when (and (nth 2 sort-description)
949 (search-forward-regexp (nth 2 sort-description) nil t)) 955 (search-forward-regexp (nth 2 sort-description) nil t))
950 (let ((inhibit-read-only t)) 956 (let ((inhibit-read-only t))
951 (put-text-property (match-beginning 0) 957 (put-text-property (match-beginning 0)
952 (match-end 0) 958 (match-end 0)
953 'face 959 'face
954 (or (nth 3 sort-description) 960 (or (nth 3 sort-description)
955 'region))))))) 961 'region)))))))
956 962
957(defun bs-toggle-show-all () 963(defun bs-toggle-show-all ()
958 "Toggle show all buffers / show buffers with current configuration." 964 "Toggle show all buffers / show buffers with current configuration."
@@ -983,10 +989,8 @@ Uses function `vc-toggle-read-only'."
983 989
984(defun bs--nth-wrapper (count fun &rest args) 990(defun bs--nth-wrapper (count fun &rest args)
985 "Call COUNT times function FUN with arguments ARGS." 991 "Call COUNT times function FUN with arguments ARGS."
986 (setq count (or count 1)) 992 (dotimes (i (or count 1))
987 (while (> count 0) 993 (apply fun args)))
988 (apply fun args)
989 (setq count (1- count))))
990 994
991(defun bs-up (arg) 995(defun bs-up (arg)
992 "Move cursor vertically up ARG lines in Buffer Selection Menu." 996 "Move cursor vertically up ARG lines in Buffer Selection Menu."
@@ -1026,7 +1030,7 @@ A value of nil means BUFFER belongs to a file."
1026 1030
1027(defun bs-sort-buffer-interns-are-last (b1 b2) 1031(defun bs-sort-buffer-interns-are-last (b1 b2)
1028 "Function for sorting internal buffers at the end of all buffers." 1032 "Function for sorting internal buffers at the end of all buffers."
1029 (string-match "^\\*" (buffer-name b2))) 1033 (string-match-p "^\\*" (buffer-name b2)))
1030 1034
1031;; ---------------------------------------------------------------------- 1035;; ----------------------------------------------------------------------
1032;; Configurations: 1036;; Configurations:
@@ -1108,8 +1112,8 @@ Will return the first if START-NAME is at end."
1108 (length (length list)) 1112 (length (length list))
1109 pos) 1113 pos)
1110 (while (and assocs (not pos)) 1114 (while (and assocs (not pos))
1111 (if (string= (car (car assocs)) start-name) 1115 (when (string= (car (car assocs)) start-name)
1112 (setq pos (- length (length assocs)))) 1116 (setq pos (- length (length assocs))))
1113 (setq assocs (cdr assocs))) 1117 (setq assocs (cdr assocs)))
1114 (setq pos (1+ pos)) 1118 (setq pos (1+ pos))
1115 (if (eq pos length) 1119 (if (eq pos length)
@@ -1151,10 +1155,9 @@ and move point to current buffer."
1151 (erase-buffer) 1155 (erase-buffer)
1152 (setq bs--name-entry-length name-entry-length) 1156 (setq bs--name-entry-length name-entry-length)
1153 (bs--show-header) 1157 (bs--show-header)
1154 (while list 1158 (dolist (buffer list)
1155 (bs--insert-one-entry (car list)) 1159 (bs--insert-one-entry buffer)
1156 (insert "\n") 1160 (insert "\n"))
1157 (setq list (cdr list)))
1158 (delete-backward-char 1) 1161 (delete-backward-char 1)
1159 (bs--set-window-height) 1162 (bs--set-window-height)
1160 (bs--goto-current-buffer) 1163 (bs--goto-current-buffer)
@@ -1348,27 +1351,21 @@ It goes over all columns described in `bs-attributes-list'
1348and evaluates corresponding string. Inserts string in current buffer; 1351and evaluates corresponding string. Inserts string in current buffer;
1349normally *buffer-selection*." 1352normally *buffer-selection*."
1350 (let ((string "") 1353 (let ((string "")
1351 (columns bs-attributes-list)
1352 (to-much 0) 1354 (to-much 0)
1353 (apply-args (append (list bs--buffer-coming-from bs-current-list)))) 1355 (apply-args (append (list bs--buffer-coming-from bs-current-list))))
1354 (save-excursion 1356 (save-excursion
1355 (while columns 1357 (set-buffer buffer)
1356 (set-buffer buffer) 1358 (dolist (column bs-attributes-list)
1357 (let ((min (bs--get-value (nth 1 (car columns)))) 1359 (let* ((min (bs--get-value (nth 1 column)))
1358 ;;(max (bs--get-value (nth 2 (car columns)))) refered no more 1360 (new-string (bs--format-aux (bs--get-value (nth 4 column) ; fun
1359 (align (nth 3 (car columns))) 1361 apply-args)
1360 (fun (nth 4 (car columns))) 1362 (nth 3 column) ; align
1361 (val nil) 1363 (- min to-much)))
1362 new-string) 1364 (len (length new-string)))
1363 (setq val (bs--get-value fun apply-args))
1364 (setq new-string (bs--format-aux val align (- min to-much)))
1365 (setq string (concat string new-string)) 1365 (setq string (concat string new-string))
1366 (if (> (length new-string) min) 1366 (when (> len min)
1367 (setq to-much (- (length new-string) min))) 1367 (setq to-much (- len min))))))
1368 ) ; let 1368 (insert string)))
1369 (setq columns (cdr columns))))
1370 (insert string)
1371 string))
1372 1369
1373(defun bs--format-aux (string align len) 1370(defun bs--format-aux (string align len)
1374 "Pad STRING to length LEN with alignment ALIGN. 1371 "Pad STRING to length LEN with alignment ALIGN.
@@ -1382,28 +1379,26 @@ ALIGN is one of the symbols `left', `middle', or `right'."
1382 1379
1383(defun bs--show-header () 1380(defun bs--show-header ()
1384 "Insert header for Buffer Selection Menu in current buffer." 1381 "Insert header for Buffer Selection Menu in current buffer."
1385 (dolist (string (bs--create-header)) 1382 (insert (bs--create-header-line #'identity)
1386 (insert string "\n"))) 1383 "\n"
1384 (bs--create-header-line (lambda (title)
1385 (make-string (length title) ?-)))
1386 "\n"))
1387 1387
1388(defun bs--get-name-length () 1388(defun bs--get-name-length ()
1389 "Return value of `bs--name-entry-length'." 1389 "Return value of `bs--name-entry-length'."
1390 bs--name-entry-length) 1390 bs--name-entry-length)
1391 1391
1392(defun bs--create-header () 1392(defun bs--create-header-line (col)
1393 "Return all header lines used in Buffer Selection Menu as a list of strings." 1393 "Generate a line for the header.
1394 (list (mapconcat (lambda (column) 1394COL is called for each column in `bs-attributes-list' as a
1395 (bs--format-aux (bs--get-value (car column)) 1395function of one argument, the string heading for the column."
1396 (nth 3 column) ; align 1396 (mapconcat (lambda (column)
1397 (bs--get-value (nth 1 column)))) 1397 (bs--format-aux (funcall col (bs--get-value (car column)))
1398 bs-attributes-list 1398 (nth 3 column) ; align
1399 "") 1399 (bs--get-value (nth 1 column))))
1400 (mapconcat (lambda (column) 1400 bs-attributes-list
1401 (let ((length (length (bs--get-value (car column))))) 1401 ""))
1402 (bs--format-aux (make-string length ?-)
1403 (nth 3 column) ; align
1404 (bs--get-value (nth 1 column)))))
1405 bs-attributes-list
1406 "")))
1407 1402
1408(defun bs--show-with-configuration (name &optional arg) 1403(defun bs--show-with-configuration (name &optional arg)
1409 "Display buffer list of configuration with name NAME. 1404 "Display buffer list of configuration with name NAME.
@@ -1424,14 +1419,14 @@ for buffer selection."
1424 (setq bs--buffer-coming-from (current-buffer))) 1419 (setq bs--buffer-coming-from (current-buffer)))
1425 (let ((liste (bs-buffer-list)) 1420 (let ((liste (bs-buffer-list))
1426 (active-window (get-window-with-predicate 1421 (active-window (get-window-with-predicate
1427 (lambda (w) 1422 (lambda (w)
1428 (string= (buffer-name (window-buffer w)) 1423 (string= (buffer-name (window-buffer w))
1429 "*buffer-selection*"))))) 1424 "*buffer-selection*"))
1425 nil (selected-frame))))
1430 (if active-window 1426 (if active-window
1431 (select-window active-window) 1427 (select-window active-window)
1432 (modify-frame-parameters nil 1428 (bs--restore-window-config)
1433 (list (cons 'bs--window-config-coming-from 1429 (setq bs--window-config-coming-from (current-window-configuration))
1434 (current-window-configuration))))
1435 (when (> (window-height (selected-window)) 7) 1430 (when (> (window-height (selected-window)) 7)
1436 (split-window-vertically) 1431 (split-window-vertically)
1437 (other-window 1))) 1432 (other-window 1)))