aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorDave Love2000-08-15 11:18:38 +0000
committerDave Love2000-08-15 11:18:38 +0000
commitdc7904f533d38b5a9f2b0be7aa90fd0e859aeb6d (patch)
tree10785f4ac492d3e4481e8b11996a7cb2f4ebadc0
parent3abc9fa14b0cd60f573047f77c540d4cee9e0e20 (diff)
downloademacs-dc7904f533d38b5a9f2b0be7aa90fd0e859aeb6d.tar.gz
emacs-dc7904f533d38b5a9f2b0be7aa90fd0e859aeb6d.zip
Fix indentation.
(bs) <defgroup>: Add :links.
-rw-r--r--lisp/bs.el607
1 files changed, 305 insertions, 302 deletions
diff --git a/lisp/bs.el b/lisp/bs.el
index 20fe02c363d..48779cb98e5 100644
--- a/lisp/bs.el
+++ b/lisp/bs.el
@@ -137,6 +137,8 @@
137(defgroup bs nil 137(defgroup bs nil
138 "Buffer Selection: Maintaining buffers by buffer menu." 138 "Buffer Selection: Maintaining buffers by buffer menu."
139 :version "21.1" 139 :version "21.1"
140 :link '(emacs-commentary-link "bs")
141 :link '(url-link "http://home.netsurf.de/olaf.sylvester/emacs")
140 :group 'convenience) 142 :group 'convenience)
141 143
142(defgroup bs-appearence nil 144(defgroup bs-appearence nil
@@ -180,7 +182,7 @@ return a string representing the columns value."
180(defun bs--make-header-match-string () 182(defun bs--make-header-match-string ()
181 "Return a regexp matching the first line of a Buffer Selection Menu buffer." 183 "Return a regexp matching the first line of a Buffer Selection Menu buffer."
182 (let ((res "^\\(") 184 (let ((res "^\\(")
183 (ele bs-attributes-list)) 185 (ele bs-attributes-list))
184 (while ele 186 (while ele
185 (setq res (concat res (car (car ele)) " *")) 187 (setq res (concat res (car (car ele)) " *"))
186 (setq ele (cdr ele))) 188 (setq ele (cdr ele)))
@@ -188,21 +190,21 @@ return a string representing the columns value."
188 190
189;;; Font-Lock-Settings 191;;; Font-Lock-Settings
190(defvar bs-mode-font-lock-keywords 192(defvar bs-mode-font-lock-keywords
191 (list ;; header in font-lock-type-face 193 (list;; header in font-lock-type-face
192 (list (bs--make-header-match-string) 194 (list (bs--make-header-match-string)
193 '(1 font-lock-type-face append) '(1 'bold append)) 195 '(1 font-lock-type-face append) '(1 'bold append))
194 ;; Buffername embedded by * 196 ;; Buffername embedded by *
195 (list "^\\(.*\\*.*\\*.*\\)$" 197 (list "^\\(.*\\*.*\\*.*\\)$"
196 1 (if bs--running-in-xemacs 198 1 (if bs--running-in-xemacs
197 ;; problem in XEmacs with font-lock-constant-face 199 ;; problem in XEmacs with font-lock-constant-face
198 (if (facep 'font-lock-constant-face) 200 (if (facep 'font-lock-constant-face)
199 'font-lock-constant-face 201 'font-lock-constant-face
200 'font-lock-comment-face) 202 'font-lock-comment-face)
201 'font-lock-constant-face)) 203 'font-lock-constant-face))
202 ;; Dired-Buffers 204 ;; Dired-Buffers
203 '("^..\\(.*Dired by .*\\)$" 1 font-lock-function-name-face) 205 '("^..\\(.*Dired by .*\\)$" 1 font-lock-function-name-face)
204 ;; the star for modified buffers 206 ;; the star for modified buffers
205 '("^.\\(\\*\\) +[^\\*]" 1 font-lock-comment-face)) 207 '("^.\\(\\*\\) +[^\\*]" 1 font-lock-comment-face))
206 "Default font lock expressions for Buffer Selection Menu.") 208 "Default font lock expressions for Buffer Selection Menu.")
207 209
208(defcustom bs-max-window-height 20 210(defcustom bs-max-window-height 20
@@ -365,18 +367,18 @@ A value of `always' means to show buffer regardless of the configuration.")
365(defun bs--sort-by-name (b1 b2) 367(defun bs--sort-by-name (b1 b2)
366 "Compare buffers B1 and B2 by buffer name." 368 "Compare buffers B1 and B2 by buffer name."
367 (string< (buffer-name b1) 369 (string< (buffer-name b1)
368 (buffer-name b2))) 370 (buffer-name b2)))
369 371
370(defun bs--sort-by-filename (b1 b2) 372(defun bs--sort-by-filename (b1 b2)
371 "Compare buffers B1 and B2 by file name." 373 "Compare buffers B1 and B2 by file name."
372 (string< (or (buffer-file-name b1) "") 374 (string< (or (buffer-file-name b1) "")
373 (or (buffer-file-name b2) ""))) 375 (or (buffer-file-name b2) "")))
374 376
375(defun bs--sort-by-mode (b1 b2) 377(defun bs--sort-by-mode (b1 b2)
376 "Compare buffers B1 and B2 by mode name." 378 "Compare buffers B1 and B2 by mode name."
377 (save-excursion 379 (save-excursion
378 (string< (progn (set-buffer b1) (format "%s" mode-name)) 380 (string< (progn (set-buffer b1) (format "%s" mode-name))
379 (progn (set-buffer b2) (format "%s" mode-name))))) 381 (progn (set-buffer b2) (format "%s" mode-name)))))
380 382
381(defun bs--sort-by-size (b1 b2) 383(defun bs--sort-by-size (b1 b2)
382 "Compare buffers B1 and B2 by buffer size." 384 "Compare buffers B1 and B2 by buffer size."
@@ -415,10 +417,10 @@ don't highlight.
415The new sort aspect will be inserted into list `bs-sort-functions'." 417The new sort aspect will be inserted into list `bs-sort-functions'."
416 (let ((tupel (assoc name bs-sort-functions))) 418 (let ((tupel (assoc name bs-sort-functions)))
417 (if tupel 419 (if tupel
418 (setcdr tupel (list fun regexp-for-sorting face)) 420 (setcdr tupel (list fun regexp-for-sorting face))
419 (setq bs-sort-functions 421 (setq bs-sort-functions
420 (cons (list name fun regexp-for-sorting face) 422 (cons (list name fun regexp-for-sorting face)
421 bs-sort-functions))))) 423 bs-sort-functions)))))
422 424
423(defvar bs--current-sort-function nil 425(defvar bs--current-sort-function nil
424 "Description of the current function for sorting the buffer list. 426 "Description of the current function for sorting the buffer list.
@@ -431,9 +433,9 @@ naming a sort behavior. Default is \"by nothing\" which means no sorting."
431 :group 'bs 433 :group 'bs
432 :type 'string 434 :type 'string
433 :set (lambda (var-name value) 435 :set (lambda (var-name value)
434 (set var-name value) 436 (set var-name value)
435 (setq bs--current-sort-function 437 (setq bs--current-sort-function
436 (assoc value bs-sort-functions)))) 438 (assoc value bs-sort-functions))))
437 439
438(defvar bs--buffer-coming-from nil 440(defvar bs--buffer-coming-from nil
439 "The buffer in which the user started the current Buffer Selection Menu.") 441 "The buffer in which the user started the current Buffer Selection Menu.")
@@ -534,52 +536,53 @@ and `bs-buffer-sort-function'.
534If SORT-DESCRIPTION isn't nil the list will be sorted by 536If SORT-DESCRIPTION isn't nil the list will be sorted by
535a special function. SORT-DESCRIPTION is an element of `bs-sort-functions'." 537a special function. SORT-DESCRIPTION is an element of `bs-sort-functions'."
536 (setq sort-description (or sort-description bs--current-sort-function) 538 (setq sort-description (or sort-description bs--current-sort-function)
537 list (or list (buffer-list))) 539 list (or list (buffer-list)))
538 (let ((result nil)) 540 (let ((result nil))
539 (while list 541 (while list
540 (let* ((buffername (buffer-name (car list))) 542 (let* ((buffername (buffer-name (car list)))
541 (int-show-never (string-match bs--intern-show-never buffername)) 543 (int-show-never (string-match bs--intern-show-never buffername))
542 (ext-show-never (and bs-dont-show-regexp 544 (ext-show-never (and bs-dont-show-regexp
543 (string-match bs-dont-show-regexp 545 (string-match bs-dont-show-regexp
544 buffername))) 546 buffername)))
545 (extern-must-show (or (and bs-must-always-show-regexp 547 (extern-must-show (or (and bs-must-always-show-regexp
546 (string-match bs-must-always-show-regexp 548 (string-match
547 buffername)) 549 bs-must-always-show-regexp
548 (and bs-must-show-regexp 550 buffername))
549 (string-match bs-must-show-regexp 551 (and bs-must-show-regexp
550 buffername)))) 552 (string-match bs-must-show-regexp
551 (extern-show-never-from-fun (and bs-dont-show-function 553 buffername))))
552 (funcall bs-dont-show-function 554 (extern-show-never-from-fun (and bs-dont-show-function
553 (car list)))) 555 (funcall bs-dont-show-function
554 (extern-must-show-from-fun (and bs-must-show-function 556 (car list))))
555 (funcall bs-must-show-function 557 (extern-must-show-from-fun (and bs-must-show-function
556 (car list)))) 558 (funcall bs-must-show-function
557 (show-flag (save-excursion 559 (car list))))
558 (set-buffer (car list)) 560 (show-flag (save-excursion
559 bs-buffer-show-mark))) 561 (set-buffer (car list))
560 (if (or (eq show-flag 'always) 562 bs-buffer-show-mark)))
561 (and (or bs--show-all (not (eq show-flag 'never))) 563 (if (or (eq show-flag 'always)
562 (not int-show-never) 564 (and (or bs--show-all (not (eq show-flag 'never)))
563 (or bs--show-all 565 (not int-show-never)
564 extern-must-show 566 (or bs--show-all
565 extern-must-show-from-fun 567 extern-must-show
566 (and (not ext-show-never) 568 extern-must-show-from-fun
567 (not extern-show-never-from-fun))))) 569 (and (not ext-show-never)
568 (setq result (cons (car list) 570 (not extern-show-never-from-fun)))))
569 result))) 571 (setq result (cons (car list)
570 (setq list (cdr list)))) 572 result)))
573 (setq list (cdr list))))
571 (setq result (reverse result)) 574 (setq result (reverse result))
572 ;; The current buffer which was the start point of bs should be an element 575 ;; The current buffer which was the start point of bs should be an element
573 ;; of result list, so that we can leave with space and be back in the 576 ;; of result list, so that we can leave with space and be back in the
574 ;; buffer we started bs-show. 577 ;; buffer we started bs-show.
575 (if (and bs--buffer-coming-from 578 (if (and bs--buffer-coming-from
576 (buffer-live-p bs--buffer-coming-from) 579 (buffer-live-p bs--buffer-coming-from)
577 (not (memq bs--buffer-coming-from result))) 580 (not (memq bs--buffer-coming-from result)))
578 (setq result (cons bs--buffer-coming-from result))) 581 (setq result (cons bs--buffer-coming-from result)))
579 ;; sorting 582 ;; sorting
580 (if (and sort-description 583 (if (and sort-description
581 (nth 1 sort-description)) 584 (nth 1 sort-description))
582 (setq result (sort result (nth 1 sort-description))) 585 (setq result (sort result (nth 1 sort-description)))
583 ;; else standard sorting 586 ;; else standard sorting
584 (bs-buffer-sort result)))) 587 (bs-buffer-sort result))))
585 588
@@ -596,31 +599,31 @@ SORT-DESCRIPTION is an element of `bs-sort-functions'"
596 (let ((line (1+ (count-lines 1 (point))))) 599 (let ((line (1+ (count-lines 1 (point)))))
597 (bs-show-in-buffer (bs-buffer-list nil sort-description)) 600 (bs-show-in-buffer (bs-buffer-list nil sort-description))
598 (if keep-line-p 601 (if keep-line-p
599 (goto-line line)) 602 (goto-line line))
600 (beginning-of-line))) 603 (beginning-of-line)))
601 604
602(defun bs--goto-current-buffer () 605(defun bs--goto-current-buffer ()
603 "Goto line which represents the current buffer; 606 "Goto line which represents the current buffer;
604actually the line which begins with character in `bs-string-current' or 607actually the line which begins with character in `bs-string-current' or
605`bs-string-current-marked'." 608`bs-string-current-marked'."
606 (let (point 609 (let ((regexp (concat "^"
607 (regexp (concat "^" 610 (regexp-quote bs-string-current)
608 (regexp-quote bs-string-current) 611 "\\|^"
609 "\\|^" 612 (regexp-quote bs-string-current-marked)))
610 (regexp-quote bs-string-current-marked)))) 613 point)
611 (save-excursion 614 (save-excursion
612 (goto-char (point-min)) 615 (goto-char (point-min))
613 (if (search-forward-regexp regexp nil t) 616 (if (search-forward-regexp regexp nil t)
614 (setq point (- (point) 1)))) 617 (setq point (- (point) 1))))
615 (if point 618 (if point
616 (goto-char point)))) 619 (goto-char point))))
617 620
618(defun bs--current-config-message () 621(defun bs--current-config-message ()
619 "Return a string describing the current `bs-mode' configuration." 622 "Return a string describing the current `bs-mode' configuration."
620 (if bs--show-all 623 (if bs--show-all
621 "Show all buffers." 624 "Show all buffers."
622 (format "Show buffer by configuration %S" 625 (format "Show buffer by configuration %S"
623 bs-current-configuration))) 626 bs-current-configuration)))
624 627
625(defun bs-mode () 628(defun bs-mode ()
626 "Major mode for editing a subset of Emacs' buffers. 629 "Major mode for editing a subset of Emacs' buffers.
@@ -661,11 +664,11 @@ to show always.
661 (make-local-variable 'font-lock-defaults) 664 (make-local-variable 'font-lock-defaults)
662 (make-local-variable 'font-lock-verbose) 665 (make-local-variable 'font-lock-verbose)
663 (setq major-mode 'bs-mode 666 (setq major-mode 'bs-mode
664 mode-name "Buffer-Selection-Menu" 667 mode-name "Buffer-Selection-Menu"
665 buffer-read-only t 668 buffer-read-only t
666 truncate-lines t 669 truncate-lines t
667 font-lock-defaults '(bs-mode-font-lock-keywords t) 670 font-lock-defaults '(bs-mode-font-lock-keywords t)
668 font-lock-verbose nil) 671 font-lock-verbose nil)
669 (run-hooks 'bs-mode-hook)) 672 (run-hooks 'bs-mode-hook))
670 673
671(defun bs-kill () 674(defun bs-kill ()
@@ -676,7 +679,7 @@ to show always.
676 679
677(defun bs-abort () 680(defun bs-abort ()
678 "Ding and leave Buffer Selection Menu without a selection." 681 "Ding and leave Buffer Selection Menu without a selection."
679 (interactive) 682 (interactive)
680 (ding) 683 (ding)
681 (bs-kill)) 684 (bs-kill))
682 685
@@ -698,35 +701,35 @@ Take only windows of current frame into account.
698Return nil if there is no such buffer." 701Return nil if there is no such buffer."
699 (let ((window nil)) 702 (let ((window nil))
700 (walk-windows (lambda (wind) 703 (walk-windows (lambda (wind)
701 (if (string= (buffer-name (window-buffer wind)) 704 (if (string= (buffer-name (window-buffer wind))
702 buffer-name) 705 buffer-name)
703 (setq window wind)))) 706 (setq window wind))))
704 window)) 707 window))
705 708
706(defun bs--set-window-height () 709(defun bs--set-window-height ()
707 "Change the height of the selected window to suit the current buffer list." 710 "Change the height of the selected window to suit the current buffer list."
708 (unless (one-window-p t) 711 (unless (one-window-p t)
709 (shrink-window (- (window-height (selected-window)) 712 (shrink-window (- (window-height (selected-window))
710 ;; window-height in xemacs includes mode-line 713 ;; window-height in xemacs includes mode-line
711 (+ (if bs--running-in-xemacs 3 1) 714 (+ (if bs--running-in-xemacs 3 1)
712 bs-header-lines-length 715 bs-header-lines-length
713 (min (length bs-current-list) 716 (min (length bs-current-list)
714 bs-max-window-height)))))) 717 bs-max-window-height))))))
715 718
716(defun bs--current-buffer () 719(defun bs--current-buffer ()
717 "Return buffer on current line. 720 "Return buffer on current line.
718Raise an error if not an a buffer line." 721Raise an error if not an a buffer line."
719 (beginning-of-line) 722 (beginning-of-line)
720 (let ((line (+ (- bs-header-lines-length) 723 (let ((line (+ (- bs-header-lines-length)
721 (count-lines 1 (point))))) 724 (count-lines 1 (point)))))
722 (if (< line 0) 725 (if (< line 0)
723 (error "You are on a header row")) 726 (error "You are on a header row"))
724 (nth line bs-current-list))) 727 (nth line bs-current-list)))
725 728
726(defun bs--update-current-line () 729(defun bs--update-current-line ()
727 "Update the entry on current line for Buffer Selection Menu." 730 "Update the entry on current line for Buffer Selection Menu."
728 (let ((buffer (bs--current-buffer)) 731 (let ((buffer (bs--current-buffer))
729 (inhibit-read-only t)) 732 (inhibit-read-only t))
730 (beginning-of-line) 733 (beginning-of-line)
731 (delete-region (point) (line-end-position)) 734 (delete-region (point) (line-end-position))
732 (bs--insert-one-entry buffer) 735 (bs--insert-one-entry buffer)
@@ -751,18 +754,18 @@ Leave Buffer Selection Menu."
751 (set-window-configuration bs--window-config-coming-from) 754 (set-window-configuration bs--window-config-coming-from)
752 (switch-to-buffer buffer) 755 (switch-to-buffer buffer)
753 (if bs--marked-buffers 756 (if bs--marked-buffers
754 ;; Some marked buffers for selection 757 ;; Some marked buffers for selection
755 (let* ((all (delq buffer bs--marked-buffers)) 758 (let* ((all (delq buffer bs--marked-buffers))
756 (height (/ (1- (frame-height)) (1+ (length all))))) 759 (height (/ (1- (frame-height)) (1+ (length all)))))
757 (delete-other-windows) 760 (delete-other-windows)
758 (switch-to-buffer buffer) 761 (switch-to-buffer buffer)
759 (while all 762 (while all
760 (split-window nil height) 763 (split-window nil height)
761 (other-window 1) 764 (other-window 1)
762 (switch-to-buffer (car all)) 765 (switch-to-buffer (car all))
763 (setq all (cdr all))) 766 (setq all (cdr all)))
764 ;; goto window we have started bs. 767 ;; goto window we have started bs.
765 (other-window 1))))) 768 (other-window 1)))))
766 769
767(defun bs-select-other-window () 770(defun bs-select-other-window ()
768 "Select current line's buffer by `switch-to-buffer-other-window'. 771 "Select current line's buffer by `switch-to-buffer-other-window'.
@@ -834,21 +837,21 @@ See `visit-tags-table'."
834 (interactive) 837 (interactive)
835 (let ((file (buffer-file-name (bs--current-buffer)))) 838 (let ((file (buffer-file-name (bs--current-buffer))))
836 (if file 839 (if file
837 (visit-tags-table file) 840 (visit-tags-table file)
838 (error "Specified buffer has no file")))) 841 (error "Specified buffer has no file"))))
839 842
840(defun bs-toggle-current-to-show () 843(defun bs-toggle-current-to-show ()
841 "Toggle status of showing flag for buffer in current line." 844 "Toggle status of showing flag for buffer in current line."
842 (interactive) 845 (interactive)
843 (let ((buffer (bs--current-buffer)) 846 (let ((buffer (bs--current-buffer))
844 res) 847 res)
845 (save-excursion 848 (save-excursion
846 (set-buffer buffer) 849 (set-buffer buffer)
847 (setq res (cond ((null bs-buffer-show-mark) 850 (setq res (cond ((null bs-buffer-show-mark)
848 'never) 851 'never)
849 ((eq bs-buffer-show-mark 'never) 852 ((eq bs-buffer-show-mark 'never)
850 'always) 853 'always)
851 (t nil))) 854 (t nil)))
852 (setq bs-buffer-show-mark res)) 855 (setq bs-buffer-show-mark res))
853 (bs--update-current-line) 856 (bs--update-current-line)
854 (bs--set-window-height) 857 (bs--set-window-height)
@@ -886,13 +889,13 @@ COUNT is the number of buffers to mark.
886Move cursor vertically down COUNT lines." 889Move cursor vertically down COUNT lines."
887 (interactive "p") 890 (interactive "p")
888 (let ((dir (if (> count 0) 1 -1)) 891 (let ((dir (if (> count 0) 1 -1))
889 (count (abs count))) 892 (count (abs count)))
890 (while (> count 0) 893 (while (> count 0)
891 (let ((buffer (bs--current-buffer))) 894 (let ((buffer (bs--current-buffer)))
892 (if buffer 895 (if buffer
893 (setq bs--marked-buffers (cons buffer bs--marked-buffers))) 896 (setq bs--marked-buffers (cons buffer bs--marked-buffers)))
894 (bs--update-current-line) 897 (bs--update-current-line)
895 (bs-down dir)) 898 (bs-down dir))
896 (setq count (1- count))))) 899 (setq count (1- count)))))
897 900
898(defun bs-unmark-current (count) 901(defun bs-unmark-current (count)
@@ -901,40 +904,40 @@ COUNT is the number of buffers to unmark.
901Move cursor vertically down COUNT lines." 904Move cursor vertically down COUNT lines."
902 (interactive "p") 905 (interactive "p")
903 (let ((dir (if (> count 0) 1 -1)) 906 (let ((dir (if (> count 0) 1 -1))
904 (count (abs count))) 907 (count (abs count)))
905 (while (> count 0) 908 (while (> count 0)
906 (let ((buffer (bs--current-buffer))) 909 (let ((buffer (bs--current-buffer)))
907 (if buffer 910 (if buffer
908 (setq bs--marked-buffers (delq buffer bs--marked-buffers))) 911 (setq bs--marked-buffers (delq buffer bs--marked-buffers)))
909 (bs--update-current-line) 912 (bs--update-current-line)
910 (bs-down dir)) 913 (bs-down dir))
911 (setq count (1- count))))) 914 (setq count (1- count)))))
912 915
913(defun bs--show-config-message (what) 916(defun bs--show-config-message (what)
914 "Show message indicating the new showing status WHAT. 917 "Show message indicating the new showing status WHAT.
915WHAT is a value of nil, `never', or `always'." 918WHAT is a value of nil, `never', or `always'."
916 (bs-message-without-log (cond ((null what) 919 (bs-message-without-log (cond ((null what)
917 "Buffer will be shown normally.") 920 "Buffer will be shown normally.")
918 ((eq what 'never) 921 ((eq what 'never)
919 "Mark buffer to never be shown.") 922 "Mark buffer to never be shown.")
920 (t "Mark buffer to show always.")))) 923 (t "Mark buffer to show always."))))
921 924
922(defun bs-delete () 925(defun bs-delete ()
923 "Kill buffer on current line." 926 "Kill buffer on current line."
924 (interactive) 927 (interactive)
925 (let ((current (bs--current-buffer)) 928 (let ((current (bs--current-buffer))
926 (inhibit-read-only t)) 929 (inhibit-read-only t))
927 (setq bs-current-list (delq current bs-current-list)) 930 (setq bs-current-list (delq current bs-current-list))
928 (kill-buffer current) 931 (kill-buffer current)
929 (beginning-of-line) 932 (beginning-of-line)
930 (delete-region (point) (save-excursion 933 (delete-region (point) (save-excursion
931 (end-of-line) 934 (end-of-line)
932 (if (eobp) (point) (1+ (point))))) 935 (if (eobp) (point) (1+ (point)))))
933 (if (eobp) 936 (if (eobp)
934 (progn 937 (progn
935 (backward-delete-char 1) 938 (backward-delete-char 1)
936 (beginning-of-line) 939 (beginning-of-line)
937 (recenter -1))) 940 (recenter -1)))
938 (bs--set-window-height))) 941 (bs--set-window-height)))
939 942
940(defun bs-delete-backward () 943(defun bs-delete-backward ()
@@ -943,14 +946,14 @@ WHAT is a value of nil, `never', or `always'."
943 (let ((on-last-line-p (save-excursion (end-of-line) (eobp)))) 946 (let ((on-last-line-p (save-excursion (end-of-line) (eobp))))
944 (bs-delete) 947 (bs-delete)
945 (unless on-last-line-p 948 (unless on-last-line-p
946 (bs-up 1)))) 949 (bs-up 1))))
947 950
948(defun bs-show-sorted () 951(defun bs-show-sorted ()
949 "Show buffer list sorted by buffer name." 952 "Show buffer list sorted by buffer name."
950 (interactive) 953 (interactive)
951 (setq bs--current-sort-function 954 (setq bs--current-sort-function
952 (bs-next-config-aux (car bs--current-sort-function) 955 (bs-next-config-aux (car bs--current-sort-function)
953 bs-sort-functions)) 956 bs-sort-functions))
954 (bs--redisplay) 957 (bs--redisplay)
955 (bs--goto-current-buffer) 958 (bs--goto-current-buffer)
956 (bs-message-without-log "Sorted %s" (car bs--current-sort-function))) 959 (bs-message-without-log "Sorted %s" (car bs--current-sort-function)))
@@ -960,7 +963,7 @@ WHAT is a value of nil, `never', or `always'."
960SORT-DESCRIPTION is an element of `bs-sort-functions'. 963SORT-DESCRIPTION is an element of `bs-sort-functions'.
961Default is `bs--current-sort-function'." 964Default is `bs--current-sort-function'."
962 (let ((sort-description (or sort-description 965 (let ((sort-description (or sort-description
963 bs--current-sort-function))) 966 bs--current-sort-function)))
964 (save-excursion 967 (save-excursion
965 (goto-char (point-min)) 968 (goto-char (point-min))
966 (if (and (nth 2 sort-description) 969 (if (and (nth 2 sort-description)
@@ -1020,9 +1023,9 @@ If on top of buffer list go to last line."
1020 (previous-line 1) 1023 (previous-line 1)
1021 (if (<= (count-lines 1 (point)) (1- bs-header-lines-length)) 1024 (if (<= (count-lines 1 (point)) (1- bs-header-lines-length))
1022 (progn 1025 (progn
1023 (goto-char (point-max)) 1026 (goto-char (point-max))
1024 (beginning-of-line) 1027 (beginning-of-line)
1025 (recenter -1)) 1028 (recenter -1))
1026 (beginning-of-line))) 1029 (beginning-of-line)))
1027 1030
1028(defun bs-down (arg) 1031(defun bs-down (arg)
@@ -1037,7 +1040,7 @@ If on top of buffer list go to last line."
1037If at end of buffer list go to first line." 1040If at end of buffer list go to first line."
1038 (let ((last (line-end-position))) 1041 (let ((last (line-end-position)))
1039 (if (eq last (point-max)) 1042 (if (eq last (point-max))
1040 (goto-line (1+ bs-header-lines-length)) 1043 (goto-line (1+ bs-header-lines-length))
1041 (next-line 1)))) 1044 (next-line 1))))
1042 1045
1043(defun bs-visits-non-file (buffer) 1046(defun bs-visits-non-file (buffer)
@@ -1060,28 +1063,28 @@ These variables are `bs-dont-show-regexp', `bs-must-show-regexp',
1060`bs-dont-show-function', `bs-must-show-function' and 1063`bs-dont-show-function', `bs-must-show-function' and
1061`bs-buffer-sort-function'." 1064`bs-buffer-sort-function'."
1062 (setq bs-dont-show-regexp nil 1065 (setq bs-dont-show-regexp nil
1063 bs-must-show-regexp nil 1066 bs-must-show-regexp nil
1064 bs-dont-show-function nil 1067 bs-dont-show-function nil
1065 bs-must-show-function nil 1068 bs-must-show-function nil
1066 bs-buffer-sort-function nil)) 1069 bs-buffer-sort-function nil))
1067 1070
1068(defun bs-config--only-files () 1071(defun bs-config--only-files ()
1069 "Define a configuration for showing only buffers visiting a file." 1072 "Define a configuration for showing only buffers visiting a file."
1070 (bs-config-clear) 1073 (bs-config-clear)
1071 (setq ;; I want to see *-buffers at the end 1074 (setq;; I want to see *-buffers at the end
1072 bs-buffer-sort-function 'bs-sort-buffer-interns-are-last 1075 bs-buffer-sort-function 'bs-sort-buffer-interns-are-last
1073 ;; Don't show files who don't belong to a file 1076 ;; Don't show files who don't belong to a file
1074 bs-dont-show-function 'bs-visits-non-file)) 1077 bs-dont-show-function 'bs-visits-non-file))
1075 1078
1076(defun bs-config--files-and-scratch () 1079(defun bs-config--files-and-scratch ()
1077 "Define a configuration for showing buffer *scratch* and file buffers." 1080 "Define a configuration for showing buffer *scratch* and file buffers."
1078 (bs-config-clear) 1081 (bs-config-clear)
1079 (setq ;; I want to see *-buffers at the end 1082 (setq;; I want to see *-buffers at the end
1080 bs-buffer-sort-function 'bs-sort-buffer-interns-are-last 1083 bs-buffer-sort-function 'bs-sort-buffer-interns-are-last
1081 ;; Don't show files who don't belong to a file 1084 ;; Don't show files who don't belong to a file
1082 bs-dont-show-function 'bs-visits-non-file 1085 bs-dont-show-function 'bs-visits-non-file
1083 ;; Show *scratch* buffer. 1086 ;; Show *scratch* buffer.
1084 bs-must-show-regexp "^\\*scratch\\*")) 1087 bs-must-show-regexp "^\\*scratch\\*"))
1085 1088
1086(defun bs-config--all () 1089(defun bs-config--all ()
1087 "Define a configuration for showing all buffers. 1090 "Define a configuration for showing all buffers.
@@ -1100,20 +1103,20 @@ Intern buffers appear at end of all buffers."
1100When called interactively ask user for a configuration and apply selected 1103When called interactively ask user for a configuration and apply selected
1101configuration." 1104configuration."
1102 (interactive (list (completing-read "Use configuration: " 1105 (interactive (list (completing-read "Use configuration: "
1103 bs-configurations 1106 bs-configurations
1104 nil 1107 nil
1105 t))) 1108 t)))
1106 (let ((list (assoc name bs-configurations))) 1109 (let ((list (assoc name bs-configurations)))
1107 (if list 1110 (if list
1108 (if (listp list) 1111 (if (listp list)
1109 (setq bs-current-configuration name 1112 (setq bs-current-configuration name
1110 bs-must-show-regexp (nth 1 list) 1113 bs-must-show-regexp (nth 1 list)
1111 bs-must-show-function (nth 2 list) 1114 bs-must-show-function (nth 2 list)
1112 bs-dont-show-regexp (nth 3 list) 1115 bs-dont-show-regexp (nth 3 list)
1113 bs-dont-show-function (nth 4 list) 1116 bs-dont-show-function (nth 4 list)
1114 bs-buffer-sort-function (nth 5 list)) 1117 bs-buffer-sort-function (nth 5 list))
1115 ;; for backward compability 1118 ;; for backward compability
1116 (funcall (cdr list))) 1119 (funcall (cdr list)))
1117 ;; else 1120 ;; else
1118 (ding) 1121 (ding)
1119 (bs-message-without-log "No bs-configuration named %S." name)))) 1122 (bs-message-without-log "No bs-configuration named %S." name))))
@@ -1127,15 +1130,15 @@ configuration."
1127 "Get the next assoc after START-NAME in list LIST. 1130 "Get the next assoc after START-NAME in list LIST.
1128Will return the first if START-NAME is at end." 1131Will return the first if START-NAME is at end."
1129 (let ((assocs list) 1132 (let ((assocs list)
1130 (length (length list)) 1133 (length (length list))
1131 pos) 1134 pos)
1132 (while (and assocs (not pos)) 1135 (while (and assocs (not pos))
1133 (if (string= (car (car assocs)) start-name) 1136 (if (string= (car (car assocs)) start-name)
1134 (setq pos (- length (length assocs)))) 1137 (setq pos (- length (length assocs))))
1135 (setq assocs (cdr assocs))) 1138 (setq assocs (cdr assocs)))
1136 (setq pos (1+ pos)) 1139 (setq pos (1+ pos))
1137 (if (eq pos length) 1140 (if (eq pos length)
1138 (car list) 1141 (car list)
1139 (nth pos list)))) 1142 (nth pos list))))
1140 1143
1141(defun bs-next-config (name) 1144(defun bs-next-config (name)
@@ -1163,13 +1166,13 @@ and move point to current buffer."
1163 (switch-to-buffer (get-buffer-create "*buffer-selection*")) 1166 (switch-to-buffer (get-buffer-create "*buffer-selection*"))
1164 (bs-mode) 1167 (bs-mode)
1165 (let* ((inhibit-read-only t) 1168 (let* ((inhibit-read-only t)
1166 (map-fun (lambda (entry) 1169 (map-fun (lambda (entry)
1167 (length (buffer-name entry)))) 1170 (length (buffer-name entry))))
1168 (max-length-of-names (apply 'max 1171 (max-length-of-names (apply 'max
1169 (cons 0 (mapcar map-fun list)))) 1172 (cons 0 (mapcar map-fun list))))
1170 (name-entry-length (min bs-maximal-buffer-name-column 1173 (name-entry-length (min bs-maximal-buffer-name-column
1171 (max bs-minimal-buffer-name-column 1174 (max bs-minimal-buffer-name-column
1172 max-length-of-names)))) 1175 max-length-of-names))))
1173 (erase-buffer) 1176 (erase-buffer)
1174 (setq bs--name-entry-length name-entry-length) 1177 (setq bs--name-entry-length name-entry-length)
1175 (bs--show-header) 1178 (bs--show-header)
@@ -1190,12 +1193,12 @@ If BUFFER-LIST is nil the result of `bs-buffer-list' will be used as
1190buffer list. The result is a cons of normally the second element of 1193buffer list. The result is a cons of normally the second element of
1191BUFFER-LIST and the buffer list used for buffer cycling." 1194BUFFER-LIST and the buffer list used for buffer cycling."
1192 (let* ((bs--current-sort-function (if sorting-p 1195 (let* ((bs--current-sort-function (if sorting-p
1193 bs--current-sort-function)) 1196 bs--current-sort-function))
1194 (bs-buffer-list (or buffer-list (bs-buffer-list)))) 1197 (bs-buffer-list (or buffer-list (bs-buffer-list))))
1195 (cons (or (car (cdr bs-buffer-list)) 1198 (cons (or (car (cdr bs-buffer-list))
1196 (car bs-buffer-list) 1199 (car bs-buffer-list)
1197 (current-buffer)) 1200 (current-buffer))
1198 bs-buffer-list))) 1201 bs-buffer-list)))
1199 1202
1200(defun bs-previous-buffer (&optional buffer-list sorting-p) 1203(defun bs-previous-buffer (&optional buffer-list sorting-p)
1201 "Return previous buffer and buffer list for buffer cycling in BUFFER-LIST. 1204 "Return previous buffer and buffer list for buffer cycling in BUFFER-LIST.
@@ -1204,11 +1207,11 @@ If BUFFER-LIST is nil the result of `bs-buffer-list' will be used as
1204buffer list. The result is a cons of last element of BUFFER-LIST and the 1207buffer list. The result is a cons of last element of BUFFER-LIST and the
1205buffer list used for buffer cycling." 1208buffer list used for buffer cycling."
1206 (let* ((bs--current-sort-function (if sorting-p 1209 (let* ((bs--current-sort-function (if sorting-p
1207 bs--current-sort-function)) 1210 bs--current-sort-function))
1208 (bs-buffer-list (or buffer-list (bs-buffer-list)))) 1211 (bs-buffer-list (or buffer-list (bs-buffer-list))))
1209 (cons (or (car (last bs-buffer-list)) 1212 (cons (or (car (last bs-buffer-list))
1210 (current-buffer)) 1213 (current-buffer))
1211 bs-buffer-list))) 1214 bs-buffer-list)))
1212 1215
1213(defun bs-message-without-log (&rest args) 1216(defun bs-message-without-log (&rest args)
1214 "Like `message' but don't log it on the message log. 1217 "Like `message' but don't log it on the message log.
@@ -1226,29 +1229,29 @@ The buffers taking part in buffer cycling are defined
1226by buffer configuration `bs-cycle-configuration-name'." 1229by buffer configuration `bs-cycle-configuration-name'."
1227 (interactive) 1230 (interactive)
1228 (let ((bs--buffer-coming-from (current-buffer)) 1231 (let ((bs--buffer-coming-from (current-buffer))
1229 (bs-dont-show-regexp bs-dont-show-regexp) 1232 (bs-dont-show-regexp bs-dont-show-regexp)
1230 (bs-must-show-regexp bs-must-show-regexp) 1233 (bs-must-show-regexp bs-must-show-regexp)
1231 (bs-dont-show-function bs-dont-show-function) 1234 (bs-dont-show-function bs-dont-show-function)
1232 (bs-must-show-function bs-must-show-function) 1235 (bs-must-show-function bs-must-show-function)
1233 (bs--show-all bs--show-all)) 1236 (bs--show-all bs--show-all))
1234 (if bs-cycle-configuration-name 1237 (if bs-cycle-configuration-name
1235 (bs-set-configuration bs-cycle-configuration-name)) 1238 (bs-set-configuration bs-cycle-configuration-name))
1236 (let ((bs-buffer-sort-function nil) 1239 (let ((bs-buffer-sort-function nil)
1237 (bs--current-sort-function nil)) 1240 (bs--current-sort-function nil))
1238 (let* ((tupel (bs-next-buffer (if (or (eq last-command 1241 (let* ((tupel (bs-next-buffer (if (or (eq last-command
1239 'bs-cycle-next) 1242 'bs-cycle-next)
1240 (eq last-command 1243 (eq last-command
1241 'bs-cycle-previous)) 1244 'bs-cycle-previous))
1242 bs--cycle-list))) 1245 bs--cycle-list)))
1243 (next (car tupel)) 1246 (next (car tupel))
1244 (cycle-list (cdr tupel))) 1247 (cycle-list (cdr tupel)))
1245 (setq bs--cycle-list (append (cdr cycle-list) 1248 (setq bs--cycle-list (append (cdr cycle-list)
1246 (list (car cycle-list)))) 1249 (list (car cycle-list))))
1247 (bury-buffer) 1250 (bury-buffer)
1248 (switch-to-buffer next) 1251 (switch-to-buffer next)
1249 (bs-message-without-log "Next buffers: %s" 1252 (bs-message-without-log "Next buffers: %s"
1250 (or (cdr bs--cycle-list) 1253 (or (cdr bs--cycle-list)
1251 "this buffer")))))) 1254 "this buffer"))))))
1252 1255
1253 1256
1254;;;###autoload 1257;;;###autoload
@@ -1258,38 +1261,38 @@ The buffers taking part in buffer cycling are defined
1258by buffer configuration `bs-cycle-configuration-name'." 1261by buffer configuration `bs-cycle-configuration-name'."
1259 (interactive) 1262 (interactive)
1260 (let ((bs--buffer-coming-from (current-buffer)) 1263 (let ((bs--buffer-coming-from (current-buffer))
1261 (bs-dont-show-regexp bs-dont-show-regexp) 1264 (bs-dont-show-regexp bs-dont-show-regexp)
1262 (bs-must-show-regexp bs-must-show-regexp) 1265 (bs-must-show-regexp bs-must-show-regexp)
1263 (bs-dont-show-function bs-dont-show-function) 1266 (bs-dont-show-function bs-dont-show-function)
1264 (bs-must-show-function bs-must-show-function) 1267 (bs-must-show-function bs-must-show-function)
1265 (bs--show-all bs--show-all)) 1268 (bs--show-all bs--show-all))
1266 (if bs-cycle-configuration-name 1269 (if bs-cycle-configuration-name
1267 (bs-set-configuration bs-cycle-configuration-name)) 1270 (bs-set-configuration bs-cycle-configuration-name))
1268 (let ((bs-buffer-sort-function nil) 1271 (let ((bs-buffer-sort-function nil)
1269 (bs--current-sort-function nil)) 1272 (bs--current-sort-function nil))
1270 (let* ((tupel (bs-previous-buffer (if (or (eq last-command 1273 (let* ((tupel (bs-previous-buffer (if (or (eq last-command
1271 'bs-cycle-next) 1274 'bs-cycle-next)
1272 (eq last-command 1275 (eq last-command
1273 'bs-cycle-previous)) 1276 'bs-cycle-previous))
1274 bs--cycle-list))) 1277 bs--cycle-list)))
1275 (prev-buffer (car tupel)) 1278 (prev-buffer (car tupel))
1276 (cycle-list (cdr tupel))) 1279 (cycle-list (cdr tupel)))
1277 (setq bs--cycle-list (append (last cycle-list) 1280 (setq bs--cycle-list (append (last cycle-list)
1278 (reverse (cdr (reverse cycle-list))))) 1281 (reverse (cdr (reverse cycle-list)))))
1279 (switch-to-buffer prev-buffer) 1282 (switch-to-buffer prev-buffer)
1280 (bs-message-without-log "Previous buffers: %s" 1283 (bs-message-without-log "Previous buffers: %s"
1281 (or (reverse (cdr bs--cycle-list)) 1284 (or (reverse (cdr bs--cycle-list))
1282 "this buffer")))))) 1285 "this buffer"))))))
1283 1286
1284(defun bs--get-value (fun &optional args) 1287(defun bs--get-value (fun &optional args)
1285 "Apply function FUN with arguments ARGS. 1288 "Apply function FUN with arguments ARGS.
1286Return result of evaluation. Will return FUN if FUN is a number 1289Return result of evaluation. Will return FUN if FUN is a number
1287or a string." 1290or a string."
1288 (cond ((numberp fun) 1291 (cond ((numberp fun)
1289 fun) 1292 fun)
1290 ((stringp fun) 1293 ((stringp fun)
1291 fun) 1294 fun)
1292 (t (apply fun args)))) 1295 (t (apply fun args))))
1293 1296
1294(defun bs--get-marked-string (start-buffer all-buffers) 1297(defun bs--get-marked-string (start-buffer all-buffers)
1295 "Return a string which describes whether current buffer is marked. 1298 "Return a string which describes whether current buffer is marked.
@@ -1298,23 +1301,23 @@ ALL-BUFFERS is the list of buffer appearing in Buffer Selection Menu.
1298The result string is one of `bs-string-current', `bs-string-current-marked', 1301The result string is one of `bs-string-current', `bs-string-current-marked',
1299`bs-string-marked', `bs-string-show-normally', `bs-string-show-never', or 1302`bs-string-marked', `bs-string-show-normally', `bs-string-show-never', or
1300`bs-string-show-always'." 1303`bs-string-show-always'."
1301 (cond ;; current buffer is the buffer we started buffer selection. 1304 (cond;; current buffer is the buffer we started buffer selection.
1302 ((eq (current-buffer) start-buffer) 1305 ((eq (current-buffer) start-buffer)
1303 (if (memq (current-buffer) bs--marked-buffers) 1306 (if (memq (current-buffer) bs--marked-buffers)
1304 bs-string-current-marked ; buffer is marked 1307 bs-string-current-marked ; buffer is marked
1305 bs-string-current)) 1308 bs-string-current))
1306 ;; current buffer is marked 1309 ;; current buffer is marked
1307 ((memq (current-buffer) bs--marked-buffers) 1310 ((memq (current-buffer) bs--marked-buffers)
1308 bs-string-marked) 1311 bs-string-marked)
1309 ;; current buffer hasn't a special mark. 1312 ;; current buffer hasn't a special mark.
1310 ((null bs-buffer-show-mark) 1313 ((null bs-buffer-show-mark)
1311 bs-string-show-normally) 1314 bs-string-show-normally)
1312 ;; current buffer has a mark not to show itself. 1315 ;; current buffer has a mark not to show itself.
1313 ((eq bs-buffer-show-mark 'never) 1316 ((eq bs-buffer-show-mark 'never)
1314 bs-string-show-never) 1317 bs-string-show-never)
1315 ;; otherwise current buffer is marked to show always. 1318 ;; otherwise current buffer is marked to show always.
1316 (t 1319 (t
1317 bs-string-show-always))) 1320 bs-string-show-always)))
1318 1321
1319(defun bs--get-modified-string (start-buffer all-buffers) 1322(defun bs--get-modified-string (start-buffer all-buffers)
1320 "Return a string which describes whether current buffer is modified. 1323 "Return a string which describes whether current buffer is modified.
@@ -1343,8 +1346,8 @@ ALL-BUFFERS is the list of buffer appearing in Buffer Selection Menu."
1343 (let ((name (copy-sequence (buffer-name)))) 1346 (let ((name (copy-sequence (buffer-name))))
1344 (put-text-property 0 (length name) 'mouse-face 'highlight name) 1347 (put-text-property 0 (length name) 'mouse-face 'highlight name)
1345 (if (< (length name) bs--name-entry-length) 1348 (if (< (length name) bs--name-entry-length)
1346 (concat name 1349 (concat name
1347 (make-string (- bs--name-entry-length (length name)) ? )) 1350 (make-string (- bs--name-entry-length (length name)) ? ))
1348 name))) 1351 name)))
1349 1352
1350 1353
@@ -1362,9 +1365,9 @@ default directory.
1362START-BUFFER is the buffer where we started buffer selection. 1365START-BUFFER is the buffer where we started buffer selection.
1363ALL-BUFFERS is the list of buffer appearing in Buffer Selection Menu." 1366ALL-BUFFERS is the list of buffer appearing in Buffer Selection Menu."
1364 (let ((string (copy-sequence (if (member major-mode 1367 (let ((string (copy-sequence (if (member major-mode
1365 '(shell-mode dired-mode)) 1368 '(shell-mode dired-mode))
1366 default-directory 1369 default-directory
1367 (or buffer-file-name ""))))) 1370 (or buffer-file-name "")))))
1368 (put-text-property 0 (length string) 'mouse-face 'highlight string) 1371 (put-text-property 0 (length string) 'mouse-face 'highlight string)
1369 string)) 1372 string))
1370 1373
@@ -1375,25 +1378,25 @@ It goes over all columns described in `bs-attributes-list'
1375and evaluates corresponding string. Inserts string in current buffer; 1378and evaluates corresponding string. Inserts string in current buffer;
1376normally *buffer-selection*." 1379normally *buffer-selection*."
1377 (let ((string "") 1380 (let ((string "")
1378 (columns bs-attributes-list) 1381 (columns bs-attributes-list)
1379 (to-much 0) 1382 (to-much 0)
1380 (apply-args (append (list bs--buffer-coming-from bs-current-list)))) 1383 (apply-args (append (list bs--buffer-coming-from bs-current-list))))
1381 (save-excursion 1384 (save-excursion
1382 (while columns 1385 (while columns
1383 (set-buffer buffer) 1386 (set-buffer buffer)
1384 (let ((min (bs--get-value (nth 1 (car columns)))) 1387 (let ((min (bs--get-value (nth 1 (car columns))))
1385 ;;(max (bs--get-value (nth 2 (car columns)))) refered no more 1388 ;;(max (bs--get-value (nth 2 (car columns)))) refered no more
1386 (align (nth 3 (car columns))) 1389 (align (nth 3 (car columns)))
1387 (fun (nth 4 (car columns))) 1390 (fun (nth 4 (car columns)))
1388 (val nil) 1391 (val nil)
1389 new-string) 1392 new-string)
1390 (setq val (bs--get-value fun apply-args)) 1393 (setq val (bs--get-value fun apply-args))
1391 (setq new-string (bs--format-aux val align (- min to-much))) 1394 (setq new-string (bs--format-aux val align (- min to-much)))
1392 (setq string (concat string new-string)) 1395 (setq string (concat string new-string))
1393 (if (> (length new-string) min) 1396 (if (> (length new-string) min)
1394 (setq to-much (- (length new-string) min))) 1397 (setq to-much (- (length new-string) min)))
1395 ) ; let 1398 ) ; let
1396 (setq columns (cdr columns)))) 1399 (setq columns (cdr columns))))
1397 (insert string) 1400 (insert string)
1398 string)) 1401 string))
1399 1402
@@ -1402,16 +1405,16 @@ normally *buffer-selection*."
1402ALIGN is one of the symbols `left', `middle', or `right'." 1405ALIGN is one of the symbols `left', `middle', or `right'."
1403 (let ((length (length string))) 1406 (let ((length (length string)))
1404 (if (>= length len) 1407 (if (>= length len)
1405 string 1408 string
1406 (if (eq 'right align) 1409 (if (eq 'right align)
1407 (concat (make-string (- len length) ? ) string) 1410 (concat (make-string (- len length) ? ) string)
1408 (concat string (make-string (- len length) ? )))))) 1411 (concat string (make-string (- len length) ? ))))))
1409 1412
1410(defun bs--show-header () 1413(defun bs--show-header ()
1411 "Insert header for Buffer Selection Menu in current buffer." 1414 "Insert header for Buffer Selection Menu in current buffer."
1412 (mapcar '(lambda (string) 1415 (mapcar '(lambda (string)
1413 (insert string "\n")) 1416 (insert string "\n"))
1414 (bs--create-header))) 1417 (bs--create-header)))
1415 1418
1416(defun bs--get-name-length () 1419(defun bs--get-name-length ()
1417 "Return value of `bs--name-entry-length'." 1420 "Return value of `bs--name-entry-length'."
@@ -1420,18 +1423,18 @@ ALIGN is one of the symbols `left', `middle', or `right'."
1420(defun bs--create-header () 1423(defun bs--create-header ()
1421 "Return all header lines used in Buffer Selection Menu as a list of strings." 1424 "Return all header lines used in Buffer Selection Menu as a list of strings."
1422 (list (mapconcat (lambda (column) 1425 (list (mapconcat (lambda (column)
1423 (bs--format-aux (bs--get-value (car column)) 1426 (bs--format-aux (bs--get-value (car column))
1424 (nth 3 column) ; align 1427 (nth 3 column) ; align
1425 (bs--get-value (nth 1 column)))) 1428 (bs--get-value (nth 1 column))))
1426 bs-attributes-list 1429 bs-attributes-list
1427 "") 1430 "")
1428 (mapconcat (lambda (column) 1431 (mapconcat (lambda (column)
1429 (let ((length (length (bs--get-value (car column))))) 1432 (let ((length (length (bs--get-value (car column)))))
1430 (bs--format-aux (make-string length ?-) 1433 (bs--format-aux (make-string length ?-)
1431 (nth 3 column) ; align 1434 (nth 3 column) ; align
1432 (bs--get-value (nth 1 column))))) 1435 (bs--get-value (nth 1 column)))))
1433 bs-attributes-list 1436 bs-attributes-list
1434 ""))) 1437 "")))
1435 1438
1436(defun bs--show-with-configuration (name &optional arg) 1439(defun bs--show-with-configuration (name &optional arg)
1437 "Display buffer list of configuration with NAME name. 1440 "Display buffer list of configuration with NAME name.
@@ -1446,38 +1449,38 @@ The optional argument ARG is the prefix argument when calling a function
1446for buffer selection." 1449for buffer selection."
1447 (bs-set-configuration name) 1450 (bs-set-configuration name)
1448 (let ((bs--show-all (or bs--show-all arg))) 1451 (let ((bs--show-all (or bs--show-all arg)))
1449 (unless (string= "*buffer-selection*" (buffer-name)) 1452 (unless (string= "*buffer-selection*" (buffer-name))
1450 ;; Only when not in buffer *buffer-selection* 1453 ;; Only when not in buffer *buffer-selection*
1451 ;; we have to set the buffer we started the command 1454 ;; we have to set the buffer we started the command
1452 (progn 1455 (progn
1453 (setq bs--buffer-coming-from (current-buffer)) 1456 (setq bs--buffer-coming-from (current-buffer))
1454 (setq bs--window-config-coming-from (current-window-configuration)))) 1457 (setq bs--window-config-coming-from (current-window-configuration))))
1455 (let ((liste (bs-buffer-list)) 1458 (let ((liste (bs-buffer-list))
1456 (active-window (bs--window-for-buffer "*buffer-selection*"))) 1459 (active-window (bs--window-for-buffer "*buffer-selection*")))
1457 (if active-window 1460 (if active-window
1458 (select-window active-window) 1461 (select-window active-window)
1459 (if (> (window-height (selected-window)) 7) 1462 (if (> (window-height (selected-window)) 7)
1460 (progn 1463 (progn
1461 (split-window-vertically) 1464 (split-window-vertically)
1462 (other-window 1)))) 1465 (other-window 1))))
1463 (bs-show-in-buffer liste) 1466 (bs-show-in-buffer liste)
1464 (bs-message-without-log "%s" (bs--current-config-message))))) 1467 (bs-message-without-log "%s" (bs--current-config-message)))))
1465 1468
1466(defun bs--configuration-name-for-prefix-arg (prefix-arg) 1469(defun bs--configuration-name-for-prefix-arg (prefix-arg)
1467 "Convert prefix argument PREFIX-ARG to a name of a buffer configuration. 1470 "Convert prefix argument PREFIX-ARG to a name of a buffer configuration.
1468If PREFIX-ARG is nil return `bs-default-configuration'. 1471If PREFIX-ARG is nil return `bs-default-configuration'.
1469If PREFIX-ARG is an integer return PREFIX-ARG element of `bs-configurations'. 1472If PREFIX-ARG is an integer return PREFIX-ARG element of `bs-configurations'.
1470Otherwise return `bs-alternative-configuration'." 1473Otherwise return `bs-alternative-configuration'."
1471 (cond ;; usually activation 1474 (cond;; usually activation
1472 ((null prefix-arg) 1475 ((null prefix-arg)
1473 bs-default-configuration) 1476 bs-default-configuration)
1474 ;; call with integer as prefix argument 1477 ;; call with integer as prefix argument
1475 ((integerp prefix-arg) 1478 ((integerp prefix-arg)
1476 (if (and (< 0 prefix-arg) (<= prefix-arg (length bs-configurations))) 1479 (if (and (< 0 prefix-arg) (<= prefix-arg (length bs-configurations)))
1477 (car (nth (1- prefix-arg) bs-configurations)) 1480 (car (nth (1- prefix-arg) bs-configurations))
1478 bs-default-configuration)) 1481 bs-default-configuration))
1479 ;; call by prefix argument C-u 1482 ;; call by prefix argument C-u
1480 (t bs-alternative-configuration))) 1483 (t bs-alternative-configuration)))
1481 1484
1482;; ---------------------------------------------------------------------- 1485;; ----------------------------------------------------------------------
1483;; Main function bs-customize and bs-show 1486;; Main function bs-customize and bs-show
@@ -1491,7 +1494,7 @@ Otherwise return `bs-alternative-configuration'."
1491 1494
1492;;;###autoload 1495;;;###autoload
1493(defun bs-show (arg) 1496(defun bs-show (arg)
1494 "Make a menu of buffers so you can manipulate buffer list or buffers itself. 1497 "Make a menu of buffers so you can manipulate buffers or the buffer list.
1495\\<bs-mode-map> 1498\\<bs-mode-map>
1496There are many key commands similar to `Buffer-menu-mode' for 1499There are many key commands similar to `Buffer-menu-mode' for
1497manipulating buffer list and buffers itself. 1500manipulating buffer list and buffers itself.