Annotation of GNUtools/emacs/lisp/buff-menu.el, revision 1.1

1.1     ! root        1: ;; Buffer menu main function and support functions.
        !             2: ;; Copyright (C) 1985, 1986, 1987, 1990 Free Software Foundation, Inc.
        !             3: 
        !             4: ;; This file is part of GNU Emacs.
        !             5: 
        !             6: ;; GNU Emacs is free software; you can redistribute it and/or modify
        !             7: ;; it under the terms of the GNU General Public License as published by
        !             8: ;; the Free Software Foundation; either version 1, or (at your option)
        !             9: ;; any later version.
        !            10: 
        !            11: ;; GNU Emacs is distributed in the hope that it will be useful,
        !            12: ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
        !            13: ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
        !            14: ;; GNU General Public License for more details.
        !            15: 
        !            16: ;; You should have received a copy of the GNU General Public License
        !            17: ;; along with GNU Emacs; see the file COPYING.  If not, write to
        !            18: ;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
        !            19: 
        !            20: 
        !            21: ; Put buffer *Buffer List* into proper mode right away
        !            22: ; so that from now on even list-buffers is enough to get a buffer menu.
        !            23: 
        !            24: (defvar Buffer-menu-mode-map nil "")
        !            25: 
        !            26: (if Buffer-menu-mode-map
        !            27:     ()
        !            28:   (setq Buffer-menu-mode-map (make-keymap))
        !            29:   (suppress-keymap Buffer-menu-mode-map t)
        !            30:   (define-key Buffer-menu-mode-map "q" 'Buffer-menu-select)
        !            31:   (define-key Buffer-menu-mode-map "2" 'Buffer-menu-2-window)
        !            32:   (define-key Buffer-menu-mode-map "1" 'Buffer-menu-1-window)
        !            33:   (define-key Buffer-menu-mode-map "f" 'Buffer-menu-this-window)
        !            34:   (define-key Buffer-menu-mode-map "o" 'Buffer-menu-other-window)
        !            35:   (define-key Buffer-menu-mode-map "s" 'Buffer-menu-save)
        !            36:   (define-key Buffer-menu-mode-map "d" 'Buffer-menu-delete)
        !            37:   (define-key Buffer-menu-mode-map "k" 'Buffer-menu-delete)
        !            38:   (define-key Buffer-menu-mode-map "\C-d" 'Buffer-menu-delete-backwards)
        !            39:   (define-key Buffer-menu-mode-map "\C-k" 'Buffer-menu-delete)
        !            40:   (define-key Buffer-menu-mode-map "x" 'Buffer-menu-execute)
        !            41:   (define-key Buffer-menu-mode-map " " 'next-line)
        !            42:   (define-key Buffer-menu-mode-map "\177" 'Buffer-menu-backup-unmark)
        !            43:   (define-key Buffer-menu-mode-map "~" 'Buffer-menu-not-modified)
        !            44:   (define-key Buffer-menu-mode-map "?" 'describe-mode)
        !            45:   (define-key Buffer-menu-mode-map "u" 'Buffer-menu-unmark)
        !            46:   (define-key Buffer-menu-mode-map "m" 'Buffer-menu-mark))
        !            47: 
        !            48: ;; Buffer Menu mode is suitable only for specially formatted data.
        !            49: (put 'Buffer-menu-mode 'mode-class 'special)
        !            50: 
        !            51: (defun Buffer-menu-mode ()
        !            52:   "Major mode for editing a list of buffers.
        !            53: Each line describes one of the buffers in Emacs.
        !            54: Letters do not insert themselves; instead, they are commands.
        !            55: m -- mark buffer to be displayed.
        !            56: q -- select buffer of line point is on.
        !            57:   Also show buffers marked with m in other windows.
        !            58: 1 -- select that buffer in full-screen window.
        !            59: 2 -- select that buffer in one window,
        !            60:   together with buffer selected before this one in another window.
        !            61: f -- select that buffer in place of the buffer menu buffer.
        !            62: o -- select that buffer in another window,
        !            63:   so the buffer menu buffer remains visible in its window.
        !            64: ~ -- clear modified-flag on that buffer.
        !            65: s -- mark that buffer to be saved, and move down.
        !            66: d or k -- mark that buffer to be deleted, and move down.
        !            67: C-d -- mark that buffer to be deleted, and move up.
        !            68: x -- delete or save marked buffers.
        !            69: u -- remove all kinds of marks from current line.
        !            70: Delete -- back up a line and remove marks.
        !            71: 
        !            72: Precisely,\\{Buffer-menu-mode-map}"
        !            73:   (kill-all-local-variables)
        !            74:   (use-local-map Buffer-menu-mode-map)
        !            75:   (setq truncate-lines t)
        !            76:   (setq buffer-read-only t)
        !            77:   (setq major-mode 'Buffer-menu-mode)
        !            78:   (setq mode-name "Buffer Menu")
        !            79:   (run-hooks 'buffer-menu-mode-hook))
        !            80: 
        !            81: (defvar Buffer-menu-buffer-column 4)
        !            82: 
        !            83: (defun Buffer-menu-buffer (error-if-non-existent-p)
        !            84:   "Return buffer described by this line of buffer menu."
        !            85:   (save-excursion
        !            86:     (beginning-of-line)
        !            87:     (forward-char Buffer-menu-buffer-column)
        !            88:     (let ((start (point))
        !            89:          string)
        !            90:       ;; End of buffer name marked by tab or two spaces.
        !            91:       (re-search-forward "\t\\|  ")
        !            92:       (skip-chars-backward " \t")
        !            93:       (setq string (buffer-substring start (point)))
        !            94:       (or (get-buffer string)
        !            95:          (if error-if-non-existent-p
        !            96:              (error "No buffer named \"%s\"" string)
        !            97:            nil)))))
        !            98: 
        !            99: (defun buffer-menu (arg)
        !           100:   "Make a menu of buffers so you can save, delete or select them.
        !           101: With argument, show only buffers that are visiting files.
        !           102: Type ? after invocation to get help on commands available.
        !           103: Type q immediately to make the buffer menu go away."
        !           104:   (interactive "P")
        !           105:   (list-buffers arg)
        !           106:   (pop-to-buffer "*Buffer List*")
        !           107:   (forward-line 2)
        !           108:   (message
        !           109:    "Commands: d, s, x; 1, 2, m, u, q; delete; ~;  ? for help."))
        !           110: 
        !           111: (defun Buffer-menu-mark ()
        !           112:   "Mark buffer on this line for being displayed by \\[Buffer-menu-select] command."
        !           113:   (interactive)
        !           114:   (beginning-of-line)
        !           115:   (if (looking-at " [-M]")
        !           116:       (ding)
        !           117:     (let ((buffer-read-only nil))
        !           118:       (delete-char 1)
        !           119:       (insert ?>)
        !           120:       (forward-line 1))))
        !           121: 
        !           122: (defun Buffer-menu-unmark ()
        !           123:   "Cancel all requested operations on buffer on this line."
        !           124:   (interactive)
        !           125:   (beginning-of-line)
        !           126:   (if (looking-at " [-M]")
        !           127:       (ding)
        !           128:     (let* ((buf (Buffer-menu-buffer t))
        !           129:           (mod (buffer-modified-p buf))
        !           130:           (readonly (save-excursion (set-buffer buf) buffer-read-only))
        !           131:           (buffer-read-only nil))
        !           132:       (delete-char 3)
        !           133:       (insert (if readonly (if mod " *%" "  %") (if mod " * " "   ")))))
        !           134:   (forward-line 1))
        !           135: 
        !           136: (defun Buffer-menu-backup-unmark ()
        !           137:   "Move up and cancel all requested operations on buffer on line above."
        !           138:   (interactive)
        !           139:   (forward-line -1)
        !           140:   (Buffer-menu-unmark)
        !           141:   (forward-line -1))
        !           142: 
        !           143: (defun Buffer-menu-delete ()
        !           144:   "Mark buffer on this line to be deleted by \\[Buffer-menu-execute] command."
        !           145:   (interactive)
        !           146:   (beginning-of-line)
        !           147:   (if (looking-at " [-M]")             ;header lines
        !           148:       (ding)
        !           149:     (let ((buffer-read-only nil))
        !           150:       (delete-char 1)
        !           151:       (insert ?D)
        !           152:       (forward-line 1))))
        !           153: 
        !           154: (defun Buffer-menu-delete-backwards ()
        !           155:   "Mark buffer on this line to be deleted by \\[Buffer-menu-execute] command
        !           156: and then move up one line"
        !           157:   (interactive)
        !           158:   (Buffer-menu-delete)
        !           159:   (forward-line -2)
        !           160:   (if (looking-at " [-M]") (forward-line 1)))
        !           161: 
        !           162: (defun Buffer-menu-save ()
        !           163:   "Mark buffer on this line to be saved by \\[Buffer-menu-execute] command."
        !           164:   (interactive)
        !           165:   (beginning-of-line)
        !           166:   (forward-char 1)
        !           167:   (if (looking-at " [-M]")             ;header lines
        !           168:       (ding)
        !           169:     (let ((buffer-read-only nil))
        !           170:       (delete-char 1)
        !           171:       (insert ?S)
        !           172:       (forward-line 1))))
        !           173: 
        !           174: (defun Buffer-menu-not-modified ()
        !           175:   "Mark buffer on this line as unmodified (no changes to save)."
        !           176:   (interactive)
        !           177:   (save-excursion
        !           178:     (set-buffer (Buffer-menu-buffer t))
        !           179:     (set-buffer-modified-p nil))
        !           180:   (save-excursion
        !           181:    (beginning-of-line)
        !           182:    (forward-char 1)
        !           183:    (if (looking-at "\\*")
        !           184:        (let ((buffer-read-only nil))
        !           185:         (delete-char 1)
        !           186:         (insert ? )))))
        !           187: 
        !           188: (defun Buffer-menu-execute ()
        !           189:   "Save and/or delete buffers marked with \\[Buffer-menu-save] or \\[Buffer-menu-delete] commands."
        !           190:   (interactive)
        !           191:   (save-excursion
        !           192:     (goto-char (point-min))
        !           193:     (forward-line 1)
        !           194:     (while (re-search-forward "^.S" nil t)
        !           195:       (let ((modp nil))
        !           196:        (save-excursion
        !           197:          (set-buffer (Buffer-menu-buffer t))
        !           198:          (save-buffer)
        !           199:          (setq modp (buffer-modified-p)))
        !           200:        (let ((buffer-read-only nil))
        !           201:          (delete-char -1)
        !           202:          (insert (if modp ?* ? ))))))
        !           203:   (save-excursion
        !           204:     (goto-char (point-min))
        !           205:     (forward-line 1)
        !           206:     (let ((buff-menu-buffer (current-buffer))
        !           207:          (buffer-read-only nil))
        !           208:       (while (search-forward "\nD" nil t)
        !           209:        (forward-char -1)
        !           210:        (let ((buf (Buffer-menu-buffer nil)))
        !           211:          (or (eq buf nil)
        !           212:              (eq buf buff-menu-buffer)
        !           213:              (save-excursion (kill-buffer buf))))
        !           214:        (if (Buffer-menu-buffer nil)
        !           215:            (progn (delete-char 1)
        !           216:                   (insert ? ))
        !           217:          (delete-region (point) (progn (forward-line 1) (point)))
        !           218:          (forward-char -1))))))
        !           219: 
        !           220: (defun Buffer-menu-select ()
        !           221:   "Select this line's buffer; also display buffers marked with \">\".
        !           222: You can mark buffers with the \\[Buffer-menu-mark] command."
        !           223:   (interactive)
        !           224:   (let ((buff (Buffer-menu-buffer t))
        !           225:        (menu (current-buffer))       
        !           226:        (others ())
        !           227:        tem)
        !           228:     (goto-char (point-min))
        !           229:     (while (search-forward "\n>" nil t)
        !           230:       (setq tem (Buffer-menu-buffer t))
        !           231:       (let ((buffer-read-only nil))
        !           232:        (delete-char -1)
        !           233:        (insert ?\ ))
        !           234:       (or (eq tem buff) (memq tem others) (setq others (cons tem others))))
        !           235:     (setq others (nreverse others)
        !           236:          tem (/ (1- (screen-height)) (1+ (length others))))
        !           237:     (delete-other-windows)
        !           238:     (switch-to-buffer buff)
        !           239:     (or (eq menu buff)
        !           240:        (bury-buffer menu))
        !           241:     (while others
        !           242:       (split-window nil tem)
        !           243:       (other-window 1)
        !           244:       (switch-to-buffer (car others))
        !           245:       (setq others (cdr others)))
        !           246:     (other-window 1)))                 ;back to the beginning!
        !           247: 
        !           248: (defun Buffer-menu-1-window ()
        !           249:   "Select this line's buffer, alone, in full screen."
        !           250:   (interactive)
        !           251:   (switch-to-buffer (Buffer-menu-buffer t))
        !           252:   (bury-buffer (other-buffer))
        !           253:   (delete-other-windows))
        !           254: 
        !           255: (defun Buffer-menu-this-window ()
        !           256:   "Select this line's buffer in this window."
        !           257:   (interactive)
        !           258:   (switch-to-buffer (Buffer-menu-buffer t)))
        !           259: 
        !           260: (defun Buffer-menu-other-window ()
        !           261:   "Select this line's buffer in other window, leaving buffer menu visible."
        !           262:   (interactive)
        !           263:   (switch-to-buffer-other-window (Buffer-menu-buffer t)))
        !           264: 
        !           265: (defun Buffer-menu-2-window ()
        !           266:   "Select this line's buffer, with previous buffer in second window."
        !           267:   (interactive)
        !           268:   (let ((buff (Buffer-menu-buffer t))
        !           269:        (menu (current-buffer))
        !           270:        (pop-up-windows t))
        !           271:     (switch-to-buffer (other-buffer))
        !           272:     (pop-to-buffer buff)
        !           273:     (bury-buffer menu)))

unix.superglobalmegacorp.com

This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.