home *** CD-ROM | disk | FTP | other *** search
/ NetNews Usenet Archive 1993 #3 / NN_1993_3.iso / spool / gnu / emacs / sources / 958 < prev    next >
Encoding:
Text File  |  1993-01-23  |  34.1 KB  |  952 lines
  1. Path: sparky!uunet!elroy.jpl.nasa.gov!ames!agate!agate.berkeley.edu!dodd
  2. From: dodd@mycenae.cchem.berkeley.edu (Lawrence R. Dodd)
  3. Newsgroups: gnu.emacs.sources
  4. Subject: new release of GTbuf-menu.el, v 1.25
  5. Date: 22 Jan 93 13:33:17
  6. Organization: Dept of Chemical Engineering, Polytechnic Univ, NY, USA
  7. Lines: 939
  8. Distribution: gnu
  9. Message-ID: <DODD.93Jan22133317@mycenae.cchem.berkeley.edu>
  10. NNTP-Posting-Host: mycenae.cchem.berkeley.edu
  11. Keywords: buffer-menu, GTbuf-menu.el, update
  12.  
  13.  
  14.   here is the newest release of GTbuf-menu.el a more dired-like buffer menu.
  15.   I am posting this for the authors Bill Benedetto and Tom Wurgler since the
  16.   copy in the elisp-archive is out of date.
  17.  
  18.   it has some new features in it like using `N' and `P' to display buffers in
  19.   the other window as you scroll through the list in the buffer-menu.  
  20.  
  21.   [Edward J.  Hartnett <ejh@khonshu.Colorado.EDU> had asked about "Subject:
  22.    anyone got a way to cycle through buffers with a keystroke?" back in
  23.    November.  There was a lot of discussion about it back then.  The above
  24.    feature of GTBuf-menu.el addresses this his question.]
  25.  
  26.   for whatever it is worth, I have been using this for a couple of months now
  27.   and I really love it.
  28.  
  29.   Also available via anonymous ftp to roebling.poly.edu in /pub/GTbuf-men.el.
  30.  
  31.   share and enjoy
  32.   Larry
  33.  
  34. ........................... cut along dotted line ...........................
  35. ;;;; GTbuf-men.el - more dired-like buffer menu
  36.  
  37. (defconst GTbuf-men-version (substring "$Revision: 1.25 $" 11 -2)
  38.   "$Id: GTbuf-men.el,v 1.25 1992/12/13 22:30:45 wurgler Exp wurgler $")
  39.  
  40. ;; Copyright (C) 1991 by Bill Benedetto and Tom Wurgler
  41.  
  42. ;; This program is free software; you can redistribute it and/or modify
  43. ;; it under the terms of the GNU General Public License as published by
  44. ;; the Free Software Foundation; either version 1, or (at your option)
  45. ;; any later version.
  46. ;;
  47. ;; This program is distributed in the hope that it will be useful,
  48. ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
  49. ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  50. ;; GNU General Public License for more details.
  51. ;;
  52. ;; You should have received a copy of the GNU General Public License
  53. ;; along with this program; if not, write to the Free Software
  54. ;; Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
  55.  
  56. ;; LISPDIR ENTRY for the Elisp Archive ===============================
  57. ;;    LCD Archive Entry:
  58. ;;    GTbuf-men| Tom Wurgler and Bill Benedetto
  59. ;;    |wurgler@gentire.com and benedett@gentire.com
  60. ;;    |more dired-like buffer menu 
  61. ;;    |$Date: 1992/12/13 22:30:45 $|$Revision: 1.25 $|
  62.  
  63. ;; INSTALLATION ======================================================
  64. ;; 
  65. ;; Put this file into your load-path and the following in your ~/.emacs:
  66. ;; 
  67. ;;   (autoload 'buffer-menu-dired-extended "GTbuf-men")
  68. ;;   (define-key ctl-x-map "\C-b" 'buffer-menu-dired-extended)
  69.  
  70. ;; OVERVIEW ==========================================================
  71. ;
  72. ; extended buff-menu functions
  73. ;
  74. ;      Global keybinding:
  75. ;          \C-c\C-j - switch to buffer list
  76. ;
  77. ;      Buffer-menu mode keybindings
  78. ;          %d - mark buffers for deletion containing regexp
  79. ;          %m - mark buffers for viewing containing regexp
  80. ;          m - mark the next ARG buffers
  81. ;          M-del - unflag all buffers
  82. ;          M-< - goto the first buffer
  83. ;          M-> - goto the last buffer
  84. ;          M-{ - goto the next marked buffer
  85. ;          M-} - goto the previous marked buffer
  86. ;          F - display marked buffers
  87. ;          L - display the buffer list based on files only, direds only, plain
  88. ;              buffers (those not associated with a file) or all buffers
  89. ;          R - list only buffers containing regexp
  90. ;       S - sort the buffer list
  91. ;       g - to revert a buffer list
  92. ;       q - quit buffer-menu
  93. ;       r - rename the buffer
  94. ;       w - copy the marked or current buffer name(s) to the kill ring
  95. ;     C-n, n - go to the next buffer line and postion on the name
  96. ;     C-p, p - go to the previous buffer line and postion on the name
  97. ;          N - display next buffer in another window
  98. ;          P - display previous buffer in another window
  99. ;          J - display this buffer in another window
  100. ;          T - switches marked and unmarked buffers
  101. ;          X - deletes marked buffers
  102. ;
  103. ; This package is based on and requires Sebastian Kremer's dired and gmhist 
  104. ; code, which can be otained via anonymous ftp from:
  105. ;
  106. ;       ftp.thp.Uni-Koeln.DE[134.95.64.1]:/pub/gnu/emacs/diredall.tar.Z
  107. ;       ftp.thp.Uni-Koeln.DE[134.95.64.1]:/pub/gnu/emacs/gmhist.tar.Z
  108. ;
  109. ; Many thanks to Sebastian for all the clean code for dired and the start
  110. ; of this package, and his helpful comments and debugging of this code.
  111. ;
  112. ; Also, thanks to Larry Dodd for acting as a beta tester and for his many
  113. ; suggestions for improving the code.
  114. ;
  115. ; Bill Benedetto and Tom Wurgler,  wurgler@gentire.com
  116. ;
  117.  
  118. (require 'dired)
  119. (require 'gmhist)
  120.  
  121. (defvar buffer-menu-restricted nil
  122.   "Whether buffer-menu is restricted by regexp, sort, files or direds.")
  123.  
  124. (defvar buffer-menu-full-screen nil
  125.   "*If t, use the full screen when displaying marked buffers using 'F'.")
  126.  
  127. (defvar buffer-menu-confirm-deletes t
  128.   "*In buffer menu, if non-nil will ask you to confirm deletions.
  129. If nil, you will not be asked if you want to make deletes --
  130. they will just be done.")
  131.  
  132. (defvar buffer-marker-char ?>
  133.   "In buffer menu, character used to mark buffers for later commands.")
  134.  
  135. (defvar buffer-delete-marker ?D
  136.   "In buffer menu, character used to mark buffers for later deletions.")
  137.  
  138. (defvar buffer-options ""
  139.   "*Contains the last string of buffer-menu-options such as sort, regexp etc.")
  140.  
  141. (defvar buffer-menu-regexp nil
  142.   "*Contains the last regexp used in buffer-menu.")
  143.  
  144. (defvar buffer-menu-list nil
  145.   "*In buffer menu, contains a list of the marked buffers.")
  146.  
  147. (defvar buffer-menu-ignore-modified-regexp "^\\*"
  148.   "Buffers matching this regexp are marked as unmodified in the
  149. buffer menu.")
  150.  
  151. (defvar buffer-menu-strange-buf-regexp "\
  152. ^... \\*Buffer List\\*\\|\
  153. ^... \\*Messages\\*"
  154.  
  155. "These buffers must have their modified mark cleared after the listing
  156. has been made.")
  157.  
  158. (defvar buffer-menu-ignore-modified-modes '(ange-ftp-shell-mode)
  159.   "Buffers in this mode will show up unmodified in the buffer menu.")
  160.  
  161. (defvar buffer-menu-mode-options nil
  162.   "Whether buffer-menu lists by regexp or files only or etc.")
  163.  
  164. (defconst buffer-menu-modified-mark-column 1)
  165.  
  166. (defun buffer-menu-dired-extended (&optional buff-opt fromp)
  167.   "Make a menu of buffers so you can save, delete or select them.
  168. With \\[universal-argument] you will be allowed to choose whether you want just
  169. files, just direds or plain buffers and whether or not you want the list 
  170. sorted.  Type ? after invocation to get help on commands available.
  171. Type \\[Buffer-menu-quit] immediately to make the buffer menu go away."
  172.   (interactive)
  173.   (if (or current-prefix-arg (and buffer-menu-restricted fromp))
  174.       (let ((buffer-menu-opts "")
  175.         (buffer-menu-sort-it nil))
  176.     (if (not buff-opt)
  177.         (setq buffer-menu-opts
  178.           (read-string "Choose direds or files or plain buffers, regexp, sort (d/f/n,r,s): "))
  179.       (setq buffer-menu-opts buff-opt))
  180.     (setq buffer-options buffer-menu-opts)
  181.     (if (not (string-equal buffer-menu-opts ""))
  182.         (progn
  183.           (setq buffer-menu-restricted t)
  184.           (if (string-match "s" buffer-menu-opts)
  185.           (setq buffer-menu-sort-it t))
  186.           (if (string-match "r" buffer-menu-opts)
  187.           (if (not buff-opt)
  188.               (setq buffer-menu-regexp (read-with-history-in
  189.                         'buffer-menu-regexp-history
  190.                         "Regexp: ")))
  191.         (setq buffer-menu-regexp nil))
  192.           (if (string-match "f" buffer-menu-opts)
  193.           (buffer-menu t)
  194.         (buffer-menu nil))
  195.           (if (string-match "n" buffer-menu-opts)
  196.           (let ((buffer-read-only nil))
  197.             (delete-matching-lines "[0-9]+[ \t]+Dired[ \t]*")
  198.             (Buffer-menu-goto-first-buffer)
  199.             (while (not (eobp))
  200.               (if (buffer-file-name (Buffer-menu-buffer nil))
  201.               (delete-region (progn (beginning-of-line) (point))
  202.                      (progn (forward-line 1) (point)))
  203.             (forward-line 1)))
  204.             (Buffer-menu-goto-first-buffer)
  205.             (delete-region (point-min) (point))
  206.             (insert "\
  207.  MR Buffer         Size  Mode\n\
  208.  -- ------         ----  ----\n")
  209.             (Buffer-menu-goto-first-buffer)))
  210.           (if (string-match "d" buffer-menu-opts)
  211.           (let ((buffer-read-only nil) buf dir)
  212.             ;; Epoch 3.2 appends the filename for dired buffers
  213.             (keep-lines "[0-9]+[ \t]+Dired[ \t]*")    ; ugh
  214.             (Buffer-menu-goto-first-buffer)
  215.             (delete-region 1 (point))
  216.             (insert "\
  217.  MR Buffer         Size  Mode           Directory\n\
  218.  -- ------         ----  ----           ---------\n")
  219.             (or (string-match "^3\\.2" emacs-version)
  220.             ;; Epoch 3.2 appends the filename for dired buffers
  221.             (save-excursion
  222.               (while (not (eobp))
  223.                 (if (setq buf (Buffer-menu-buffer nil))
  224.                 (progn
  225.                   (save-excursion
  226.                     (set-buffer buf)
  227.                     (setq dir (or (and (boundp
  228.                             'dired-directory)
  229.                                dired-directory)
  230.                           ;; 18.55 Dired does not
  231.                           ;; have this variable
  232.                           default-directory)))
  233.                   (end-of-line)
  234.                   (insert dir)))
  235.                 (forward-line))))))
  236.           (if buffer-menu-sort-it 
  237.           (let ((buffer-read-only nil))
  238.             (require 'sort)
  239.             (Buffer-menu-goto-first-buffer)
  240.             (sort-subr nil 'forward-line 'end-of-line
  241.                    'Buffer-menu-buffer-no-arg)
  242.             (Buffer-menu-goto-first-buffer)))
  243.           (if buffer-menu-regexp
  244.           (let ((buffer-read-only nil))
  245.             (Buffer-menu-goto-first-buffer)
  246.             (buffer-mark-files-regexp buffer-menu-regexp "_")
  247.             (keep-lines "^_.. ")
  248.             (buffer-unflag-all-files "_")
  249.             (message "")
  250.             (Buffer-menu-goto-first-buffer))))
  251.       (buffer-menu nil)
  252.       (setq buffer-menu-restricted nil)))
  253.     (setq buffer-options "")
  254.     (setq buffer-menu-restricted nil)
  255.     (buffer-menu nil))
  256.   (buffer-menu-list-options)
  257.   (make-local-variable 'buffer-menu-restricted)
  258.   (make-local-variable 'buffer-menu-mode-options)
  259.   (setq buffer-menu-restricted nil)
  260.   (run-hooks 'buffer-menu-hook)
  261.   (buffer-menu-move-to-name)
  262.   (message "q to quit, ? for help."))
  263.  
  264.  
  265.  
  266. (defun Buffer-menu-buffer (error-if-non-existent-p)
  267.   "Return buffer described by this line of buffer menu."
  268.   (if (<= (buffer-menu-cur-line) 2)
  269.       (error "Must point at a buffer."))
  270.   (save-excursion
  271.     (beginning-of-line)
  272.     (if (eobp) (forward-line -1))
  273.     (forward-char Buffer-menu-buffer-column)
  274.     (let ((start (point))
  275.       string)
  276.       ;; End of buffer name marked by tab or two spaces.
  277.       (re-search-forward "\t\\|  ")
  278.       (skip-chars-backward " \t")
  279.       (setq string (buffer-substring start (point)))
  280.       (or (get-buffer string)
  281.       (if error-if-non-existent-p
  282.           (error "No buffer named \"%s\"" string)
  283.         nil)))))
  284.  
  285. (defun Buffer-menu-buffer-no-arg ()
  286.   "Return buffer described by this line of buffer menu.
  287. A version of the original except this one doesn't require an arg."
  288.   (if (<= (buffer-menu-cur-line) 2)
  289.       (error "Must point at a buffer."))
  290.   (save-excursion
  291.     (beginning-of-line)
  292.     (if (eobp) (forward-line -1))
  293.     (forward-char Buffer-menu-buffer-column)
  294.     (let ((start (point))
  295.       string)
  296.       ;; End of buffer name marked by tab or two spaces.
  297.       (re-search-forward "\t\\|  ")
  298.       (skip-chars-backward " \t")
  299.       (buffer-substring start (point)))))
  300.  
  301.  
  302. ;; Make the `modified' marker in buffer menu more meaningful by
  303. ;; putting buffer-menu-set-some-buffers-unmodified on buffer-menu-hook.
  304.  
  305. (defun dired-pending-marks-p ()
  306.   (save-excursion
  307.     (goto-char (point-min))
  308.     (re-search-forward dired-re-mark nil t)))
  309.       
  310. (defun dired-set-buffer-modified-p ()
  311.   "Mark all Dired buffers as modified iff there are pending marks."
  312.   (interactive)
  313.   (let ((blist (buffer-list)))
  314.     (while blist
  315.       (save-excursion
  316.     (set-buffer (car blist))
  317.     (setq blist (cdr blist))
  318.     (if (eq major-mode 'dired-mode)
  319.         (set-buffer-modified-p (dired-pending-marks-p)))))))
  320.  
  321. (defun set-some-buffers-unmodified (name-regexp major-modes)
  322.   "Clears the modification flag of buffers whose names match NAME-REGEXP
  323. or whose major mode is a member of MAJOR-MODES.  Either or both of the
  324. arguments may be nil.
  325. Also sets dired buffer modification flags according to dired-pending-marks-p."
  326.   (let ((blist (buffer-list)))
  327.     (while blist
  328.       (save-excursion
  329.     (set-buffer (car blist))
  330.     (setq blist (cdr blist))
  331.     (cond ((eq major-mode 'dired-mode)
  332.            (set-buffer-modified-p (dired-pending-marks-p)))
  333.           ((buffer-modified-p)
  334.            ;; Don't do the work unless the buffer is marked modified.
  335.            (if (or (memq major-mode major-modes)
  336.                (and name-regexp
  337.                 (string-match name-regexp (buffer-name))))
  338.            (set-buffer-modified-p nil))))))))
  339.  
  340. (defun buffer-menu-set-some-buffers-unmodified ()
  341.   "Useful on `buffer-menu-hook' to make the modified marker in the
  342. buffer menu more meaningful."
  343.   (set-some-buffers-unmodified buffer-menu-ignore-modified-regexp
  344.                    buffer-menu-ignore-modified-modes)
  345.   (save-excursion
  346.     (buffer-menu-home-to-tilde)
  347.     (let ((buffer-read-only nil))
  348.       (goto-char (point-min))
  349.       ;; These buffers are modified during the listing, so
  350.       ;; set-buffer-modified-p is too late.
  351.       (while (re-search-forward buffer-menu-strange-buf-regexp nil t)
  352.     (move-to-column buffer-menu-modified-mark-column)
  353.     (delete-char 1)
  354.     (insert " ")))))
  355.  
  356. ;; Move to next and previous marked buffer line.
  357.  
  358. (defun buffer-menu-next-marked-buffer (arg &optional wrap opoint string)
  359.   "Move to the next marked buffer, wrapping around the end of the buffer list."
  360.   (interactive "p\np")
  361.   (or opoint (setq opoint (point)));; return to where interactively started
  362.   (or string (setq string (concat "\n" (char-to-string buffer-marker-char))))
  363.   (if (if (> arg 0)
  364.       (search-forward string nil t arg)
  365.     (beginning-of-line)
  366.     (if (search-backward string nil t (- arg))
  367.         (search-forward string)))
  368.       (buffer-menu-move-to-name);; or the re-search will get stuck
  369.     (if (null wrap)
  370.     (progn
  371.       (goto-char opoint)
  372.       (error "No next marked buffer!"))
  373.       (message "(Wraparound for next marked buffer)")
  374.       (goto-char (if (> arg 0) (point-min) (point-max)))
  375.       (buffer-menu-next-marked-buffer arg nil opoint))))
  376.  
  377. (defun buffer-menu-prev-marked-buffer (arg &optional wrap)
  378.   "Move to the previous marked buffer, wrapping around the end of the
  379. buffer list."
  380.   (interactive "p\np")
  381.   (buffer-menu-next-marked-buffer (- arg) wrap))
  382.  
  383. (defconst buffer-menu-name-column 4)
  384.  
  385. (defun buffer-menu-move-to-name ()
  386.   (move-to-column buffer-menu-name-column))
  387.  
  388. (defun buffer-mark-files-regexp (regexp &optional marker-char)
  389.   "Mark all buffers matching REGEXP for use in later commands.
  390. A prefix argument means to unmark them instead."
  391.   (interactive
  392.    (list (dired-read-regexp (concat (if current-prefix-arg "Unmark" "Mark")
  393.                     " buffers (regexp): "))
  394.      (if current-prefix-arg ?\040)))
  395.   (let ((dired-marker-char (or marker-char buffer-marker-char)))
  396.     (save-excursion
  397.       (Buffer-menu-goto-first-buffer)
  398.       (save-restriction
  399.     (narrow-to-region (point) (point-max))
  400.     (dired-mark-if
  401.      (and (not (eolp))        ; empty line
  402.           (let ((fn (buffer-name (Buffer-menu-buffer t))))
  403.         (and fn (string-match regexp fn))))
  404.      "matching buffer")))))
  405.  
  406. (defun buffer-flag-regexp-files (regexp)
  407.   "In buffer-menu, flag all buffers containing the specified REGEXP for deletion.
  408. Use `^' and `$' to anchor matches."
  409.   (interactive (list (dired-read-regexp "Flag for deletion (regexp): ")))
  410.   (buffer-mark-files-regexp regexp buffer-delete-marker))
  411.  
  412. (defun buffer-unflag-all-files (flag &optional arg)
  413.   "Remove a specific or all flags from every buffer line.
  414. With an arg, queries for each marked buffer.
  415. Type \\[help-command] at that time for help."
  416.   (interactive "sRemove flag: (default: all flags) \nP")
  417.   (let ((count 0)
  418.     (re (if (zerop (length flag)) dired-re-mark
  419.           (concat "^" (regexp-quote flag)))))
  420.     (save-excursion
  421.       (let (buffer-read-only case-fold-search query
  422.                  (help-form "\
  423. Type SPC or `y' to unflag one buffer, DEL or `n' to skip to next,
  424. `!' to unflag all remaining buffers with no more questions."))
  425.     (goto-char (point-min))
  426.     (while (re-search-forward re nil t)
  427.       (if (or (not arg)
  428.           (dired-query 'query "Unflag buffer `%s' ? "
  429.                    (Buffer-menu-buffer t)))
  430.           (progn (delete-char -1) (insert " ") (setq count (1+ count))))
  431.       (forward-line 1))))
  432.     (message "%s" (format "Flags removed: %d %s" count flag) )))
  433.  
  434. ;; redefines buff-menu.el's version to make a pop-up for deletions
  435. ;; like Dired does
  436.  
  437. (defun Buffer-menu-execute (&optional marked-buffers-instead)
  438.   "Save and/or delete buffers marked with \\[Buffer-menu-save] or \\[Buffer-menu-delete] commands."
  439.   (interactive)
  440.   (if (not marked-buffers-instead)
  441.       (save-excursion
  442.     (goto-char (point-min))
  443.     (while (re-search-forward "^.S" nil t)
  444.       (let ((modp nil))
  445.         (save-excursion
  446.           (set-buffer (Buffer-menu-buffer t))
  447.           (save-buffer)
  448.           (setq modp (buffer-modified-p)))
  449.         (let ((buffer-read-only nil))
  450.           (delete-char -1)
  451.           (insert (if modp ?* ? )))))))
  452.   (save-excursion
  453.     (goto-char (point-min))
  454.     (let ((buffer-menu-buffer (current-buffer))
  455.       (dired-marker-char buffer-delete-marker)
  456.       (buffer-menu-do-deletes nil)
  457.       (buffer-read-only nil))
  458.       (buffer-menu-list (if marked-buffers-instead
  459.                 (char-to-string buffer-marker-char)
  460.               (char-to-string buffer-delete-marker)))
  461.       (if buffer-menu-confirm-deletes
  462.       (if (dired-mark-pop-up
  463.            " *Deletions*" 'deletions buffer-menu-list
  464.            dired-deletion-confirmer
  465.            (format "Delete %s " (buffer-mark-prompt nil buffer-menu-list)))
  466.           (setq buffer-menu-do-deletes t)
  467.         (setq buffer-menu-do-deletes nil))
  468.     (setq buffer-menu-do-deletes t))
  469.       (if buffer-menu-do-deletes
  470.       (while (search-forward
  471.           (if marked-buffers-instead
  472.               (concat "\n" (char-to-string buffer-marker-char))
  473.             (concat "\n" (char-to-string buffer-delete-marker))) nil t)
  474.         (forward-char -1)
  475.         (let ((buf (Buffer-menu-buffer nil)))
  476.           (or (eq buf nil)
  477.           (eq buf buffer-menu-buffer)
  478.           (save-excursion (kill-buffer buf))))
  479.         (if (Buffer-menu-buffer nil)
  480.         (progn (delete-char 1)
  481.                (insert ? ))
  482.           (delete-region (point) (progn (forward-line 1) (point)))
  483.           (forward-char -1)))))))
  484.  
  485. (defun buffer-mark-prompt (arg files)
  486.   ;; Return a string for use in a prompt, either the current file
  487.   ;; name, or the marker and a count of marked files.
  488.   (let ((count (length files)))
  489.     (if (= count 1)
  490.     (car files)
  491.       ;; more than 1 file:
  492.       (if (integerp arg)
  493.       ;; abs(arg) = count
  494.       ;; Perhaps this is nicer, but it also takes more screen space:
  495.       ;;(format "[%s %d files]" (if (> arg 0) "next" "previous")
  496.       ;;                        count)
  497.       (format "[next %d buffers]" arg)
  498.     (format "%c [%d buffers]" dired-marker-char count)))))
  499.  
  500. (defun Buffer-menu-select (&optional arg)
  501.   "Visit all marked buffers at once, and display them simultaneously.
  502. Visit just the buffer the cursor is on if no buffers are marked.
  503. With an arg, visit arg next buffers."
  504.   (interactive "P")
  505.   (simultaneous-find-buffer (buffer-menu-list nil arg)))
  506.  
  507. (defun simultaneous-find-buffer (file-list)
  508.   "Visit all buffers in BUFFER-LIST and display them simultaneously.
  509.  
  510. The current window is split across all buffers in BUFFER-LIST, as evenly
  511. as possible.  Remaining lines go to the bottommost window.
  512. If variable buffer-menu-full-screen is t, then use the whole screen.
  513. The number of buffers that can be displayed this way is restricted by
  514. the height of the current window and the variable `window-min-height'."
  515.   (let ((size (/ (if buffer-menu-full-screen (1- (screen-height))
  516.            (window-height)) (length file-list))))
  517.     (or (<= window-min-height size)
  518.     (error "Too many buffers to visit simultaneously"))
  519.     (if buffer-menu-full-screen (delete-other-windows))
  520.     (switch-to-buffer (car file-list))
  521.     (setq file-list (cdr file-list))
  522.     (while file-list
  523.       ;; Split off vertically a window of the desired size
  524.       ;; The upper window will have SIZE lines.  We select the lower
  525.       ;; (larger) window because we want to split that again.
  526.       (select-window (split-window nil size))
  527.       (switch-to-buffer (car file-list))
  528.       (setq file-list (cdr file-list)))))
  529.  
  530. (defun Buffer-menu-quit ()
  531.   "Bury the current buffer-menu."
  532.   (interactive)
  533.   (bury-buffer)
  534.   (if (not (one-window-p))
  535.       (delete-window)))
  536.  
  537. (defun Buffer-menu-goto-first-buffer ()
  538.   (goto-line 3))
  539.  
  540.  
  541. (defun buffer-copy-buffername-as-kill (&optional arg)
  542.   "Copy names of marked buffers into the kill ring.
  543. The names are separated by a space.
  544. With a prefix arg, use just current buffer.
  545. You can then feed the file name to other commands with \\[yank]."
  546.   (interactive "P")
  547.   (copy-string-as-kill
  548.    (if arg
  549.        (buffer-name (Buffer-menu-buffer t))
  550.      (mapconcat (function identity) (buffer-menu-list) " ")))
  551.   (message "%s" (car kill-ring)))
  552.  
  553. (defun buffer-menu-list (&optional marker-char arg)
  554.   (let ((marker (or marker-char (char-to-string buffer-marker-char)))
  555.     (there-are-some))
  556.     (if arg
  557.     (progn
  558.       (setq buffer-menu-list nil)
  559.       (while (> arg 0)
  560.         (setq buffer-menu-list (cons (buffer-name (Buffer-menu-buffer t))
  561.                      buffer-menu-list))
  562.         (next-line 1)
  563.         (setq arg (1- arg)))
  564.       (setq buffer-menu-list (nreverse buffer-menu-list)))
  565.       (save-excursion
  566.     (goto-char (point-min))
  567.     (if (search-forward (concat "\n" marker) nil t)
  568.         (setq there-are-some t)
  569.       (error "No buffers marked.")))
  570.       (if there-are-some
  571.       (save-excursion
  572.         (setq buffer-menu-list nil)
  573.         (goto-char (point-min))
  574.         (while (search-forward (concat "\n" marker) nil t)
  575.           (setq buffer-menu-list
  576.             (cons (buffer-name (Buffer-menu-buffer t))
  577.               buffer-menu-list)))
  578.         (setq buffer-menu-list (nreverse buffer-menu-list)))
  579.     (setq buffer-menu-list (cons (buffer-name (Buffer-menu-buffer t))
  580.                    nil))))))
  581.  
  582. (defun Buffer-menu-revert ()
  583.   (interactive)
  584.   (let ((opoint (point))
  585.     (buf (Buffer-menu-buffer-no-arg))
  586.     (mark-alist nil)
  587.     case-fold-search
  588.     buffer-read-only)
  589.     (goto-char (point-min))
  590.     (setq mark-alist (buffer-remember-marks (point-min) (point-max)))
  591.     (setq buffer-menu-restricted t)
  592.     (buffer-menu-dired-extended buffer-options t)
  593.     (buffer-mark-remembered mark-alist)
  594.     (run-hooks 'buffer-menu-hook)
  595.     (buffer-goto-buffer buf opoint)
  596.     (beginning-of-line)
  597.     (buffer-menu-move-to-name)))
  598.  
  599. (defun buffer-remember-marks (beg end)
  600.   "Return alist of buffers and their marks, from BEG to END."
  601.   (let (fil chr alist)
  602.     (save-excursion
  603.       (goto-char beg)
  604.       (while (re-search-forward dired-re-mark end t)
  605.     (if (setq fil (buffer-name (Buffer-menu-buffer nil)))
  606.         (setq chr (preceding-char)
  607.           alist (cons (cons fil chr) alist)))))
  608.     alist))
  609.  
  610. (defun buffer-mark-remembered (alist)
  611.   ;; Mark all files remembered in ALIST.
  612.   (let (elt fil chr)
  613.     (while alist
  614.       (setq elt (car alist)
  615.         alist (cdr alist)
  616.         fil (car elt)
  617.         chr (cdr elt))
  618.       (if (buffer-goto-buffer fil)
  619.       (save-excursion
  620.         (beginning-of-line)
  621.         (setq buffer-read-only nil)
  622.         (delete-char 1)
  623.         (insert chr)
  624.         (setq buffer-read-only t))))))
  625.  
  626. (defun buffer-goto-buffer (buf &optional pos)
  627.   (interactive)
  628.   (let ((beg (or pos (point))))
  629.     (goto-char (point-min))
  630.     (if (re-search-forward (concat "\n...." buf) nil t)
  631.     t
  632.       (goto-char beg)
  633.       nil)))
  634.  
  635. (defun buffer-menu-home-to-tilde ()
  636.   "Function to convert the \"home\" to \"~\"."
  637.   (let* ((home (regexp-quote (expand-file-name "~/")))
  638.      (hleng (length home))
  639.      (buffer-read-only nil))
  640.     ;; Unexpand home directory:
  641.     (save-excursion
  642.       (goto-char (point-min))
  643.       (while (re-search-forward home nil t)
  644.     (if (not (= (- (current-column) hleng) 4))
  645.         (replace-match "~/" t t))))))
  646.  
  647. (defun buffer-menu-toggle-sort ()
  648.   "Toggles between sorted and unsorted buffer-menu.  Maintains all other
  649. buffer-menu options."  
  650.   (interactive)
  651.   (let ((opoint (point))
  652.     (buf (Buffer-menu-buffer-no-arg))
  653.     (mark-alist (buffer-remember-marks (point-min) (point-max))))
  654.     (if (string-match "s" buffer-options)
  655.     (setq buffer-options (buffer-menu-translate buffer-options "s" ""))
  656.       (setq buffer-options (concat buffer-options "s")))
  657.     (setq buffer-menu-restricted t)
  658.     (buffer-menu-dired-extended buffer-options t)
  659.     (buffer-mark-remembered mark-alist)
  660.     (buffer-goto-buffer buf)
  661.     (beginning-of-line)))
  662.  
  663. (defun buffer-menu-list-regexp ()
  664.   "Lists only buffer conatining the specified regexp.  Maintains all other
  665. buffer-menu options."
  666.   (interactive)
  667.   (setq buffer-menu-regexp (read-string "Regexp: "))
  668.   (if (string-equal buffer-menu-regexp "")
  669.       (setq buffer-options (buffer-menu-translate buffer-options "r" ""))
  670.     (if (not (string-match "r" buffer-options))
  671.     (setq buffer-options (concat buffer-options "r")))
  672.     (setq buffer-menu-restricted t))
  673.   (buffer-menu-dired-extended buffer-options t))
  674.  
  675. (defun buffer-menu-toggle-direds-or-files ()
  676.   "Cycles listing buffers by direds, files, plain buffers and all buffers."
  677.   (interactive)
  678.   (if (string-match "d" buffer-options)
  679.       (progn
  680.     (setq buffer-options (buffer-menu-translate buffer-options "f" ""))
  681.     (setq buffer-options (buffer-menu-translate buffer-options "n" ""))
  682.     (setq buffer-options (buffer-menu-translate buffer-options "d" "f")))
  683.     (if (string-match "f" buffer-options)
  684.     (progn
  685.       (setq buffer-options (buffer-menu-translate buffer-options "d" ""))
  686.       (setq buffer-options (buffer-menu-translate buffer-options "n" ""))
  687.       (setq buffer-options (buffer-menu-translate buffer-options "f" "n")))
  688.       (if (string-match "n" buffer-options)
  689.       (progn
  690.         (setq buffer-options (buffer-menu-translate buffer-options "d" ""))
  691.         (setq buffer-options (buffer-menu-translate buffer-options "f" ""))
  692.         (setq buffer-options (buffer-menu-translate buffer-options "n" "")))
  693.     (setq buffer-options (concat buffer-options "d")))))
  694.   (setq buffer-menu-restricted t)
  695.   (buffer-menu-dired-extended buffer-options t))
  696.  
  697. (or (equal (assq 'buffer-menu-mode-options minor-mode-alist)
  698.        '(buffer-menu-mode-options buffer-menu-mode-options))
  699.     ;; Test whether this has already been done in case dired is reloaded
  700.     ;; There may be several elements with buffer-menu-mode-options as car.
  701.     (setq minor-mode-alist
  702.       (cons '(buffer-menu-mode-options buffer-menu-mode-options)
  703.         ;; buffer-menu-mode-options is nil outside dired
  704.         minor-mode-alist)))
  705.  
  706. (defun buffer-menu-list-options ()
  707.   (setq buffer-menu-mode-options
  708.     (concat "" 
  709.         (if (string-match "r" buffer-options)
  710.             " regexp")
  711.         (if (string-match "s" buffer-options)
  712.             " sorted")
  713.         (if (string-match "d" buffer-options)
  714.             " direds only")
  715.         (if (string-match "f" buffer-options)
  716.             " files only")
  717.         (if (string-match "n" buffer-options)
  718.             " plain buffers only")))
  719.   ;; update mode line:
  720.   (set-buffer-modified-p (buffer-modified-p)))
  721.  
  722. (defun buffer-menu-translate (string1 string2 string3)
  723.   "Change every occurence in STRING of FSTRING with RSTRING."
  724.   (let ((case-fold-search nil))
  725.     (while (string-match string2 string1)
  726.       (if (not (string-equal string3 ""))
  727.       (aset string1
  728.         (match-beginning 0) (string-to-char string3))
  729.     (setq string1 (concat
  730.                (substring string1 0 (match-beginning 0))
  731.                (substring string1 (match-end 0)))))))
  732.   string1)
  733.  
  734. (defun beginning-of-buffer-menu ()
  735.   "Go to first buffer."
  736.   (interactive)
  737.   (Buffer-menu-goto-first-buffer))
  738.  
  739. (defun end-of-buffer-menu ()
  740.   "Go to last buffer."
  741.   (interactive)
  742.   (goto-char (point-max))
  743.   (forward-line -1)
  744.   (buffer-menu-move-to-name))
  745.  
  746. (defun buffer-menu-rename ()
  747.   "Rename the current buffer and optionally the associated file."
  748.   (interactive)
  749.   (let ((buffer (Buffer-menu-buffer nil))
  750.     new-buffer)
  751.     (setq new-buffer (read-buffer
  752.               (concat "Rename " (buffer-name buffer) " to: ")))
  753.     (if (get-buffer new-buffer)
  754.     (error "Buffer %s already exists" new-buffer)
  755.       (save-excursion 
  756.     (set-buffer buffer)
  757.     (rename-buffer new-buffer))
  758.       (Buffer-menu-revert)
  759.       ;; I don't think it should do anything with filenames, this
  760.       ;; should be done in dired.
  761.       ;; The code below is not tested much!
  762.       (if (and (buffer-file-name buffer)
  763.            (y-or-n-p "Change the filename too? "))
  764.       (let ((new-file (concat (file-name-directory 
  765.                    (buffer-file-name buffer)) new-buffer)))
  766.         (if (file-exists-p new-file)
  767.         (error "File already exists.")
  768.           (save-excursion
  769.         (set-buffer buffer)
  770.         (set-visited-file-name new-file))
  771.           (message ""))))
  772.       )))
  773.  
  774. (defun buffer-menu-next-line (arg)
  775.   "Move down lines then position at buffer name.
  776. Optional prefix ARG says how many lines to move; default is one line."
  777.   (interactive "p")
  778.   (if (> arg 0)
  779.       (while (> arg 0)
  780.     (forward-line 1)
  781.     (if (eobp)
  782.         (goto-line 3)
  783.       (if (< (buffer-menu-cur-line) 3)
  784.           (end-of-buffer-menu)))
  785.     (setq arg (1- arg)))
  786.     (while (< arg 0)
  787.       (forward-line -1)
  788.       (if (eobp)
  789.       (goto-line 3)
  790.     (if (< (buffer-menu-cur-line) 3)
  791.         (end-of-buffer-menu)))
  792.       (setq arg (1+ arg))))
  793.   (buffer-menu-move-to-name))
  794.  
  795. (defun buffer-menu-previous-line (arg)
  796.   "Move up lines then position at buffer name.
  797. Optional prefix ARG says how many lines to move; default is one line."
  798.   (interactive "p")
  799.   (buffer-menu-next-line (- arg)))
  800.  
  801. (defun buffer-jump-back ()
  802.   "Jump back to the buffer menu (*Buffer List*) if it exists, if not
  803. do a buffer-menu."
  804.   (interactive)
  805.   (if (get-buffer "*Buffer List*")
  806.       (switch-to-buffer "*Buffer List*")
  807.     (buffer-menu-dired-extended)))
  808.  
  809. (defun Buffer-menu-mark (arg)
  810.   "Mark next ARG buffers.  Default arg is 1."
  811.   (interactive "p")
  812.   (if (> arg 0) 
  813.       (while (> arg 0)
  814.     (beginning-of-line)
  815.     (if (looking-at " [-M]")
  816.         (ding)
  817.       (let ((buffer-read-only nil))
  818.         (if (not (get-buffer (Buffer-menu-buffer-no-arg)))
  819.         (progn
  820.           (buffer-menu-move-to-name)
  821.           (error (concat
  822.               "Buffer '" (Buffer-menu-buffer-no-arg)
  823.               "' no longer exists."))))
  824.         (delete-char 1)
  825.         (insert buffer-marker-char)
  826.         (buffer-menu-next-line 1)))
  827.     (setq arg (1- arg)))
  828.     (while (< arg 0)
  829.       (beginning-of-line)
  830.       (if (looking-at " [-M]")
  831.       (ding)
  832.     (let ((buffer-read-only nil))
  833.       (delete-char 1)
  834.       (insert buffer-marker-char)
  835.       (buffer-menu-next-line -1)))
  836.       (setq arg (1+ arg)))))
  837.  
  838. (defun Buffer-menu-unmark ()
  839.   "Cancel all requested operations on buffer on this line.  Same as original
  840. except this version positions point on the buffername."
  841.   (interactive)
  842.   (beginning-of-line)
  843.   (if (looking-at " [-M]")
  844.       (ding)
  845.     (let* ((buf (Buffer-menu-buffer t))
  846.        (mod (buffer-modified-p buf))
  847.        (readonly (save-excursion (set-buffer buf) buffer-read-only))
  848.        (buffer-read-only nil))
  849.       (delete-char 3)
  850.       (insert (if readonly (if mod " *%" "  %") (if mod " * " "   ")))))
  851.   (buffer-menu-next-line 1))
  852.  
  853. (defun Buffer-menu-backup-unmark ()
  854.   "Move up and cancel all requested operations on buffer on line above.
  855. Same as original except this version positions point on the buffername."
  856.   (interactive)
  857.   (forward-line -1)
  858.   (Buffer-menu-unmark)
  859.   (forward-line -1)
  860.   (buffer-menu-move-to-name))
  861.  
  862. (defun Buffer-menu-delete (arg)
  863.   "In buffer-menu, flag the current line's buffer for deletion."
  864.   (interactive "p")
  865.   (let ((buffer-marker-char buffer-delete-marker))
  866.     (Buffer-menu-mark arg)))
  867.  
  868. (defun Buffer-menu-display-next-buffer (arg)
  869.   "Move down ARG lines and display the buffer in another window."
  870.   (interactive "p")
  871.   (buffer-menu-next-line arg)
  872.   (Buffer-menu-display-this-buffer))
  873.  
  874. (defun Buffer-menu-display-prev-buffer (arg)
  875.   "Move up ARG lines and display the buffer in another window."
  876.   (interactive "p")
  877.   (Buffer-menu-display-next-buffer (- arg)))
  878.  
  879. (defun Buffer-menu-display-this-buffer ()
  880.   "Display this buffer in another window, keeping cursor in *Buffer list*."
  881.   (interactive)
  882.   (let ((name-buffer (Buffer-menu-buffer-no-arg)))
  883.     (if (get-buffer name-buffer)
  884.     (pop-to-buffer name-buffer)
  885.       (if (y-or-n-p (concat "Buffer '" name-buffer
  886.                 "' no longer exists, create it? "))
  887.       (pop-to-buffer name-buffer)
  888.     (message "Reverting buffer list...")
  889.     (sit-for 1)
  890.     (Buffer-menu-revert))))
  891.     (pop-to-buffer "*Buffer List*"))
  892.   
  893. (defun buffer-menu-cur-line ()
  894.    "Function to return the current line number.    GT"
  895.    (save-excursion
  896.       (beginning-of-line)
  897.       (setq buffer-menu-cur-line (1+ (count-lines 1 (point))))))
  898.  
  899. (defun buffer-menu-do-toggle ()
  900.   "Toggle marks.
  901. That is, currently marked buffers become unmarked and vice versa.
  902. Buffers marked with other flags (such as `D') are not affected."
  903.   (interactive)
  904.   (save-excursion
  905.     (goto-line 3)
  906.     (beginning-of-line)
  907.     (let (buffer-read-only)
  908.       (while (not (eobp))
  909.     (apply 'subst-char-in-region
  910.            (point) (1+ (point))
  911.            (if (eq ?\040 (following-char)) ; SPC
  912.            (list ?\040 buffer-marker-char)
  913.          (list buffer-marker-char ?\040)))
  914.     (forward-line 1)))))
  915.  
  916. (defun buffer-do-delete ()
  917.   "Deletes the buffers marked with the buffer-mark-char.  Interactive if
  918. buffer-menu-confirm-deletes is t."
  919.   (interactive)
  920.   (Buffer-menu-execute t))
  921.  
  922. (define-key global-map "\C-c\C-j" 'buffer-jump-back)
  923.  
  924. (fset 'buffer-regexp-prefix (make-sparse-keymap))
  925. (define-key Buffer-menu-mode-map "r" 'buffer-menu-rename)
  926. (define-key Buffer-menu-mode-map "\e<" 'beginning-of-buffer-menu)
  927. (define-key Buffer-menu-mode-map "\e>" 'end-of-buffer-menu)
  928. (define-key Buffer-menu-mode-map "\e{" 'buffer-menu-prev-marked-buffer)
  929. (define-key Buffer-menu-mode-map "\e}" 'buffer-menu-next-marked-buffer)
  930. (define-key Buffer-menu-mode-map "%" 'buffer-regexp-prefix)
  931. (define-key Buffer-menu-mode-map "%d" 'buffer-flag-regexp-files)
  932. (define-key Buffer-menu-mode-map "%m" 'buffer-mark-files-regexp)
  933. (define-key Buffer-menu-mode-map "\M-\C-?" 'buffer-unflag-all-files)
  934. (define-key Buffer-menu-mode-map "F" 'Buffer-menu-select)
  935. (define-key Buffer-menu-mode-map "q" 'Buffer-menu-quit)
  936. (define-key Buffer-menu-mode-map "g" 'Buffer-menu-revert)
  937. (define-key Buffer-menu-mode-map "w" 'buffer-copy-buffername-as-kill)
  938. (define-key Buffer-menu-mode-map "R" 'buffer-menu-list-regexp)
  939. (define-key Buffer-menu-mode-map "S" 'buffer-menu-toggle-sort)
  940. (define-key Buffer-menu-mode-map "L" 'buffer-menu-toggle-direds-or-files)
  941. (define-key Buffer-menu-mode-map "n" 'buffer-menu-next-line)
  942. (define-key Buffer-menu-mode-map "p" 'buffer-menu-previous-line)
  943. (define-key Buffer-menu-mode-map " " 'buffer-menu-next-line)
  944. (define-key Buffer-menu-mode-map "\C-n" 'buffer-menu-next-line)
  945. (define-key Buffer-menu-mode-map "\C-p" 'buffer-menu-previous-line)
  946. (define-key Buffer-menu-mode-map "N" 'Buffer-menu-display-next-buffer)
  947. (define-key Buffer-menu-mode-map "P" 'Buffer-menu-display-prev-buffer)
  948. (define-key Buffer-menu-mode-map "J" 'Buffer-menu-display-this-buffer)
  949. (define-key Buffer-menu-mode-map "T" 'buffer-menu-do-toggle)
  950. (define-key Buffer-menu-mode-map "X" 'buffer-do-delete)
  951. ........................... cut along dotted line ...........................
  952.