lisp/menu-bar.el

   1 (define-key global-map [menu-bar] (make-sparse-keymap "menu-bar"))
   2 (setq menu-bar-help-menu (make-sparse-keymap "Help"))
   3 (define-key global-map [menu-bar help] (cons "Help" menu-bar-help-menu))
   4 (setq menu-bar-edit-menu (make-sparse-keymap "Edit"))
   5 (define-key global-map [menu-bar edit] (cons "Edit" menu-bar-edit-menu))
   6 (setq menu-bar-file-menu (make-sparse-keymap "File"))
   7 (define-key global-map [menu-bar file] (cons "File" menu-bar-file-menu))
   8
   9 (define-key menu-bar-file-menu [exit-emacs]
  10   '("Exit Emacs" . save-buffers-kill-emacs))
  11 (define-key menu-bar-file-menu [kill-buffer]
  12   '("Kill Buffer" . kill-this-buffer))
  13 (define-key menu-bar-file-menu [delete-frame] '("Delete Frame" . delete-frame))
  14 (define-key menu-bar-file-menu [print-buffer] '("Print Buffer" . print-buffer))
  15 (define-key menu-bar-file-menu [revert-buffer]
  16   '("Revert Buffer" . revert-buffer))
  17 (define-key menu-bar-file-menu [write-file]
  18   '("Save Buffer As..." . write-file))
  19 (define-key menu-bar-file-menu [save-buffer] '("Save Buffer" . save-buffer))
  20 (define-key menu-bar-file-menu [open-file] '("Open File..." . find-file))
  21 (define-key menu-bar-file-menu [new-frame] '("New Frame" . new-frame))
  22
  23 (define-key menu-bar-edit-menu [clear] '("Clear" . x-delete-primary-selection))
  24 (define-key menu-bar-edit-menu [paste] '("Paste" . x-yank-clipboard-selection))
  25 (define-key menu-bar-edit-menu [copy] '("Copy" . x-copy-primary-selection))
  26 (define-key menu-bar-edit-menu [cut] '("Cut" . x-kill-primary-selection))
  27 (define-key menu-bar-edit-menu [undo] '("Undo" . advertised-undo))
  28
  29 (define-key menu-bar-help-menu [emacs-tutorial]
  30   '("Emacs Tutorial" . help-with-tutorial))
  31 (define-key menu-bar-help-menu [man] '("Man..." . manual-entry))
  32 (define-key menu-bar-help-menu [describe-variable]
  33   '("Describe Variable..." . describe-variable))
  34 (define-key menu-bar-help-menu [describe-function]
  35   '("Describe Function..." . describe-function))
  36 (define-key menu-bar-help-menu [describe-key]
  37   '("Describe Key..." . describe-key))
  38 (define-key menu-bar-help-menu [list-keybindings]
  39   '("List Keybindings" . describe-bindings))
  40 (define-key menu-bar-help-menu [command-apropos]
  41   '("Command Apropos..." . command-apropos))
  42 (define-key menu-bar-help-menu [describe-mode]
  43   '("Describe Mode" . describe-mode))
  44 (define-key menu-bar-help-menu [info] '("Info" . info))
  45
  46 (define-key menu-bar-help-menu [emacs-news] '("Emacs News" . view-emacs-news))
  47 (defun kill-this-buffer ()      ; for the menubar
  48   "Kills the current buffer."
  49   (interactive)
  50   (kill-buffer (current-buffer)))
  51
  52 (defun kill-this-buffer-enabled-p ()
  53   (let ((count 0)
  54         (buffers (buffer-list)))
  55     (while buffers
  56       (or (string-match "^ " (buffer-name (car buffers)))
  57           (setq count (1+ count)))
  58       (setq buffers (cdr buffers)))
  59     (> count 1)))
  60
  61 (put 'save-buffer 'menu-enable '(buffer-modified-p))
  62 (put 'revert-buffer 'menu-enable '(and (buffer-modified-p) (buffer-file-name)))
  63 (put 'delete-frame 'menu-enable '(cdr (visible-frame-list)))
  64 (put 'kill-this-buffer 'menu-enable '(kill-this-buffer-enabled-p))
  65
  66 (put 'x-kill-primary-selection 'menu-enable '(x-selection-owner-p))
  67 (put 'x-copy-primary-selection 'menu-enable '(x-selection-owner-p))
  68 (put 'x-yank-clipboard-selection 'menu-enable '(x-selection-owner-p))
  69 (put 'x-delete-primary-selection 'menu-enable
  70      '(x-selection-exists-p 'CLIPBOARD))
  71
  72 (put 'advertised-undo 'menu-enable
  73      '(and (not (eq t buffer-undo-list))
  74            (if (eq last-command 'undo)
  75                (and (boundp 'pending-undo-list)
  76                     pending-undo-list)
  77              buffer-undo-list)))
  78 \f
  79 (define-key global-map [menu-bar buffer] '("Buffers" . mouse-buffer-menu))
  80
  81 (defvar complex-buffers-menu-p nil
  82   "*Non-nil says, offer a choice of actions after you pick a buffer.
  83 This applies to the Buffers menu from the menu bar.")
  84
  85 (defvar buffers-menu-max-size 10
  86   "*Maximum number of entries which may appear on the Buffers menu.
  87 If this is 10, then only the ten most-recently-selected buffers are shown.
  88 If this is nil, then all buffers are shown.
  89 A large number or nil slows down menu responsiveness.")
  90
  91 (defun mouse-buffer-menu (event)
  92   "Pop up a menu of buffers for selection with the mouse.
  93 This switches buffers in the window that you clicked on,
  94 and selects that window."
  95   (interactive "e")
  96   (let ((buffers (buffer-list))
  97         menu)
  98     ;; If requested, list only the N most recently selected buffers.
  99     (if (and (integerp buffers-menu-max-size)
 100              (> buffers-menu-max-size 1))
 101         (if (> (length buffers) buffers-menu-max-size)
 102             (setcdr (nthcdr buffers-menu-max-size buffers) nil)))
 103     (setq menu
 104           (list "Buffer Menu"
 105                 (cons "Select Buffer"
 106                       (let ((tail buffers)
 107                             (maxlen 0)
 108                             head)
 109                         (while tail
 110                           (let ((elt (car tail)))
 111                             (if (not (string-match "^ "
 112                                                    (buffer-name elt)))
 113                                 (setq head (cons
 114                                             (cons
 115                                              (format
 116                                               "%14s   %s"
 117                                               (buffer-name elt)
 118                                               (or (buffer-file-name elt) ""))
 119                                              elt)
 120                                             head)))
 121                             (and head (> (length (car (car head))) maxlen)
 122                                  (setq maxlen (length (car (car head))))))
 123                           (setq tail (cdr tail)))
 124                         (nconc (reverse head)
 125                                (list (cons (concat (make-string (- (/ maxlen 2) 8) ?\ )
 126                                                    "List All Buffers")
 127                                            'list-buffers)))))))
 128
 129
 130     (let ((buf (x-popup-menu (if (listp event) event
 131                                (cons '(0 0) (selected-frame)))
 132                              menu))
 133           (window (and (listp event) (posn-window (event-start event)))))
 134       (if (eq buf 'list-buffers)
 135           (list-buffers)
 136         (if buf
 137             (if complex-buffers-menu-p
 138                 (let ((action (x-popup-menu (if (listp event) event
 139                                               (cons '(0 0) (selected-frame)))
 140                                             '("Buffer Action"
 141                                               (""
 142                                                ("Save Buffer" . save-buffer)
 143                                                ("Kill Buffer" . kill-buffer)
 144                                                ("Select Buffer" . switch-to-buffer))))))
 145                   (if (eq action 'save-buffer)
 146                       (save-excursion
 147                         (set-buffer buf)
 148                         (save-buffer))
 149                     (funcall action buf)))
 150               (and (windowp window)
 151                    (select-window window))
 152               (switch-to-buffer buf)))))))
 153
 154 ;; this version is too slow
 155 ;;;(defun format-buffers-menu-line (buffer)
 156 ;;;  "Returns a string to represent the given buffer in the Buffer menu.
 157 ;;;nil means the buffer shouldn't be listed.  You can redefine this."
 158 ;;;  (if (string-match "\\` " (buffer-name buffer))
 159 ;;;      nil
 160 ;;;    (save-excursion
 161 ;;;     (set-buffer buffer)
 162 ;;;     (let ((size (buffer-size)))
 163 ;;;       (format "%s%s %-19s %6s %-15s %s"
 164 ;;;            (if (buffer-modified-p) "*" " ")
 165 ;;;            (if buffer-read-only "%" " ")
 166 ;;;            (buffer-name)
 167 ;;;            size
 168 ;;;            mode-name
 169 ;;;            (or (buffer-file-name) ""))))))
 170 \f
 171 (let ((frames (frame-list)))
 172   (while frames
 173     (modify-frame-parameters (car frames) '((menu-bar-lines . 1)))
 174     (setq frames (cdr frames))))
 175 (or (assq 'menu-bar-lines default-frame-alist)
 176     (setq default-frame-alist
 177           (cons '(menu-bar-lines . 1) default-frame-alist)))