[bpt/emacs.git] / lisp / menu-bar.el

;;; menu-bar.el --- define a default menu bar.

;; Author: RMS
;; Keywords: internal

;; Copyright (C) 1993, 1994 Free Software Foundation, Inc.

;; This file is part of GNU Emacs.

;; GNU Emacs is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation; either version 2, or (at your option)
;; any later version.

;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs; see the file COPYING.  If not, write to
;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.

;;; Code:

;; Don't clobber an existing menu-bar keymap, to preserve any menu-bar key
;; definitions made in loaddefs.el.
(or (lookup-key global-map [menu-bar])
    (define-key global-map [menu-bar] (make-sparse-keymap "menu-bar")))
(defvar menu-bar-help-menu (make-sparse-keymap "Help"))
;; Put Help item last.
(setq menu-bar-final-items '(help))
(define-key global-map [menu-bar help] (cons "Help" menu-bar-help-menu))
(defvar menu-bar-edit-menu (make-sparse-keymap "Edit"))
(define-key global-map [menu-bar edit] (cons "Edit" menu-bar-edit-menu))
(defvar menu-bar-file-menu (make-sparse-keymap "File"))
(define-key global-map [menu-bar file] (cons "File" menu-bar-file-menu))
\f
(defvar vc-menu-map (make-sparse-keymap "Version Control"))

(define-key menu-bar-file-menu [exit-emacs]
  '("Exit Emacs" . save-buffers-kill-emacs))

(define-key menu-bar-file-menu [separator-compare]
  '("--"))

(define-key menu-bar-file-menu [epatch]
  '("Apply Patch" . menu-bar-epatch-menu))
(define-key menu-bar-file-menu [ediff]
  '("Compare" . menu-bar-ediff-menu))
(define-key menu-bar-file-menu [emerge] '("Emerge" . menu-bar-emerge-menu))

(define-key menu-bar-file-menu [separator-misc]
  '("--"))

(define-key menu-bar-file-menu [calendar] '("Calendar" . calendar))
(define-key menu-bar-file-menu [rmail] '("Read Mail" . rmail))
(define-key menu-bar-file-menu [gnus] '("Read Net News" . gnus))

(if (fboundp 'delete-frame)
    (progn
      (define-key menu-bar-file-menu [separator-frames]
	'("--"))

      (define-key menu-bar-file-menu [delete-frame]
	'("Delete Frame" . delete-frame))
      (define-key menu-bar-file-menu [make-frame-on-display]
	'("Make Frame on Display" . make-frame-on-display))
      (define-key menu-bar-file-menu [make-frame]
	'("Make New Frame" . make-frame))))

(define-key menu-bar-file-menu [separator-buffers]
  '("--"))

(define-key menu-bar-file-menu [bookmark]
  '("Bookmarks" . menu-bar-bookmark-map))
(define-key menu-bar-file-menu [print-buffer]
  '("Print Buffer" . print-buffer))
(define-key menu-bar-file-menu [kill-buffer]
  '("Kill (Current) Buffer" . kill-this-buffer))
(define-key menu-bar-file-menu [insert-file]
  '("Insert File" . insert-file))
(define-key menu-bar-file-menu [vc-menu]
  (cons "Version Control" vc-menu-map))
(define-key menu-bar-file-menu [revert-buffer]
  '("Revert Buffer" . revert-buffer))
(define-key menu-bar-file-menu [write-file]
  '("Save Buffer As..." . write-file))
(define-key menu-bar-file-menu [save-buffer] '("Save Buffer" . save-buffer))
(define-key menu-bar-file-menu [dired] '("Open Directory..." . dired))
(define-key menu-bar-file-menu [open-file] '("Open File..." . find-file))

;; This is just one element of the ediff menu--the first.
(define-key menu-bar-ediff-menu [window]
  '("This Window And Next Window" . compare-windows))
\f
(define-key menu-bar-edit-menu [query-replace]
  '("Query Replace" . query-replace))
(define-key menu-bar-edit-menu [re-search-back]
  '("Regexp Search Backwards" . re-search-backward))
(define-key menu-bar-edit-menu [search-back]
  '("Search Backwards" . search-backward))
(define-key menu-bar-edit-menu [re-search-fwd]
  '("Regexp Search" . re-search-forward))
(define-key menu-bar-edit-menu [search-fwd]
  '("Search" . search-forward))

(define-key menu-bar-edit-menu [separator-misc]
  '("--"))

(define-key menu-bar-edit-menu [spell] '("Spell" . ispell-menu-map))
(define-key menu-bar-edit-menu [fill] '("Fill" . fill-region))

(define-key menu-bar-edit-menu [separator-edit]
  '("--"))

(define-key menu-bar-edit-menu [clear] '("Clear" . delete-region))

(define-key menu-bar-edit-menu [paste] '("Paste most recent" . yank))

(defvar yank-menu (cons "Select Yank" nil))
(fset 'yank-menu (cons 'keymap yank-menu))
(define-key menu-bar-edit-menu [select-paste] '("Select and Paste" . yank-menu))
(define-key menu-bar-edit-menu [copy] '("Copy" . menu-bar-kill-ring-save))
(define-key menu-bar-edit-menu [cut] '("Cut" . kill-region))
(define-key menu-bar-edit-menu [undo] '("Undo" . undo))

(defun menu-bar-kill-ring-save (beg end)
  (interactive "r")
  (if (mouse-region-match)
      (message "Select a region with the mouse does `copy' automatically")
    (kill-ring-save beg end)))

(put 'fill-region 'menu-enable 'mark-active)
(put 'kill-region 'menu-enable 'mark-active)
(put 'menu-bar-kill-ring-save 'menu-enable 'mark-active)
(put 'yank 'menu-enable '(x-selection-exists-p))
(put 'yank-menu 'menu-enable '(cdr yank-menu))
(put 'delete-region 'menu-enable '(and mark-active
				       (not (mouse-region-match))))
(put 'undo 'menu-enable '(if (eq last-command 'undo)
			     pending-undo-list
			   (consp buffer-undo-list)))
(put 'query-replace 'menu-enable '(not buffer-read-only))

(autoload 'ispell-menu-map "ispell" nil t 'keymap)

;; These are alternative definitions for the cut, paste and copy
;; menu items.  Use them if your system expects these to use the clipboard.

(put 'clipboard-kill-region 'menu-enable 'mark-active)
(put 'clipboard-kill-ring-save 'menu-enable 'mark-active)
(put 'clipboard-yank 'menu-enable
     '(or (x-selection-exists-p) (x-selection-exists-p 'CLIPBOARD)))

(defun clipboard-yank ()
  "Reinsert the last stretch of killed text, or the clipboard contents."
  (interactive)
  (let ((x-select-enable-clipboard t))
    (yank)))

(defun clipboard-kill-ring-save (beg end)
  "Copy region to kill ring, and save in the X clipboard."
  (interactive "r")
  (let ((x-select-enable-clipboard t))
    (kill-ring-save beg end)))

(defun clipboard-kill-region (beg end)
  "Kill the region, and save it in the X clipboard."
  (interactive "r")
  (let ((x-select-enable-clipboard t))
    (kill-region beg end)))

(defun menu-bar-enable-clipboard ()
  "Make CUT, PASTE and COPY (keys and menu bar items) use the clipboard.
Do the same for the keys of the same name."
  (interactive)
  ;; We can't use constant list structure here because it becomes pure,
  ;; and because it gets modified with cache data.
  (define-key menu-bar-edit-menu [paste]
    (cons "Paste" 'clipboard-yank))
  (define-key menu-bar-edit-menu [copy]
    (cons "Copy" 'clipboard-kill-ring-save))
  (define-key menu-bar-edit-menu [cut]
    (cons "Cut" 'clipboard-kill-region))

  (define-key global-map [f20] 'clipboard-kill-region)
  (define-key global-map [f16] 'clipboard-kill-ring-save)
  (define-key global-map [f18] 'clipboard-yank)
  ;; X11R6 versions
  (define-key global-map [cut] 'clipboard-kill-region)
  (define-key global-map [copy] 'clipboard-kill-ring-save)
  (define-key global-map [paste] 'clipboard-yank))
\f
(define-key menu-bar-help-menu [emacs-version]
  '("Show Version" . emacs-version))
(define-key menu-bar-help-menu [report-emacs-bug]
  '("Send Bug Report" . report-emacs-bug))
(define-key menu-bar-help-menu [emacs-tutorial]
  '("Emacs Tutorial" . help-with-tutorial))
(define-key menu-bar-help-menu [man] '("Man..." . manual-entry))
(define-key menu-bar-help-menu [describe-variable]
  '("Describe Variable..." . describe-variable))
(define-key menu-bar-help-menu [describe-function]
  '("Describe Function..." . describe-function))
(define-key menu-bar-help-menu [describe-key]
  '("Describe Key..." . describe-key))
(define-key menu-bar-help-menu [list-keybindings]
  '("List Keybindings" . describe-bindings))
(define-key menu-bar-help-menu [command-apropos]
  '("Command Apropos..." . command-apropos))
(define-key menu-bar-help-menu [describe-mode]
  '("Describe Mode" . describe-mode))
(define-key menu-bar-help-menu [info] '("Info" . info))

(define-key menu-bar-help-menu [emacs-news] '("Emacs News" . view-emacs-news))
(defun kill-this-buffer ()	; for the menubar
  "Kills the current buffer."
  (interactive)
  (kill-buffer (current-buffer)))

(defun kill-this-buffer-enabled-p ()
  (let ((count 0)
	(buffers (buffer-list)))
    (while buffers
      (or (string-match "^ " (buffer-name (car buffers)))
	  (setq count (1+ count)))
      (setq buffers (cdr buffers)))
    (> count 1)))

(put 'save-buffer 'menu-enable '(buffer-modified-p))
(put 'revert-buffer 'menu-enable
     '(or revert-buffer-function revert-buffer-insert-file-contents-function
	  (and (buffer-file-name)
	       (or (buffer-modified-p)
		   (not (verify-visited-file-modtime (current-buffer)))))))
;; Permit deleting frame if it would leave a visible or iconified frame.
(put 'delete-frame 'menu-enable
     '(let ((frames (frame-list))
	    (count 0))
	(while frames
	  (if (cdr (assq 'visibility (frame-parameters (car frames))))
	      (setq count (1+ count)))
	  (setq frames (cdr frames)))
	(> count 1)))
(put 'kill-this-buffer 'menu-enable '(kill-this-buffer-enabled-p))

(put 'advertised-undo 'menu-enable
     '(and (not (eq t buffer-undo-list))
	   (if (eq last-command 'undo)
	       (and (boundp 'pending-undo-list)
		    pending-undo-list)
	     buffer-undo-list)))

(defvar yank-menu-length 20
  "*Maximum length to display in the yank-menu.")

(defun menu-bar-update-yank-menu (string old)
  (let ((front (car (cdr yank-menu)))
	(menu-string (if (<= (length string) yank-menu-length)
			 string
		       (concat
			(substring string 0 (/ yank-menu-length 2))
			"..."
			(substring string (- (/ yank-menu-length 2)))))))
    ;; If we're supposed to be extending an existing string, and that
    ;; string really is at the front of the menu, then update it in place.
    (if (and old (or (eq old (car front))
		     (string= old (car front))))
	(progn
	  (setcar front string)
	  (setcar (cdr front) menu-string))
      (setcdr yank-menu
	      (cons
	       (cons string (cons menu-string 'menu-bar-select-yank))
	       (cdr yank-menu)))))
  (if (> (length (cdr yank-menu)) kill-ring-max)
      (setcdr (nthcdr kill-ring-max yank-menu) nil)))

(defun menu-bar-select-yank ()
  (interactive "*")
  (push-mark (point))
  (insert last-command-event))
\f
(define-key global-map [menu-bar buffer] '("Buffers" . menu-bar-buffers))

(defalias 'menu-bar-buffers (make-sparse-keymap "Buffers"))

(defvar buffers-menu-max-size 10
  "*Maximum number of entries which may appear on the Buffers menu.
If this is 10, then only the ten most-recently-selected buffers are shown.
If this is nil, then all buffers are shown.
A large number or nil slows down menu responsiveness.")

(defvar list-buffers-directory nil)

(defvar menu-bar-update-buffers-maxbuf)

(defun menu-bar-select-buffer ()
  (interactive)
  (switch-to-buffer last-command-event))

(defun menu-bar-select-frame ()
  (interactive)
  (make-frame-visible last-command-event)
  (raise-frame last-command-event)
  (select-frame last-command-event))

(defun menu-bar-update-buffers-1 (elt)
  (cons (format
	 (format "%%%ds  %%s%%s  %%s" menu-bar-update-buffers-maxbuf)
	 (cdr elt)
	 (if (buffer-modified-p (car elt))
	     "*" " ")
	 (save-excursion
	   (set-buffer (car elt))
	   (if buffer-read-only "%" " "))
	 (let ((file
		(or (buffer-file-name (car elt))
		    (save-excursion
		      (set-buffer (car elt))
		      list-buffers-directory)
		    "")))
	   (setq file (or (file-name-directory file)
			  ""))
	   (if (> (length file) 20)
	       (setq file (concat "..." (substring file -17))))
	   file))
	(car elt)))

(defun menu-bar-update-buffers ()
  ;; If user discards the Buffers item, play along.
  (and (lookup-key (current-global-map) [menu-bar buffer])
       (frame-or-buffer-changed-p)
       (let ((buffers (buffer-list))
	     (frames (frame-list))
	     buffers-menu frames-menu)
	 ;; If requested, list only the N most recently selected buffers.
	 (if (and (integerp buffers-menu-max-size)
		  (> buffers-menu-max-size 1))
	     (if (> (length buffers) buffers-menu-max-size)
		 (setcdr (nthcdr buffers-menu-max-size buffers) nil)))

	 ;; Make the menu of buffers proper.
	 (setq buffers-menu
	       (cons "Select Buffer"
		     (let* ((buffer-list
			     (mapcar 'list buffers))
			    tail
			    (menu-bar-update-buffers-maxbuf 0)
			    (maxlen 0)
			    alist
			    head)
		       ;; Put into each element of buffer-list
		       ;; the name for actual display,
		       ;; perhaps truncated in the middle.
		       (setq tail buffer-list)
		       (while tail
			 (let ((name (buffer-name (car (car tail)))))
			   (setcdr (car tail)
				   (if (> (length name) 27)
				       (concat (substring name 0 12)
					       "..."
					       (substring name -12))
				     name)))
			 (setq tail (cdr tail)))
		       ;; Compute the maximum length of any name.
		       (setq tail buffer-list)
		       (while tail
			 (or (eq ?\ (aref (cdr (car tail)) 0))
			     (setq menu-bar-update-buffers-maxbuf
				   (max menu-bar-update-buffers-maxbuf
					(length (cdr (car tail))))))
			 (setq tail (cdr tail)))
		       ;; Set ALIST to an alist of the form
		       ;; ITEM-STRING . BUFFER
		       (setq tail buffer-list)
		       (while tail
			 (let ((elt (car tail)))
			   (or (eq ?\ (aref (cdr elt) 0))
			       (setq alist (cons
					    (menu-bar-update-buffers-1 elt)
					    alist)))
			   (and alist (> (length (car (car alist))) maxlen)
				(setq maxlen (length (car (car alist))))))
			 (setq tail (cdr tail)))
		       (setq alist (nreverse alist))
		       (nconc (mapcar '(lambda (pair)
					 ;; This is somewhat risque, to use
					 ;; the buffer name itself as the event
					 ;; type to define, but it works.
					 ;; It would not work to use the buffer
					 ;; since a buffer as an event has its
					 ;; own meaning.
					 (nconc (list (buffer-name (cdr pair))
						      (car pair)
						      (cons nil nil))
						'menu-bar-select-buffer))
				      alist)
			      (list
			       (cons
				'list-buffers
				(cons
				 (concat (make-string (max (- (/ maxlen 2) 8) 0)
						      ?\ )
					 "List All Buffers")
				 'list-buffers)))))))


	 ;; Make a Frames menu if we have more than one frame.
	 (if (cdr frames)
	     (setq frames-menu
		   (cons "Select Frame"
			 (mapcar '(lambda (frame)
				    (nconc (list frame
						 (cdr (assq 'name
							    (frame-parameters frame)))
						 (cons nil nil))
					   'menu-bar-select-frame))
				 frames))))
	 (if buffers-menu
	     (setq buffers-menu (cons 'keymap buffers-menu)))
	 (if frames-menu
	     (setq frames-menu (cons 'keymap frames-menu)))
	 (define-key (current-global-map) [menu-bar buffer]
	   (cons "Buffers"
		 (if (and buffers-menu frames-menu)
		     (list 'keymap "Buffers and Frames"
			   (cons 'buffers (cons "Buffers" buffers-menu))
			   (cons 'frames (cons "Frames" frames-menu)))
		   (or buffers-menu frames-menu 'undefined)))))))

(add-hook 'menu-bar-update-hook 'menu-bar-update-buffers)

;; this version is too slow
;;;(defun format-buffers-menu-line (buffer)
;;;  "Returns a string to represent the given buffer in the Buffer menu.
;;;nil means the buffer shouldn't be listed.  You can redefine this."
;;;  (if (string-match "\\` " (buffer-name buffer))
;;;      nil
;;;    (save-excursion
;;;     (set-buffer buffer)
;;;     (let ((size (buffer-size)))
;;;       (format "%s%s %-19s %6s %-15s %s"
;;;	       (if (buffer-modified-p) "*" " ")
;;;	       (if buffer-read-only "%" " ")
;;;	       (buffer-name)
;;;	       size
;;;	       mode-name
;;;	       (or (buffer-file-name) ""))))))
\f
(defvar menu-bar-mode nil)

(defun menu-bar-mode (flag)
  "Toggle display of a menu bar on each frame.
This command applies to all frames that exist and frames to be
created in the future.
With a numeric argument, if the argument is negative,
turn off menu bars; otherwise, turn on menu bars."
 (interactive "P")

  ;; Make menu-bar-mode and default-frame-alist consistent.
  (let ((default (assq 'menu-bar-lines default-frame-alist)))
    (if default
	(setq menu-bar-mode (not (eq (cdr default) 0)))
      (setq default-frame-alist
	    (cons (cons 'menu-bar-lines (if menu-bar-mode 1 0))
		  default-frame-alist))))

  ;; Toggle or set the mode, according to FLAG.
 (setq menu-bar-mode (if (null flag) (not menu-bar-mode)
		       (> (prefix-numeric-value flag) 0)))

 ;; Apply it to default-frame-alist.
 (let ((parameter (assq 'menu-bar-lines default-frame-alist)))
   (if (consp parameter)
       (setcdr parameter (if menu-bar-mode 1 0))
     (setq default-frame-alist
	   (cons (cons 'menu-bar-lines (if menu-bar-mode 1 0))
		 default-frame-alist))))

 ;; Apply it to existing frames.
 (let ((frames (frame-list)))
   (while frames
     (let ((height (cdr (assq 'height (frame-parameters (car frames))))))
       (modify-frame-parameters (car frames)
				(list (cons 'menu-bar-lines
					  (if menu-bar-mode 1 0))))
       (modify-frame-parameters (car frames)
				(list (cons 'height height))))
     (setq frames (cdr frames)))))

(provide 'menu-bar)

;;; menu-bar.el ends here
Commit	Line	Data
235aa29b ER	1	;;; menu-bar.el --- define a default menu bar.
	2
	3	;; Author: RMS
b7f66977	4	;; Keywords: internal
235aa29b	5
03dcd202	6	;; Copyright (C) 1993, 1994 Free Software Foundation, Inc.
1db87953 RS	7
	8	;; This file is part of GNU Emacs.
	9
	10	;; GNU Emacs is free software; you can redistribute it and/or modify
	11	;; it under the terms of the GNU General Public License as published by
	12	;; the Free Software Foundation; either version 2, or (at your option)
	13	;; any later version.
	14
	15	;; GNU Emacs is distributed in the hope that it will be useful,
	16	;; but WITHOUT ANY WARRANTY; without even the implied warranty of
	17	;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
	18	;; GNU General Public License for more details.
	19
	20	;; You should have received a copy of the GNU General Public License
	21	;; along with GNU Emacs; see the file COPYING. If not, write to
	22	;; the Free Software Foundation, 675 Mass Ave, Cambridge, MA 02139, USA.
	23
235aa29b	24	;;; Code:
1db87953	25
b132f2b1 RM	26	;; Don't clobber an existing menu-bar keymap, to preserve any menu-bar key
	27	;; definitions made in loaddefs.el.
	28	(or (lookup-key global-map [menu-bar])
	29	(define-key global-map [menu-bar] (make-sparse-keymap "menu-bar")))
22390f50	30	(defvar menu-bar-help-menu (make-sparse-keymap "Help"))
da183f87 RS	31	;; Put Help item last.
	32	(setq menu-bar-final-items '(help))
	33	(define-key global-map [menu-bar help] (cons "Help" menu-bar-help-menu))
22390f50	34	(defvar menu-bar-edit-menu (make-sparse-keymap "Edit"))
40954111	35	(define-key global-map [menu-bar edit] (cons "Edit" menu-bar-edit-menu))
22390f50	36	(defvar menu-bar-file-menu (make-sparse-keymap "File"))
40954111	37	(define-key global-map [menu-bar file] (cons "File" menu-bar-file-menu))
9bb8e471	38	\f
9dcdc43d RS	39	(defvar vc-menu-map (make-sparse-keymap "Version Control"))
9dcdc43d RS	40
ca9b40a1	41	(define-key menu-bar-file-menu [exit-emacs]
db774a16	42	'("Exit Emacs" . save-buffers-kill-emacs))
9bb8e471 RS	43
	44	(define-key menu-bar-file-menu [separator-compare]
	45	'("--"))
	46
080ac1ac RS	47	(define-key menu-bar-file-menu [epatch]
	48	'("Apply Patch" . menu-bar-epatch-menu))
	49	(define-key menu-bar-file-menu [ediff]
40a8cde1	50	'("Compare" . menu-bar-ediff-menu))
966bcddd	51	(define-key menu-bar-file-menu [emerge] '("Emerge" . menu-bar-emerge-menu))
9bb8e471 RS	52
	53	(define-key menu-bar-file-menu [separator-misc]
	54	'("--"))
	55
661b05a7 RS	56	(define-key menu-bar-file-menu [calendar] '("Calendar" . calendar))
	57	(define-key menu-bar-file-menu [rmail] '("Read Mail" . rmail))
	58	(define-key menu-bar-file-menu [gnus] '("Read Net News" . gnus))
9bb8e471	59
ca1a9692 RS	60	(if (fboundp 'delete-frame)
	61	(progn
	62	(define-key menu-bar-file-menu [separator-frames]
	63	'("--"))
	64
	65	(define-key menu-bar-file-menu [delete-frame]
	66	'("Delete Frame" . delete-frame))
08e8171f RS	67	(define-key menu-bar-file-menu [make-frame-on-display]
08e8171f RS	68	'("Make Frame on Display" . make-frame-on-display))
ca1a9692 RS	69	(define-key menu-bar-file-menu [make-frame]
ca1a9692 RS	70	'("Make New Frame" . make-frame))))
9bb8e471 RS	71
	72	(define-key menu-bar-file-menu [separator-buffers]
	73	'("--"))
	74
9d441895	75	(define-key menu-bar-file-menu [bookmark]
966bcddd	76	'("Bookmarks" . menu-bar-bookmark-map))
9bb8e471 RS	77	(define-key menu-bar-file-menu [print-buffer]
	78	'("Print Buffer" . print-buffer))
	79	(define-key menu-bar-file-menu [kill-buffer]
b85fdafb	80	'("Kill (Current) Buffer" . kill-this-buffer))
df4d8e01 RS	81	(define-key menu-bar-file-menu [insert-file]
df4d8e01 RS	82	'("Insert File" . insert-file))
9dcdc43d RS	83	(define-key menu-bar-file-menu [vc-menu]
9dcdc43d RS	84	(cons "Version Control" vc-menu-map))
2f1139a4 RS	85	(define-key menu-bar-file-menu [revert-buffer]
	86	'("Revert Buffer" . revert-buffer))
	87	(define-key menu-bar-file-menu [write-file]
	88	'("Save Buffer As..." . write-file))
	89	(define-key menu-bar-file-menu [save-buffer] '("Save Buffer" . save-buffer))
76202b57	90	(define-key menu-bar-file-menu [dired] '("Open Directory..." . dired))
2f1139a4	91	(define-key menu-bar-file-menu [open-file] '("Open File..." . find-file))
40a8cde1 RS	92
	93	;; This is just one element of the ediff menu--the first.
	94	(define-key menu-bar-ediff-menu [window]
	95	'("This Window And Next Window" . compare-windows))
9bb8e471	96	\f
33aa8946 RS	97	(define-key menu-bar-edit-menu [query-replace]
33aa8946 RS	98	'("Query Replace" . query-replace))
50d195ee RS	99	(define-key menu-bar-edit-menu [re-search-back]
	100	'("Regexp Search Backwards" . re-search-backward))
	101	(define-key menu-bar-edit-menu [search-back]
	102	'("Search Backwards" . search-backward))
	103	(define-key menu-bar-edit-menu [re-search-fwd]
	104	'("Regexp Search" . re-search-forward))
	105	(define-key menu-bar-edit-menu [search-fwd]
	106	'("Search" . search-forward))
9bb8e471 RS	107
	108	(define-key menu-bar-edit-menu [separator-misc]
	109	'("--"))
	110
	111	(define-key menu-bar-edit-menu [spell] '("Spell" . ispell-menu-map))
	112	(define-key menu-bar-edit-menu [fill] '("Fill" . fill-region))
	113
	114	(define-key menu-bar-edit-menu [separator-edit]
	115	'("--"))
	116
	117	(define-key menu-bar-edit-menu [clear] '("Clear" . delete-region))
3dd92899 KH	118
	119	(define-key menu-bar-edit-menu [paste] '("Paste most recent" . yank))
	120
	121	(defvar yank-menu (cons "Select Yank" nil))
	122	(fset 'yank-menu (cons 'keymap yank-menu))
	123	(define-key menu-bar-edit-menu [select-paste] '("Select and Paste" . yank-menu))
4c0317b1	124	(define-key menu-bar-edit-menu [copy] '("Copy" . menu-bar-kill-ring-save))
057d49d1 RS	125	(define-key menu-bar-edit-menu [cut] '("Cut" . kill-region))
	126	(define-key menu-bar-edit-menu [undo] '("Undo" . undo))
	127
4c0317b1 RS	128	(defun menu-bar-kill-ring-save (beg end)
	129	(interactive "r")
	130	(if (mouse-region-match)
	131	(message "Select a region with the mouse does `copy' automatically")
	132	(kill-ring-save beg end)))
	133
057d49d1 RS	134	(put 'fill-region 'menu-enable 'mark-active)
057d49d1 RS	135	(put 'kill-region 'menu-enable 'mark-active)
4c0317b1	136	(put 'menu-bar-kill-ring-save 'menu-enable 'mark-active)
057d49d1	137	(put 'yank 'menu-enable '(x-selection-exists-p))
3dd92899	138	(put 'yank-menu 'menu-enable '(cdr yank-menu))
4c0317b1 RS	139	(put 'delete-region 'menu-enable '(and mark-active
4c0317b1 RS	140	(not (mouse-region-match))))
057d49d1 RS	141	(put 'undo 'menu-enable '(if (eq last-command 'undo)
	142	pending-undo-list
	143	(consp buffer-undo-list)))
3a841b0b	144	(put 'query-replace 'menu-enable '(not buffer-read-only))
db774a16	145
9e18f0a0 RS	146	(autoload 'ispell-menu-map "ispell" nil t 'keymap)
9e18f0a0 RS	147
f9cf0be2	148	;; These are alternative definitions for the cut, paste and copy
4c0317b1	149	;; menu items. Use them if your system expects these to use the clipboard.
f9cf0be2	150
f9cf0be2 RS	151	(put 'clipboard-kill-region 'menu-enable 'mark-active)
	152	(put 'clipboard-kill-ring-save 'menu-enable 'mark-active)
	153	(put 'clipboard-yank 'menu-enable
	154	'(or (x-selection-exists-p) (x-selection-exists-p 'CLIPBOARD)))
	155
	156	(defun clipboard-yank ()
	157	"Reinsert the last stretch of killed text, or the clipboard contents."
	158	(interactive)
	159	(let ((x-select-enable-clipboard t))
	160	(yank)))
	161
	162	(defun clipboard-kill-ring-save (beg end)
	163	"Copy region to kill ring, and save in the X clipboard."
	164	(interactive "r")
	165	(let ((x-select-enable-clipboard t))
	166	(kill-ring-save beg end)))
	167
	168	(defun clipboard-kill-region (beg end)
	169	"Kill the region, and save it in the X clipboard."
	170	(interactive "r")
	171	(let ((x-select-enable-clipboard t))
	172	(kill-region beg end)))
	173
	174	(defun menu-bar-enable-clipboard ()
5cbdeb30 RS	175	"Make CUT, PASTE and COPY (keys and menu bar items) use the clipboard.
5cbdeb30 RS	176	Do the same for the keys of the same name."
f9cf0be2	177	(interactive)
5754d7f2 RS	178	;; We can't use constant list structure here because it becomes pure,
	179	;; and because it gets modified with cache data.
	180	(define-key menu-bar-edit-menu [paste]
	181	(cons "Paste" 'clipboard-yank))
	182	(define-key menu-bar-edit-menu [copy]
	183	(cons "Copy" 'clipboard-kill-ring-save))
	184	(define-key menu-bar-edit-menu [cut]
5cbdeb30 RS	185	(cons "Cut" 'clipboard-kill-region))
	186
	187	(define-key global-map [f20] 'clipboard-kill-region)
	188	(define-key global-map [f16] 'clipboard-kill-ring-save)
	189	(define-key global-map [f18] 'clipboard-yank)
	190	;; X11R6 versions
	191	(define-key global-map [cut] 'clipboard-kill-region)
	192	(define-key global-map [copy] 'clipboard-kill-ring-save)
	193	(define-key global-map [paste] 'clipboard-yank))
f9cf0be2	194	\f
efb166ff RS	195	(define-key menu-bar-help-menu [emacs-version]
efb166ff RS	196	'("Show Version" . emacs-version))
48433a65 RS	197	(define-key menu-bar-help-menu [report-emacs-bug]
48433a65 RS	198	'("Send Bug Report" . report-emacs-bug))
ca9b40a1	199	(define-key menu-bar-help-menu [emacs-tutorial]
db774a16	200	'("Emacs Tutorial" . help-with-tutorial))
2f1139a4 RS	201	(define-key menu-bar-help-menu [man] '("Man..." . manual-entry))
	202	(define-key menu-bar-help-menu [describe-variable]
	203	'("Describe Variable..." . describe-variable))
	204	(define-key menu-bar-help-menu [describe-function]
	205	'("Describe Function..." . describe-function))
	206	(define-key menu-bar-help-menu [describe-key]
	207	'("Describe Key..." . describe-key))
	208	(define-key menu-bar-help-menu [list-keybindings]
	209	'("List Keybindings" . describe-bindings))
	210	(define-key menu-bar-help-menu [command-apropos]
	211	'("Command Apropos..." . command-apropos))
	212	(define-key menu-bar-help-menu [describe-mode]
	213	'("Describe Mode" . describe-mode))
	214	(define-key menu-bar-help-menu [info] '("Info" . info))
db774a16	215
2f1139a4	216	(define-key menu-bar-help-menu [emacs-news] '("Emacs News" . view-emacs-news))
db774a16 RS	217	(defun kill-this-buffer () ; for the menubar
	218	"Kills the current buffer."
	219	(interactive)
	220	(kill-buffer (current-buffer)))
	221
2f1139a4 RS	222	(defun kill-this-buffer-enabled-p ()
	223	(let ((count 0)
	224	(buffers (buffer-list)))
	225	(while buffers
	226	(or (string-match "^ " (buffer-name (car buffers)))
	227	(setq count (1+ count)))
	228	(setq buffers (cdr buffers)))
	229	(> count 1)))
	230
db774a16	231	(put 'save-buffer 'menu-enable '(buffer-modified-p))
da183f87 RS	232	(put 'revert-buffer 'menu-enable
	233	'(or revert-buffer-function revert-buffer-insert-file-contents-function
	234	(and (buffer-file-name)
660fa562 RM	235	(or (buffer-modified-p)
660fa562 RM	236	(not (verify-visited-file-modtime (current-buffer)))))))
a0213a97 RS	237	;; Permit deleting frame if it would leave a visible or iconified frame.
	238	(put 'delete-frame 'menu-enable
	239	'(let ((frames (frame-list))
	240	(count 0))
	241	(while frames
	242	(if (cdr (assq 'visibility (frame-parameters (car frames))))
	243	(setq count (1+ count)))
	244	(setq frames (cdr frames)))
	245	(> count 1)))
2f1139a4 RS	246	(put 'kill-this-buffer 'menu-enable '(kill-this-buffer-enabled-p))
2f1139a4 RS	247
db774a16 RS	248	(put 'advertised-undo 'menu-enable
	249	'(and (not (eq t buffer-undo-list))
	250	(if (eq last-command 'undo)
2f1139a4 RS	251	(and (boundp 'pending-undo-list)
	252	pending-undo-list)
	253	buffer-undo-list)))
2877eac2	254
c3e1d435	255	(defvar yank-menu-length 20
3dd92899 KH	256	"*Maximum length to display in the yank-menu.")
	257
	258	(defun menu-bar-update-yank-menu (string old)
	259	(let ((front (car (cdr yank-menu)))
	260	(menu-string (if (<= (length string) yank-menu-length)
	261	string
c3e1d435 RS	262	(concat
	263	(substring string 0 (/ yank-menu-length 2))
	264	"..."
	265	(substring string (- (/ yank-menu-length 2)))))))
3dd92899 KH	266	;; If we're supposed to be extending an existing string, and that
	267	;; string really is at the front of the menu, then update it in place.
	268	(if (and old (or (eq old (car front))
	269	(string= old (car front))))
dfabc98f	270	(progn
3dd92899 KH	271	(setcar front string)
	272	(setcar (cdr front) menu-string))
	273	(setcdr yank-menu
	274	(cons
	275	(cons string (cons menu-string 'menu-bar-select-yank))
	276	(cdr yank-menu)))))
	277	(if (> (length (cdr yank-menu)) kill-ring-max)
	278	(setcdr (nthcdr kill-ring-max yank-menu) nil)))
	279
	280	(defun menu-bar-select-yank ()
	281	(interactive "*")
	282	(push-mark (point))
	283	(insert last-command-event))
40954111	284	\f
09642d97 RS	285	(define-key global-map [menu-bar buffer] '("Buffers" . menu-bar-buffers))
	286
	287	(defalias 'menu-bar-buffers (make-sparse-keymap "Buffers"))
40954111	288
40954111 RS	289	(defvar buffers-menu-max-size 10
	290	"*Maximum number of entries which may appear on the Buffers menu.
	291	If this is 10, then only the ten most-recently-selected buffers are shown.
	292	If this is nil, then all buffers are shown.
	293	A large number or nil slows down menu responsiveness.")
	294
d0690d12 RS	295	(defvar list-buffers-directory nil)
d0690d12 RS	296
08e8171f RS	297	(defvar menu-bar-update-buffers-maxbuf)
08e8171f RS	298
09642d97 RS	299	(defun menu-bar-select-buffer ()
	300	(interactive)
	301	(switch-to-buffer last-command-event))
	302
	303	(defun menu-bar-select-frame ()
	304	(interactive)
	305	(make-frame-visible last-command-event)
	306	(raise-frame last-command-event)
	307	(select-frame last-command-event))
	308
c171b42f RS	309	(defun menu-bar-update-buffers-1 (elt)
c171b42f RS	310	(cons (format
08e8171f	311	(format "%%%ds %%s%%s %%s" menu-bar-update-buffers-maxbuf)
c171b42f RS	312	(cdr elt)
	313	(if (buffer-modified-p (car elt))
	314	"*" " ")
	315	(save-excursion
	316	(set-buffer (car elt))
	317	(if buffer-read-only "%" " "))
	318	(let ((file
	319	(or (buffer-file-name (car elt))
	320	(save-excursion
	321	(set-buffer (car elt))
	322	list-buffers-directory)
	323	"")))
	324	(setq file (or (file-name-directory file)
	325	""))
	326	(if (> (length file) 20)
	327	(setq file (concat "..." (substring file -17))))
	328	file))
	329	(car elt)))
	330
09642d97	331	(defun menu-bar-update-buffers ()
29397c58	332	;; If user discards the Buffers item, play along.
4d587a6c	333	(and (lookup-key (current-global-map) [menu-bar buffer])
29397c58 RS	334	(frame-or-buffer-changed-p)
	335	(let ((buffers (buffer-list))
	336	(frames (frame-list))
	337	buffers-menu frames-menu)
	338	;; If requested, list only the N most recently selected buffers.
	339	(if (and (integerp buffers-menu-max-size)
	340	(> buffers-menu-max-size 1))
	341	(if (> (length buffers) buffers-menu-max-size)
	342	(setcdr (nthcdr buffers-menu-max-size buffers) nil)))
	343
	344	;; Make the menu of buffers proper.
	345	(setq buffers-menu
	346	(cons "Select Buffer"
c171b42f RS	347	(let* ((buffer-list
	348	(mapcar 'list buffers))
	349	tail
08e8171f	350	(menu-bar-update-buffers-maxbuf 0)
c171b42f RS	351	(maxlen 0)
	352	alist
	353	head)
	354	;; Put into each element of buffer-list
	355	;; the name for actual display,
	356	;; perhaps truncated in the middle.
	357	(setq tail buffer-list)
	358	(while tail
	359	(let ((name (buffer-name (car (car tail)))))
	360	(setcdr (car tail)
	361	(if (> (length name) 27)
	362	(concat (substring name 0 12)
	363	"..."
	364	(substring name -12))
	365	name)))
	366	(setq tail (cdr tail)))
	367	;; Compute the maximum length of any name.
	368	(setq tail buffer-list)
29397c58	369	(while tail
c171b42f	370	(or (eq ?\ (aref (cdr (car tail)) 0))
08e8171f RS	371	(setq menu-bar-update-buffers-maxbuf
08e8171f RS	372	(max menu-bar-update-buffers-maxbuf
c171b42f	373	(length (cdr (car tail))))))
29397c58	374	(setq tail (cdr tail)))
c171b42f RS	375	;; Set ALIST to an alist of the form
	376	;; ITEM-STRING . BUFFER
	377	(setq tail buffer-list)
29397c58 RS	378	(while tail
29397c58 RS	379	(let ((elt (car tail)))
c171b42f	380	(or (eq ?\ (aref (cdr elt) 0))
29397c58	381	(setq alist (cons
c171b42f	382	(menu-bar-update-buffers-1 elt)
29397c58 RS	383	alist)))
	384	(and alist (> (length (car (car alist))) maxlen)
	385	(setq maxlen (length (car (car alist))))))
	386	(setq tail (cdr tail)))
	387	(setq alist (nreverse alist))
	388	(nconc (mapcar '(lambda (pair)
	389	;; This is somewhat risque, to use
	390	;; the buffer name itself as the event
	391	;; type to define, but it works.
	392	;; It would not work to use the buffer
	393	;; since a buffer as an event has its
	394	;; own meaning.
	395	(nconc (list (buffer-name (cdr pair))
	396	(car pair)
	397	(cons nil nil))
	398	'menu-bar-select-buffer))
	399	alist)
	400	(list
096ec7e7	401	(cons
29397c58 RS	402	'list-buffers
	403	(cons
	404	(concat (make-string (max (- (/ maxlen 2) 8) 0)
	405	?\ )
	406	"List All Buffers")
	407	'list-buffers)))))))
	408
	409
	410	;; Make a Frames menu if we have more than one frame.
	411	(if (cdr frames)
	412	(setq frames-menu
	413	(cons "Select Frame"
	414	(mapcar '(lambda (frame)
	415	(nconc (list frame
	416	(cdr (assq 'name
	417	(frame-parameters frame)))
	418	(cons nil nil))
	419	'menu-bar-select-frame))
	420	frames))))
	421	(if buffers-menu
	422	(setq buffers-menu (cons 'keymap buffers-menu)))
	423	(if frames-menu
	424	(setq frames-menu (cons 'keymap frames-menu)))
4d587a6c	425	(define-key (current-global-map) [menu-bar buffer]
29397c58 RS	426	(cons "Buffers"
	427	(if (and buffers-menu frames-menu)
	428	(list 'keymap "Buffers and Frames"
	429	(cons 'buffers (cons "Buffers" buffers-menu))
	430	(cons 'frames (cons "Frames" frames-menu)))
	431	(or buffers-menu frames-menu 'undefined)))))))
09642d97 RS	432
09642d97 RS	433	(add-hook 'menu-bar-update-hook 'menu-bar-update-buffers)
2f1139a4	434
40954111 RS	435	;; this version is too slow
	436	;;;(defun format-buffers-menu-line (buffer)
	437	;;; "Returns a string to represent the given buffer in the Buffer menu.
	438	;;;nil means the buffer shouldn't be listed. You can redefine this."
	439	;;; (if (string-match "\\` " (buffer-name buffer))
	440	;;; nil
	441	;;; (save-excursion
	442	;;; (set-buffer buffer)
	443	;;; (let ((size (buffer-size)))
	444	;;; (format "%s%s %-19s %6s %-15s %s"
	445	;;; (if (buffer-modified-p) "*" " ")
	446	;;; (if buffer-read-only "%" " ")
	447	;;; (buffer-name)
	448	;;; size
	449	;;; mode-name
	450	;;; (or (buffer-file-name) ""))))))
	451	\f
7b7d6615 RS	452	(defvar menu-bar-mode nil)
7b7d6615 RS	453
057d49d1	454	(defun menu-bar-mode (flag)
dfd29450	455	"Toggle display of a menu bar on each frame.
057d49d1 RS	456	This command applies to all frames that exist and frames to be
	457	created in the future.
	458	With a numeric argument, if the argument is negative,
dfd29450	459	turn off menu bars; otherwise, turn on menu bars."
dad8e392	460	(interactive "P")
dad8e392	461
7b7d6615 RS	462	;; Make menu-bar-mode and default-frame-alist consistent.
	463	(let ((default (assq 'menu-bar-lines default-frame-alist)))
	464	(if default
	465	(setq menu-bar-mode (not (eq (cdr default) 0)))
	466	(setq default-frame-alist
	467	(cons (cons 'menu-bar-lines (if menu-bar-mode 1 0))
	468	default-frame-alist))))
	469
	470	;; Toggle or set the mode, according to FLAG.
	471	(setq menu-bar-mode (if (null flag) (not menu-bar-mode)
	472	(> (prefix-numeric-value flag) 0)))
	473
	474	;; Apply it to default-frame-alist.
	475	(let ((parameter (assq 'menu-bar-lines default-frame-alist)))
	476	(if (consp parameter)
	477	(setcdr parameter (if menu-bar-mode 1 0))
	478	(setq default-frame-alist
	479	(cons (cons 'menu-bar-lines (if menu-bar-mode 1 0))
	480	default-frame-alist))))
	481
	482	;; Apply it to existing frames.
	483	(let ((frames (frame-list)))
	484	(while frames
	485	(let ((height (cdr (assq 'height (frame-parameters (car frames))))))
	486	(modify-frame-parameters (car frames)
	487	(list (cons 'menu-bar-lines
	488	(if menu-bar-mode 1 0))))
	489	(modify-frame-parameters (car frames)
	490	(list (cons 'height height))))
	491	(setq frames (cdr frames)))))
1db87953	492
bffa5d4d RS	493	(provide 'menu-bar)
bffa5d4d RS	494
235aa29b	495	;;; menu-bar.el ends here