;;; menu-bar.el --- define a default menu bar.
-;; Copyright (C) 1993, 1994, 1995, 2000 Free Software Foundation, Inc.
+;; Copyright (C) 1993, 1994, 1995, 2000, 2001 Free Software Foundation, Inc.
;; Author: RMS
;; Maintainer: FSF
-;; Keywords: internal
+;; Keywords: internal, mouse
;; This file is part of GNU Emacs.
'(menu-item "--"))
(define-key menu-bar-files-menu [ps-print-region]
+ '(menu-item "Postscript Print Region (B+W)" ps-print-region
+ :enable mark-active
+ :help "Pretty-print marked region in black and white to PostScript printer"))
+(define-key menu-bar-files-menu [ps-print-buffer]
+ '(menu-item "Postscript Print Buffer (B+W)" ps-print-buffer
+ :help "Pretty-print current buffer in black and white to PostScript printer"))
+(define-key menu-bar-files-menu [ps-print-region-faces]
'(menu-item "Postscript Print Region" ps-print-region-with-faces
:enable mark-active
:help "Pretty-print marked region to PostScript printer"))
-(define-key menu-bar-files-menu [ps-print-buffer]
+(define-key menu-bar-files-menu [ps-print-buffer-faces]
'(menu-item "Postscript Print Buffer" ps-print-buffer-with-faces
:help "Pretty-print current buffer to PostScript printer"))
(define-key menu-bar-files-menu [print-region]
(define-key menu-bar-files-menu [recover-session]
'(menu-item "Recover Crashed Session..." recover-session
:enable (and auto-save-list-file-prefix
- (directory-files
+ (file-directory-p
+ (file-name-directory auto-save-list-file-prefix))
+ (directory-files
(file-name-directory auto-save-list-file-prefix)
nil
(concat "\\`"
(define-key menu-bar-files-menu [save-buffer]
'(menu-item "Save (current buffer)" save-buffer
:enable (and (buffer-modified-p)
+ (buffer-file-name)
(not (window-minibuffer-p
(frame-selected-window menu-updating-frame))))
:help "Save current buffer to its file"))
(define-key menu-bar-files-menu [kill-buffer]
'(menu-item "Close (current buffer)" kill-this-buffer
:enable (kill-this-buffer-enabled-p)
- :help "Discard contents of current buffer"))
+ :help "Discard current buffer"))
(define-key menu-bar-files-menu [insert-file]
'(menu-item "Insert File..." insert-file
:enable (not (window-minibuffer-p
:enable (and mark-active (not buffer-read-only))
:help
"Fill text in region to fit between left and right margin"))
+(define-key menu-bar-edit-menu [mark-whole-buffer]
+ '(menu-item "Select All" mark-whole-buffer
+ :help "Mark the whole buffer for a subsequent cut/copy."))
(define-key menu-bar-edit-menu [clear]
'(menu-item "Clear" delete-region
:enable (and mark-active
(not buffer-read-only)
(not (mouse-region-match)))
:help
- "Delete the text in region between mark and current pos"))
+ "Delete the text in region between mark and current position"))
(defvar yank-menu (cons "Select Yank" nil))
(fset 'yank-menu (cons 'keymap yank-menu))
(define-key menu-bar-edit-menu [select-paste]
(define-key menu-bar-edit-menu [copy]
'(menu-item "Copy" menu-bar-kill-ring-save
:enable mark-active
- :help "Copy text in region between mark and current pos"))
+ :help "Copy text in region between mark and current position"))
(define-key menu-bar-edit-menu [cut]
'(menu-item "Cut" kill-region
:enable (and mark-active (not buffer-read-only))
- :help "Cut (kill) text in region between mark and current pos"))
-(define-key menu-bar-edit-menu [mark-whole-buffer]
- '(menu-item "Mark Buffer" mark-whole-buffer
- :help "Mark the whole buffer for a subsequent cut/copy."))
+ :help
+ "Cut (kill) text in region between mark and current position"))
(define-key menu-bar-edit-menu [undo]
'(menu-item "Undo" undo
:enable (and (not buffer-read-only)
(menu-bar-make-toggle toggle-uniquify-buffer-names uniquify-buffer-name-style
"Use Directory Names in Buffer Names"
"Directory name in buffer names (uniquify) %s"
- nil
+ "Uniquify a buffer name by adding parent directory names until unique"
(require 'uniquify)
(setq uniquify-buffer-name-style
(if (not uniquify-buffer-name-style)
"Highlight Syntax (Global Font Lock)"
"Syntax Highlighting %s"
"Highlights text based on language syntax"
- global-font-lock-mode))
+ (global-font-lock-mode)))
\f
;; The "Tools" menu items
+(defun send-mail-item-name ()
+ (let* ((known-send-mail-commands '((sendmail-user-agent . "sendmail")
+ (mh-e-user-agent . "MH")
+ (message-user-agent . "Gnus Message")
+ (gnus-user-agent . "Gnus")))
+ (name (assq mail-user-agent known-send-mail-commands)))
+ (if name
+ (setq name (cdr name))
+ (setq name (symbol-name mail-user-agent))
+ (if (string-match "\\(.+\\)-user-agent" name)
+ (setq name (match-string 1 name))))
+ name))
+
+(defun read-mail-item-name ()
+ (let* ((known-rmail-commands '((rmail . "RMAIL")
+ (mh-rmail . "MH")
+ (gnus . "Gnus")))
+ (known (assq read-mail-command known-rmail-commands)))
+ (if known (cdr known) (symbol-name read-mail-command))))
+
(defvar menu-bar-games-menu (make-sparse-keymap "Games"))
(define-key menu-bar-tools-menu [games]
(define-key menu-bar-tools-menu [separator-games]
'("--"))
+(define-key menu-bar-games-menu [zone]
+ '(menu-item "Zone Out" zone
+ :help "Play tricks with Emacs display when Emacs is idle"))
(define-key menu-bar-games-menu [yow]
'(menu-item "Random Quotation" yow
:help "Display a random Zippy quotation"))
'(menu-item "Directory Search" eudc-tools-menu
:help "Query directory servers via LDAP, CCSO PH/QI or BBDB"))
(define-key menu-bar-tools-menu [compose-mail]
- '(menu-item "Send Mail" compose-mail
- :help "Send a mail message"))
+ (list
+ 'menu-item `(format "Send Mail (with %s)" (send-mail-item-name))
+ 'compose-mail
+ :visible `(and mail-user-agent (not (eq mail-user-agent 'ignore)))
+ :help "Send a mail message"))
(define-key menu-bar-tools-menu [rmail]
- '(menu-item "Read Mail" read-mail-command
- :help "Read your mail and reply to it"))
+ (list
+ 'menu-item `(format "Read Mail (with %s)" (read-mail-item-name))
+ (lambda ()
+ (interactive)
+ (call-interactively read-mail-command))
+ :visible `(and read-mail-command (not (eq read-mail-command 'ignore)))
+ :help "Read your mail and reply to it"))
(define-key menu-bar-tools-menu [gnus]
- '(menu-item "Read Net News" gnus
+ '(menu-item "Read Net News (Gnus)" gnus
:help "Read network news groups"))
(define-key menu-bar-tools-menu [separator-vc]
(define-key menu-bar-tools-menu [gdb]
'(menu-item "Debugger (GUD)..." gdb
- :help "Debug a program from withing Emacs"))
+ :help "Debug a program from within Emacs"))
(define-key menu-bar-tools-menu [shell-on-region]
'(menu-item "Shell Command on Region..." shell-command-on-region
:enable mark-active
(define-key menu-bar-help-menu [describe-distribution]
'(menu-item "Getting New Versions" describe-distribution
:help "How to get latest versions of Emacs"))
+(define-key menu-bar-help-menu [more]
+ '(menu-item "Find Extra Packages"
+ (lambda ()
+ (interactive)
+ (let (enable-local-variables)
+ (view-file (expand-file-name "MORE.STUFF"
+ data-directory))
+ (goto-address)))
+ :help "Where to find some extra packages and possible updates"))
(define-key menu-bar-help-menu [emacs-version]
'(menu-item "Show Emacs Version" emacs-version))
(define-key menu-bar-help-menu [sep2]
(list 'menu-item "Describe" menu-bar-describe-menu
:help "Describe commands, variables, keys"))
(define-key menu-bar-help-menu [manuals]
- (list 'menu-item "Manuals" menu-bar-manuals-menu))
+ (list 'menu-item "Manuals" menu-bar-manuals-menu
+ :help "Lookup commands and keys in docs, read manuals"))
(define-key menu-bar-help-menu [sep1]
'("--"))
(define-key menu-bar-help-menu [report-emacs-bug]
'(menu-item "Send Bug Report..." report-emacs-bug
:help "Send e-mail to Emacs maintainers"))
+(define-key menu-bar-help-menu [order-emacs-manuals]
+ '(menu-item "Ordering Manuals" view-order-manuals
+ :help "How to order manuals from the Free Software Foundation"))
(define-key menu-bar-help-menu [emacs-manual]
- '(menu-item "Read the Emacs manual"
+ '(menu-item "Read the Emacs Manual"
(lambda () (interactive) (info "emacs"))))
(define-key menu-bar-help-menu [emacs-problems]
'(menu-item "Emacs Known Problems" view-emacs-problems))
(defun menu-bar-select-frame ()
(interactive)
- (make-frame-visible last-command-event)
- (raise-frame last-command-event)
- (select-frame last-command-event))
+ (let (frame)
+ (dolist (f (frame-list))
+ (when (equal last-command-event (frame-parameter f 'name))
+ (setq frame f)))
+ (make-frame-visible frame)
+ (raise-frame frame)
+ (select-frame frame)))
(defun menu-bar-update-buffers-1 (elt)
(cons (format
(defvar menu-bar-buffers-menu-list-buffers-entry nil)
-(defun menu-bar-update-buffers ()
+(defun menu-bar-update-buffers (&optional force)
;; If user discards the Buffers item, play along.
(and (lookup-key (current-global-map) [menu-bar buffer])
- (frame-or-buffer-changed-p)
+ (or force (frame-or-buffer-changed-p))
(let ((buffers (buffer-list))
(frames (frame-list))
(maxlen 0)
(mapcar
(lambda (frame)
(nconc
- (list frame
- (cdr (assq 'name
- (frame-parameters frame)))
+ (list (frame-parameter frame 'name)
+ (frame-parameter frame 'name)
(cons nil nil))
'menu-bar-select-frame))
frames)))))
\f
;;; Set up a menu bar menu for the minibuffer.
-(mapcar
- (function
- (lambda (map)
- (define-key map [menu-bar minibuf]
- (cons "Minibuf" (make-sparse-keymap "Minibuf")))))
- (list minibuffer-local-ns-map
- minibuffer-local-must-match-map
- minibuffer-local-isearch-map
- minibuffer-local-map
- minibuffer-local-completion-map))
-
-(mapcar
- (function
- (lambda (map)
- (define-key map [menu-bar minibuf ?\?]
- (list 'menu-item "List Completions" 'minibuffer-completion-help
- :help "Display all possible completions"))
- (define-key map [menu-bar minibuf space]
- (list 'menu-item "Complete Word" 'minibuffer-complete-word
- :help "Complete at most one word"))
- (define-key map [menu-bar minibuf tab]
- (list 'menu-item "Complete" 'minibuffer-complete
- :help "Complete as far as possible"))
- ))
- (list minibuffer-local-must-match-map
- minibuffer-local-completion-map))
-
-(mapcar
- (function
- (lambda (map)
- (define-key map [menu-bar minibuf quit]
- (list 'menu-item "Quit" 'keyboard-escape-quit
- :help "Abort input and exit minibuffer"))
- (define-key map [menu-bar minibuf return]
- (list 'menu-item "Enter" 'exit-minibuffer
- :help "Terminate input and exit minibuffer"))
- ))
- (list minibuffer-local-ns-map
- minibuffer-local-must-match-map
- minibuffer-local-isearch-map
- minibuffer-local-map
- minibuffer-local-completion-map))
+(dolist (map (list minibuffer-local-ns-map
+ minibuffer-local-must-match-map
+ minibuffer-local-isearch-map
+ minibuffer-local-map
+ minibuffer-local-completion-map))
+ (define-key map [menu-bar minibuf]
+ (cons "Minibuf" (make-sparse-keymap "Minibuf"))))
+
+(dolist (map (list minibuffer-local-must-match-map
+ minibuffer-local-completion-map))
+ (define-key map [menu-bar minibuf ?\?]
+ (list 'menu-item "List Completions" 'minibuffer-completion-help
+ :help "Display all possible completions"))
+ (define-key map [menu-bar minibuf space]
+ (list 'menu-item "Complete Word" 'minibuffer-complete-word
+ :help "Complete at most one word"))
+ (define-key map [menu-bar minibuf tab]
+ (list 'menu-item "Complete" 'minibuffer-complete
+ :help "Complete as far as possible")))
+
+(dolist (map (list minibuffer-local-ns-map
+ minibuffer-local-must-match-map
+ minibuffer-local-isearch-map
+ minibuffer-local-map
+ minibuffer-local-completion-map))
+ (define-key map [menu-bar minibuf quit]
+ (list 'menu-item "Quit" 'keyboard-escape-quit
+ :help "Abort input and exit minibuffer"))
+ (define-key map [menu-bar minibuf return]
+ (list 'menu-item "Enter" 'exit-minibuffer
+ :help "Terminate input and exit minibuffer")))
\f
(defcustom menu-bar-mode nil
"Toggle display of a menu bar on each frame.
HCoop / bpt / emacs.git / blobdiff