home *** CD-ROM | disk | FTP | other *** search
/ OS/2 Shareware BBS: 5 Edit / 05-Edit.zip / me34src.zip / me3 / mutt / package / buf-menu.mut < prev    next >
Lisp/Scheme  |  1995-01-14  |  11KB  |  417 lines
  1. ;; Buffer menu main function and support functions.
  2. ;; Copyright (C) 1985, 1986, 1987 Free Software Foundation, Inc.
  3.  
  4. ;; This file is part of GNU Emacs.
  5.  
  6. ;; GNU Emacs is distributed in the hope that it will be useful, but WITHOUT
  7. ;; ANY WARRANTY.  No author or distributor accepts responsibility to anyone
  8. ;; for the consequences of using it or for whether it serves any particular
  9. ;; purpose or works at all, unless he says so in writing.  Refer to the GNU
  10. ;; Emacs General Public License for full details.
  11.  
  12. ;; Everyone is granted permission to copy, modify and redistribute GNU
  13. ;; Emacs, but only under the conditions described in the GNU Emacs General
  14. ;; Public License.  A copy of this license is supposed to have been given
  15. ;; to you along with GNU Emacs so you can know your rights and
  16. ;; responsibilities.  It should be in a file named COPYING.  Among other
  17. ;; things, the copyright notice and this notice must be preserved on all
  18. ;; copies.
  19.  
  20. ;; Ported to Mutt 11/92 by C Durland
  21. ;; Added read-only stuff 7/93
  22.  
  23. (include me.mh)
  24.  
  25. ; Put buffer *Buffer List* into proper mode right away
  26. ; so that from now on even list-buffers is enough to get a buffer menu.
  27.  
  28. (int Buffer-menu-mode-map)
  29.  
  30. (defun MAIN
  31. {
  32.   (small-int i)
  33.  
  34.   (Buffer-menu-mode-map (create-keymap))
  35.  
  36. ;  (suppress-keymap Buffer-menu-mode-map t)
  37.  
  38.   (bind-key Buffer-menu-mode-map
  39.     "Buffer-menu-select"        "q"
  40.     "Buffer-menu-2-window"        "2"
  41.     "Buffer-menu-1-window"        "1"
  42.     "Buffer-menu-this-window"    "f"
  43.     "Buffer-menu-other-window"    "o"
  44.     "Buffer-menu-save"        "s"
  45.     "Buffer-menu-delete"        "d"
  46.     "Buffer-menu-delete"        "k"
  47.     "Buffer-menu-delete-backwards"    "C-d"
  48.     "Buffer-menu-delete"        "C-k"
  49.     "Buffer-menu-execute"        "x"
  50.     "next-line"            " "
  51.     "Buffer-menu-backup-unmark"    "C-?"
  52.     "Buffer-menu-backup-unmark"    "C-h"
  53.     "Buffer-menu-not-modified"    "~"
  54.     "Buffer-menu-unmark"        "u"
  55.     "Buffer-menu-mark"        "m"
  56.     "Buffer-menu-doc"        "?"
  57.     "Buffer-menu-toggle-hidden"    "h"
  58.  
  59.     "next-line"            "j"
  60.     "previous-line"            "k"
  61.     "next-character"        "l"
  62.  
  63.     "next-line"            "C-m")
  64. })
  65.  
  66. ;; Buffer Menu mode is suitable only for specially formatted data.
  67. ;(put 'Buffer-menu-mode 'mode-class 'special)
  68.  
  69. ;; Precisely,{Buffer-menu-mode-map}
  70.  
  71. (defun Buffer-menu-mode HIDDEN
  72. {
  73. ;  (setq truncate-lines t)
  74.  
  75.   (buffer-read-only TRUE)
  76.  
  77.   (install-keymap NULL-KEYMAP LOCAL-KEYMAP)    ;;!!!???
  78.   (clear-modes)            ;;!!!???
  79.  
  80.   (install-keymap Buffer-menu-mode-map LOCAL-KEYMAP)
  81.   (major-mode "Buffer Menu")
  82.  
  83.   (if (pgm-exists "buffer-menu-mode-hook") (floc "buffer-menu-mode-hook"()))
  84. })
  85.  
  86. (defun
  87.   Buffer-menu-doc
  88.   {
  89.     (menu-box
  90.       ">Major mode for editing a list of buffers."
  91.       ">Each line describes one of the buffers in Emacs."
  92.       "Letters do not insert themselves; instead, they are commands."
  93.       "m -- Mark buffer to be displayed."
  94.       "q -- Select buffer of line point is on."
  95.       "     Also show buffers marked with m in other windows."
  96.       "1 -- Select this buffer in full-screen window."
  97. ;      "2 -- Select this buffer in one window, together with buffer"
  98. ;      "     selected before this one in another window."
  99.       "f -- Select this buffer in place of the buffer menu buffer."
  100.       "o -- Put this buffer in another window, so the buffer"
  101.       "     menu buffer remains visible in its window."
  102.       "~ -- Clear modified-flag on this buffer."
  103.       "s -- Mark this buffer to be saved and move down."
  104.       "d or k -- Mark this buffer to be deleted and move down."
  105.       "C-d -- Mark this buffer to be deleted and move up."
  106.       "h -- Toggle buffer hidden flag."
  107.       "x -- Delete or save marked buffers."
  108.       "u -- Remove all kinds of marks from current line."
  109.       "Backspace or Delete -- Back up a line and remove marks."
  110.     )
  111.   }
  112. )
  113.  
  114. ;; Make a menu of buffers so you can save, delete or select them.
  115. ;; ???With argument, show only buffers that are visiting files.
  116. ;; Type ? after invocation to get help on commands available.
  117. ;; ???Type q immediately to make the buffer menu go away.
  118. (defun buffer-menu
  119. {
  120.   (current-window (list-buffers))
  121.  
  122.   (Buffer-menu-mode)
  123.  
  124.   (msg
  125.    "Commands: d, s, x; 1, m, u, q; backspace, delete; ~, h;  ? for help.")
  126. })
  127.  
  128. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  129. ;;;;;;;; Routines dependent on list-buffers (bstats.mut) ;;;;;;;;;;;
  130. ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
  131.  
  132. (const
  133.   Buffer-menu-buffer-column 14    ;; Buffer names column in *buffer-list*
  134.   Buffer-menu-mod-column     2    ;; The "M" column
  135.   Buffer-menu-hidden-column  5    ;; The "h" column
  136. )
  137.     ;; Return buffer described by this line of buffer menu.
  138.     ;; Output:
  139.     ;;   buffer id
  140.     ;;   -2
  141. (defun Buffer-menu-buffer (bool error-if-non-existent-p) HIDDEN
  142. {
  143.   (bool match)
  144.   (int bid col)
  145.  
  146.   (col (current-column))
  147.  
  148.   (current-column Buffer-menu-buffer-column)
  149.  
  150.   (match (looking-at '\([^     ]+\)\ '))
  151.   (current-column col)
  152.   (if match
  153.     (if (!= -2 (bid (attached-buffer (get-matched '\1'))))
  154.       { bid (done) }))
  155.  
  156.   (if error-if-non-existent-p
  157.     { (msg "No buffer named \"" (if match (get-matched '\1') "") "\"") (halt) })
  158.  
  159.   -2
  160. })
  161.  
  162. (defun
  163.   ding HIDDEN { (beep) }
  164.   looking-at-header HIDDEN
  165.   {
  166.     (bool no-data)
  167.     (int col)
  168.  
  169.     (col (current-column))
  170.  
  171.     (no-data FALSE)
  172.     (beginning-of-line)
  173.     (if (or
  174.       (looking-at "Flags")
  175.       (looking-at '-----   ----')
  176.       (looking-at '\ +\d+')
  177.       (looking-at '\ *$'))
  178.       (no-data TRUE))
  179.  
  180.     (current-column col)
  181.  
  182.     no-data
  183.   }
  184.   change-char-in-col (int col) (string to) HIDDEN
  185.   {
  186.     (int ccol)
  187.  
  188.     (ccol (current-column))
  189.  
  190.     (current-column col)
  191.     (buffer-read-only FALSE)
  192.     (delete-character)
  193.     (insert-text to)
  194.     (buffer-read-only TRUE)
  195.  
  196.     (current-column ccol)
  197.   }
  198.   change-to  (string to) HIDDEN { (change-char-in-col 1 to) }
  199.   change-mod (string to) HIDDEN
  200.     { (change-char-in-col Buffer-menu-mod-column to) }
  201.   find-selected (string what) HIDDEN
  202.   {
  203.     (search-forward (concat "^J" what))
  204.   }
  205.   restore-mod (int bid) HIDDEN
  206.   {
  207.     (change-mod
  208.       (if (!= 0 (bit-and BFNoCare (buffer-flags bid)))
  209.         "."
  210.         (if (buffer-modified bid) "M" "-")))
  211.   }
  212. )
  213.  
  214.     ;; Toggle hidden bit on the buffer on this line
  215. (defun Buffer-menu-toggle-hidden
  216. {
  217.   (bool hidden)
  218.   (int bid)
  219.  
  220.   (hidden (!= 0
  221.     (bit-and BFHidden2 (buffer-flags (bid (Buffer-menu-buffer TRUE))))))
  222.  
  223.   (if hidden
  224.     (unhide-buffer (buffer-name bid))
  225.     (buffer-flags bid (bit-or BFHidden2 (buffer-flags bid))))
  226.  
  227.   (change-char-in-col Buffer-menu-hidden-column (if hidden "-" "h"))
  228.  
  229.   (next-line)
  230. })
  231.  
  232. ;; Mark buffer on this line for being displayed by [Buffer-menu-select]
  233. ;;   command.
  234. (defun Buffer-menu-mark
  235. {
  236.   (if (looking-at-header)
  237.     (ding)
  238.     {
  239.       (change-to ">")
  240.       (next-line)
  241.     })
  242. })
  243.  
  244. ;; Cancel all requested operations on buffer on this line.
  245. (defun Buffer-menu-unmark
  246. {
  247.   (int buf)
  248.  
  249.   (if (looking-at-header)
  250.     (ding)
  251.     {
  252.       (restore-mod (Buffer-menu-buffer TRUE))
  253.       (change-to " ")
  254.     })
  255.   (next-line)
  256. })
  257.  
  258. ;; Move up and cancel all requested operations on buffer on line above.
  259. (defun Buffer-menu-backup-unmark
  260. {
  261.   (previous-line)
  262.   (Buffer-menu-unmark)
  263.   (previous-line)
  264. })
  265.  
  266. ;; Mark buffer on this line to be deleted by \\[Buffer-menu-execute] command.
  267. (defun Buffer-menu-delete
  268. {
  269.   (if (looking-at-header)
  270.     (ding)
  271.     {
  272.       (change-to "D")
  273.       (next-line)
  274.     })
  275. })
  276.  
  277. ;; Mark buffer on this line to be deleted by [Buffer-menu-execute]
  278. ;;   command and then move up one line
  279. (defun Buffer-menu-delete-backwards
  280. {
  281.   (Buffer-menu-delete)
  282.   (arg-prefix -2)(next-line)
  283.   (if (looking-at-header) (next-line))
  284. })
  285.  
  286. ;; Mark buffer on this line to be saved by [Buffer-menu-execute] command.
  287. (defun Buffer-menu-save
  288. {
  289.   (if (looking-at-header)
  290.     (ding)
  291.     {
  292.       (change-mod "S")
  293.       (next-line)
  294.     })
  295. })
  296.  
  297. ;; Mark buffer on this line as unmodified (no changes to save).
  298. (defun Buffer-menu-not-modified
  299. {
  300.   (int buf)
  301.  
  302.   (buffer-modified (buf (Buffer-menu-buffer TRUE)) FALSE)
  303.   (restore-mod buf)
  304. })
  305.  
  306.  
  307. ;; Save and/or delete buffers marked with [Buffer-menu-save] or
  308. ;;   [Buffer-menu-delete] commands.
  309. (defun Buffer-menu-execute
  310. {
  311.   (bool modp)
  312.   (int buff-menu-buffer buf cb mark)
  313.  
  314.   (set-mark (mark (create-mark)))
  315.   (buff-menu-buffer (current-buffer))
  316.  
  317.   (beginning-of-buffer)
  318.   (forward-line 2)
  319.   (while (re-search-forward '^.S')    ;;!!!
  320.     {
  321.       (current-buffer (buf (Buffer-menu-buffer TRUE)))
  322.       (save-buffer)
  323.       (modp (buffer-modified -1))   ;; in case save didn't (eg no file name)
  324.       (current-buffer buff-menu-buffer)
  325.  
  326.       (restore-mod buf)
  327.     })
  328.  
  329.   (beginning-of-buffer)
  330.   (forward-line 1)
  331.  
  332.   (while (find-selected "D")
  333.     {
  334.       (buf (Buffer-menu-buffer FALSE))
  335.       (if (and (!= buf -2)(!= buf buff-menu-buffer))
  336.       (delete-buffer (buffer-name buf)))
  337.  
  338.       (if (!= -2 (Buffer-menu-buffer FALSE))    ;; wasn't able to delete buffer
  339.         (change-to " ")
  340.     {
  341.       (beginning-of-line)(set-mark)(forward-line 1)
  342.       (buffer-read-only FALSE)(delete-region)(buffer-read-only TRUE)
  343.       (forward-char -1)    ;; backup for (find-selected)
  344.     })
  345.     })
  346.  
  347.   (goto-mark mark)
  348. })
  349.  
  350. ;; Select this line's buffer; also display buffers marked with ">".  You
  351. ;;   can mark buffers with the [Buffer-menu-mark] command.
  352. (defun Buffer-menu-select
  353. {
  354.   (int buff tem n)
  355.   (list others)
  356.  
  357.   (buff (Buffer-menu-buffer TRUE))
  358.  
  359.   (beginning-of-buffer)
  360.   (while (find-selected ">")
  361.     {
  362.       (tem (Buffer-menu-buffer TRUE))
  363.       (change-to " ")
  364.       (if (!= tem buff) (insert-object others 1000 tem))
  365.     })
  366.  
  367.   (tem (/ (- (screen-length) 2) (+ 1 (length-of others))))
  368.   (delete-other-windows)
  369.   (current-buffer buff TRUE)
  370.  
  371.   (n 0)
  372.   (while (!= 0 (length-of others))
  373.     {
  374.       (split-window)
  375.       (window-height n tem)
  376.       (current-window (+= n 1))    ;; because split-window can be weird pre ME3
  377.       (current-buffer (extract-element others 0) TRUE)
  378.       (remove-elements others 0 1)
  379.     })
  380.  
  381.   (current-window 0)            ; back to the beginning!
  382. })
  383.  
  384. ;; Select this line's buffer, alone, in full screen.
  385. (defun Buffer-menu-1-window
  386. {
  387.   (current-buffer (Buffer-menu-buffer TRUE) TRUE)
  388.   (delete-other-windows)
  389. })
  390.  
  391. ;; Select this line's buffer in this window.
  392. (defun Buffer-menu-this-window
  393. {
  394.   (current-buffer (Buffer-menu-buffer TRUE) TRUE)
  395. })
  396.  
  397. ;; Select this line's buffer in other window, leaving buffer menu visible.
  398. (defun Buffer-menu-other-window
  399. {
  400.   (current-window (popup-buffer (Buffer-menu-buffer TRUE)))
  401. })
  402.  
  403. ;; Select this line's buffer, with previous buffer in second window.
  404. (defun Buffer-menu-2-window
  405. {
  406.   (msg "Not implemented")
  407.  
  408. ;  (int buff menu)
  409. ;
  410. ;  (buff (Buffer-menu-buffer TRUE))
  411. ;  (menu (current-buffer))
  412. ;  (pop-up-windows t))
  413. ;  (switch-to-buffer (other-buffer))
  414. ;  (pop-to-buffer buff)
  415. ;  (bury-buffer menu))
  416. })
  417.