[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))

(define-key menu-bar-file-menu [exit-emacs]
  '("Exit Emacs" . save-buffers-kill-emacs))
(define-key menu-bar-file-menu [kill-buffer]
  '("Kill Buffer" . kill-this-buffer))
(define-key menu-bar-file-menu [delete-frame] '("Delete Frame" . delete-frame))
(define-key menu-bar-file-menu [emerge] '("Emerge" . menu-bar-emerge-menu))
(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))
(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 [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))
(define-key menu-bar-file-menu [new-frame] '("New Frame" . new-frame))

(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 [clear] '("Clear" . delete-region))
(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 [choose-next-paste]
  '("Choose Next Paste >" . mouse-menu-choose-yank))
(define-key menu-bar-edit-menu [paste] '("Paste" . yank))
(define-key menu-bar-edit-menu [copy] '("Copy" . kill-ring-save))
(define-key menu-bar-edit-menu [cut] '("Cut" . kill-region))
(define-key menu-bar-edit-menu [undo] '("Undo" . undo))

(put 'fill-region 'menu-enable 'mark-active)
(put 'kill-region 'menu-enable 'mark-active)
(put 'kill-ring-save 'menu-enable 'mark-active)
(put 'yank 'menu-enable '(x-selection-exists-p))
(put 'delete-region 'menu-enable 'mark-active)
(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 the menu bar CUT, PASTE and COPY items use the clipboard."
  (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)))

;; Sun expects these commands on these keys, so why not?
(define-key global-map [f20] 'clipboard-kill-region)
(define-key global-map [f16] 'clipboard-kill-ring-save)
(define-key global-map [f18] 'clipboard-yank)
\f
(define-key menu-bar-help-menu [emacs-version]
  '("Show Version" . emacs-version))
(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 100
  "*Maximum length of an item in the menu for \
\\[mouse-menu-choose-yank].")

(defun mouse-menu-choose-yank (event)
  "Pop up a menu of the kill-ring for selection with the mouse.
The kill-ring-yank-pointer is moved to the selected element.
A subsequent \\[yank] yanks the choice just selected."
  (interactive "e")
  (let* ((count 0)
	 (menu (mapcar (lambda (string)
			 (if (> (length string) yank-menu-length)
			     (setq string (substring string
						     0 yank-menu-length)))
			 (prog1 (cons string count)
			   (setq count (1+ count))))
		       kill-ring))
	 (arg (x-popup-menu event 
			    (list "Yank Menu"
				  (cons "Choose Next Yank" menu)))))
    ;; A mouse click outside the menu returns nil.
    ;; Avoid a confusing error from passing nil to rotate-yank-pointer.
    ;; XXX should this perhaps do something other than simply return? -rm
    (if arg
	(progn
	  ;; We don't use `rotate-yank-pointer' because we want to move
	  ;; relative to the beginning of kill-ring, not the current
	  ;; position.  Also, that would ask for any new X selection and
	  ;; thus change the list of items the user just chose from, which
	  ;; would be highly confusing.
	  (setq kill-ring-yank-pointer (nthcdr arg kill-ring))
	  (if (interactive-p)
	      (message "The next yank will insert the selected text.")
	    (current-kill 0))))))
(put 'mouse-menu-choose-yank 'menu-enable 'kill-ring)
\f
(define-key global-map [menu-bar buffer] '("Buffers" . menu-bar-buffers))

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

(defvar complex-buffers-menu-p nil
  "*Non-nil says, offer a choice of actions after you pick a buffer.
This applies to the Buffers menu from the menu bar.")

(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)

(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 ()
  (let ((buffers (buffer-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 ((tail buffers)
		      (maxbuf 0)
		      (maxlen 0)
		      alist
		      head)
		  (while tail
		    (or (eq ?\ (aref (buffer-name (car tail)) 0))
			(setq maxbuf
			      (max maxbuf
				   (length (buffer-name (car tail))))))
		    (setq tail (cdr tail)))
		  (setq tail buffers)
		  (while tail
		    (let ((elt (car tail)))
		      (if (not (string-match "^ "
					     (buffer-name elt)))
			  (setq alist (cons
				       (cons
					(format
					 (format "%%%ds  %%s%%s  %%s"
						 maxbuf)
					 (buffer-name elt)
					 (if (buffer-modified-p elt)
					     "*" " ")
					 (save-excursion
					   (set-buffer elt)
					   (if buffer-read-only "%" " "))
					 (or (buffer-file-name elt)
					     (save-excursion
					       (set-buffer elt)
					       list-buffers-directory)
					     ""))
					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 (frame-list))
	(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))
			    (frame-list)))))
    (if buffers-menu
	(setq buffers-menu (cons 'keymap buffers-menu)))
    (if frames-menu
	(setq frames-menu (cons 'keymap frames-menu)))
    (setq foo1 buffers-menu foo2 frames-menu foo3
	  (cons "Buffers"
	    (if (and buffers-menu frames-menu)
		(list 'keymap "Buffers and Frames"
		      (cons "Buffers" buffers-menu)
		      (cons "Frames" frames-menu))
	      (or buffers-menu frames-menu 'undefined))))
    (define-key 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
(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")

 ;; Obtain the current setting by looking at default-frame-alist.
 (let ((menu-bar-mode
	(not (zerop (let ((assq (assq 'menu-bar-lines default-frame-alist)))
		      (if assq (cdr assq) 0))))))

   ;; Tweedle it according to the argument.
   (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
       (modify-frame-parameters (car frames)
				(list (cons 'menu-bar-lines
					    (if menu-bar-mode 1 0))))
       (setq frames (cdr frames))))))

;; Make frames created from now on have a menu bar.
(if window-system
    (menu-bar-mode t))

(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))
db774a16	38
ca9b40a1	39	(define-key menu-bar-file-menu [exit-emacs]
db774a16	40	'("Exit Emacs" . save-buffers-kill-emacs))
2f1139a4 RS	41	(define-key menu-bar-file-menu [kill-buffer]
	42	'("Kill Buffer" . kill-this-buffer))
	43	(define-key menu-bar-file-menu [delete-frame] '("Delete Frame" . delete-frame))
966bcddd	44	(define-key menu-bar-file-menu [emerge] '("Emerge" . menu-bar-emerge-menu))
661b05a7 RS	45	(define-key menu-bar-file-menu [calendar] '("Calendar" . calendar))
	46	(define-key menu-bar-file-menu [rmail] '("Read Mail" . rmail))
	47	(define-key menu-bar-file-menu [gnus] '("Read Net News" . gnus))
9d441895	48	(define-key menu-bar-file-menu [bookmark]
966bcddd	49	'("Bookmarks" . menu-bar-bookmark-map))
2f1139a4 RS	50	(define-key menu-bar-file-menu [print-buffer] '("Print Buffer" . print-buffer))
	51	(define-key menu-bar-file-menu [revert-buffer]
	52	'("Revert Buffer" . revert-buffer))
	53	(define-key menu-bar-file-menu [write-file]
	54	'("Save Buffer As..." . write-file))
	55	(define-key menu-bar-file-menu [save-buffer] '("Save Buffer" . save-buffer))
76202b57	56	(define-key menu-bar-file-menu [dired] '("Open Directory..." . dired))
2f1139a4 RS	57	(define-key menu-bar-file-menu [open-file] '("Open File..." . find-file))
2f1139a4 RS	58	(define-key menu-bar-file-menu [new-frame] '("New Frame" . new-frame))
db774a16	59
966bcddd	60	(define-key menu-bar-edit-menu [spell] '("Spell" . ispell-menu-map))
057d49d1 RS	61	(define-key menu-bar-edit-menu [fill] '("Fill" . fill-region))
057d49d1 RS	62	(define-key menu-bar-edit-menu [clear] '("Clear" . delete-region))
33aa8946 RS	63	(define-key menu-bar-edit-menu [query-replace]
33aa8946 RS	64	'("Query Replace" . query-replace))
50d195ee RS	65	(define-key menu-bar-edit-menu [re-search-back]
	66	'("Regexp Search Backwards" . re-search-backward))
	67	(define-key menu-bar-edit-menu [search-back]
	68	'("Search Backwards" . search-backward))
	69	(define-key menu-bar-edit-menu [re-search-fwd]
	70	'("Regexp Search" . re-search-forward))
	71	(define-key menu-bar-edit-menu [search-fwd]
	72	'("Search" . search-forward))
75340584	73	(define-key menu-bar-edit-menu [choose-next-paste]
f7f19201	74	'("Choose Next Paste >" . mouse-menu-choose-yank))
057d49d1 RS	75	(define-key menu-bar-edit-menu [paste] '("Paste" . yank))
	76	(define-key menu-bar-edit-menu [copy] '("Copy" . kill-ring-save))
	77	(define-key menu-bar-edit-menu [cut] '("Cut" . kill-region))
	78	(define-key menu-bar-edit-menu [undo] '("Undo" . undo))
	79
	80	(put 'fill-region 'menu-enable 'mark-active)
	81	(put 'kill-region 'menu-enable 'mark-active)
	82	(put 'kill-ring-save 'menu-enable 'mark-active)
	83	(put 'yank 'menu-enable '(x-selection-exists-p))
	84	(put 'delete-region 'menu-enable 'mark-active)
	85	(put 'undo 'menu-enable '(if (eq last-command 'undo)
	86	pending-undo-list
	87	(consp buffer-undo-list)))
33aa8946	88	(put 'query-replace 'menu-enable (not buffer-read-only))
db774a16	89
9e18f0a0 RS	90	(autoload 'ispell-menu-map "ispell" nil t 'keymap)
9e18f0a0 RS	91
f9cf0be2 RS	92	;; These are alternative definitions for the cut, paste and copy
	93	;; menu items. Use them if your system expects these to use the clipboard
	94
f9cf0be2 RS	95	(put 'clipboard-kill-region 'menu-enable 'mark-active)
	96	(put 'clipboard-kill-ring-save 'menu-enable 'mark-active)
	97	(put 'clipboard-yank 'menu-enable
	98	'(or (x-selection-exists-p) (x-selection-exists-p 'CLIPBOARD)))
	99
	100	(defun clipboard-yank ()
	101	"Reinsert the last stretch of killed text, or the clipboard contents."
	102	(interactive)
	103	(let ((x-select-enable-clipboard t))
	104	(yank)))
	105
	106	(defun clipboard-kill-ring-save (beg end)
	107	"Copy region to kill ring, and save in the X clipboard."
	108	(interactive "r")
	109	(let ((x-select-enable-clipboard t))
	110	(kill-ring-save beg end)))
	111
	112	(defun clipboard-kill-region (beg end)
	113	"Kill the region, and save it in the X clipboard."
	114	(interactive "r")
	115	(let ((x-select-enable-clipboard t))
	116	(kill-region beg end)))
	117
	118	(defun menu-bar-enable-clipboard ()
	119	"Make the menu bar CUT, PASTE and COPY items use the clipboard."
	120	(interactive)
5754d7f2 RS	121	;; We can't use constant list structure here because it becomes pure,
	122	;; and because it gets modified with cache data.
	123	(define-key menu-bar-edit-menu [paste]
	124	(cons "Paste" 'clipboard-yank))
	125	(define-key menu-bar-edit-menu [copy]
	126	(cons "Copy" 'clipboard-kill-ring-save))
	127	(define-key menu-bar-edit-menu [cut]
	128	(cons "Cut" 'clipboard-kill-region)))
2165f676 RS	129
	130	;; Sun expects these commands on these keys, so why not?
	131	(define-key global-map [f20] 'clipboard-kill-region)
	132	(define-key global-map [f16] 'clipboard-kill-ring-save)
	133	(define-key global-map [f18] 'clipboard-yank)
f9cf0be2	134	\f
efb166ff RS	135	(define-key menu-bar-help-menu [emacs-version]
efb166ff RS	136	'("Show Version" . emacs-version))
ca9b40a1	137	(define-key menu-bar-help-menu [emacs-tutorial]
db774a16	138	'("Emacs Tutorial" . help-with-tutorial))
2f1139a4 RS	139	(define-key menu-bar-help-menu [man] '("Man..." . manual-entry))
	140	(define-key menu-bar-help-menu [describe-variable]
	141	'("Describe Variable..." . describe-variable))
	142	(define-key menu-bar-help-menu [describe-function]
	143	'("Describe Function..." . describe-function))
	144	(define-key menu-bar-help-menu [describe-key]
	145	'("Describe Key..." . describe-key))
	146	(define-key menu-bar-help-menu [list-keybindings]
	147	'("List Keybindings" . describe-bindings))
	148	(define-key menu-bar-help-menu [command-apropos]
	149	'("Command Apropos..." . command-apropos))
	150	(define-key menu-bar-help-menu [describe-mode]
	151	'("Describe Mode" . describe-mode))
	152	(define-key menu-bar-help-menu [info] '("Info" . info))
db774a16	153
2f1139a4	154	(define-key menu-bar-help-menu [emacs-news] '("Emacs News" . view-emacs-news))
db774a16 RS	155	(defun kill-this-buffer () ; for the menubar
	156	"Kills the current buffer."
	157	(interactive)
	158	(kill-buffer (current-buffer)))
	159
2f1139a4 RS	160	(defun kill-this-buffer-enabled-p ()
	161	(let ((count 0)
	162	(buffers (buffer-list)))
	163	(while buffers
	164	(or (string-match "^ " (buffer-name (car buffers)))
	165	(setq count (1+ count)))
	166	(setq buffers (cdr buffers)))
	167	(> count 1)))
	168
db774a16	169	(put 'save-buffer 'menu-enable '(buffer-modified-p))
da183f87 RS	170	(put 'revert-buffer 'menu-enable
	171	'(or revert-buffer-function revert-buffer-insert-file-contents-function
	172	(and (buffer-file-name)
660fa562 RM	173	(or (buffer-modified-p)
660fa562 RM	174	(not (verify-visited-file-modtime (current-buffer)))))))
a0213a97 RS	175	;; Permit deleting frame if it would leave a visible or iconified frame.
	176	(put 'delete-frame 'menu-enable
	177	'(let ((frames (frame-list))
	178	(count 0))
	179	(while frames
	180	(if (cdr (assq 'visibility (frame-parameters (car frames))))
	181	(setq count (1+ count)))
	182	(setq frames (cdr frames)))
	183	(> count 1)))
2f1139a4 RS	184	(put 'kill-this-buffer 'menu-enable '(kill-this-buffer-enabled-p))
2f1139a4 RS	185
db774a16 RS	186	(put 'advertised-undo 'menu-enable
	187	'(and (not (eq t buffer-undo-list))
	188	(if (eq last-command 'undo)
2f1139a4 RS	189	(and (boundp 'pending-undo-list)
	190	pending-undo-list)
	191	buffer-undo-list)))
2877eac2 RS	192
	193	(defvar yank-menu-length 100
	194	"*Maximum length of an item in the menu for \
	195	\\[mouse-menu-choose-yank].")
	196
	197	(defun mouse-menu-choose-yank (event)
	198	"Pop up a menu of the kill-ring for selection with the mouse.
	199	The kill-ring-yank-pointer is moved to the selected element.
	200	A subsequent \\[yank] yanks the choice just selected."
	201	(interactive "e")
	202	(let* ((count 0)
	203	(menu (mapcar (lambda (string)
	204	(if (> (length string) yank-menu-length)
	205	(setq string (substring string
	206	0 yank-menu-length)))
	207	(prog1 (cons string count)
	208	(setq count (1+ count))))
dfabc98f RM	209	kill-ring))
	210	(arg (x-popup-menu event
	211	(list "Yank Menu"
75340584	212	(cons "Choose Next Yank" menu)))))
dfabc98f RM	213	;; A mouse click outside the menu returns nil.
	214	;; Avoid a confusing error from passing nil to rotate-yank-pointer.
	215	;; XXX should this perhaps do something other than simply return? -rm
	216	(if arg
	217	(progn
03dcd202 RM	218	;; We don't use `rotate-yank-pointer' because we want to move
	219	;; relative to the beginning of kill-ring, not the current
	220	;; position. Also, that would ask for any new X selection and
	221	;; thus change the list of items the user just chose from, which
	222	;; would be highly confusing.
	223	(setq kill-ring-yank-pointer (nthcdr arg kill-ring))
dfabc98f RM	224	(if (interactive-p)
	225	(message "The next yank will insert the selected text.")
	226	(current-kill 0))))))
	227	(put 'mouse-menu-choose-yank 'menu-enable 'kill-ring)
40954111	228	\f
09642d97 RS	229	(define-key global-map [menu-bar buffer] '("Buffers" . menu-bar-buffers))
	230
	231	(defalias 'menu-bar-buffers (make-sparse-keymap "Buffers"))
40954111 RS	232
	233	(defvar complex-buffers-menu-p nil
	234	"*Non-nil says, offer a choice of actions after you pick a buffer.
	235	This applies to the Buffers menu from the menu bar.")
	236
	237	(defvar buffers-menu-max-size 10
	238	"*Maximum number of entries which may appear on the Buffers menu.
	239	If this is 10, then only the ten most-recently-selected buffers are shown.
	240	If this is nil, then all buffers are shown.
	241	A large number or nil slows down menu responsiveness.")
	242
d0690d12 RS	243	(defvar list-buffers-directory nil)
d0690d12 RS	244
09642d97 RS	245	(defun menu-bar-select-buffer ()
	246	(interactive)
	247	(switch-to-buffer last-command-event))
	248
	249	(defun menu-bar-select-frame ()
	250	(interactive)
	251	(make-frame-visible last-command-event)
	252	(raise-frame last-command-event)
	253	(select-frame last-command-event))
	254
	255	(defun menu-bar-update-buffers ()
40954111	256	(let ((buffers (buffer-list))
09642d97	257	buffers-menu frames-menu)
40954111 RS	258	;; If requested, list only the N most recently selected buffers.
	259	(if (and (integerp buffers-menu-max-size)
	260	(> buffers-menu-max-size 1))
	261	(if (> (length buffers) buffers-menu-max-size)
	262	(setcdr (nthcdr buffers-menu-max-size buffers) nil)))
09642d97 RS	263
	264	;; Make the menu of buffers proper.
	265	(setq buffers-menu
e936d399 RM	266	(cons "Select Buffer"
	267	(let ((tail buffers)
	268	(maxbuf 0)
	269	(maxlen 0)
09642d97	270	alist
e936d399 RM	271	head)
	272	(while tail
	273	(or (eq ?\ (aref (buffer-name (car tail)) 0))
	274	(setq maxbuf
	275	(max maxbuf
	276	(length (buffer-name (car tail))))))
	277	(setq tail (cdr tail)))
	278	(setq tail buffers)
	279	(while tail
	280	(let ((elt (car tail)))
	281	(if (not (string-match "^ "
	282	(buffer-name elt)))
09642d97 RS	283	(setq alist (cons
	284	(cons
	285	(format
	286	(format "%%%ds %%s%%s %%s"
	287	maxbuf)
	288	(buffer-name elt)
	289	(if (buffer-modified-p elt)
	290	"*" " ")
	291	(save-excursion
	292	(set-buffer elt)
	293	(if buffer-read-only "%" " "))
	294	(or (buffer-file-name elt)
	295	(save-excursion
	296	(set-buffer elt)
	297	list-buffers-directory)
	298	""))
	299	elt)
	300	alist)))
	301	(and alist (> (length (car (car alist))) maxlen)
	302	(setq maxlen (length (car (car alist))))))
e936d399	303	(setq tail (cdr tail)))
09642d97 RS	304	(setq alist (nreverse alist))
	305	(nconc (mapcar '(lambda (pair)
	306	;; This is somewhat risque, to use
	307	;; the buffer name itself as the event type
	308	;; to define, but it works.
	309	;; It would not work to use the buffer
	310	;; since a buffer as an event has its
	311	;; own meaning.
	312	(nconc (list (buffer-name (cdr pair))
	313	(car pair)
	314	(cons nil nil))
	315	'menu-bar-select-buffer))
	316	alist)
	317	(list (cons 'list-buffers
	318	(cons
	319	(concat (make-string (max (- (/ maxlen
	320	2)
	321	8)
	322	0) ?\ )
	323	"List All Buffers")
	324	'list-buffers)))))))
	325
	326	;; Make a Frames menu if we have more than one frame.
e936d399	327	(if (cdr (frame-list))
09642d97 RS	328	(setq frames-menu
	329	(cons "Select Frame"
	330	(mapcar '(lambda (frame)
	331	(nconc (list frame
	332	(cdr (assq 'name
	333	(frame-parameters frame)))
	334	(cons nil nil))
	335	'menu-bar-select-frame))
	336	(frame-list)))))
	337	(if buffers-menu
	338	(setq buffers-menu (cons 'keymap buffers-menu)))
	339	(if frames-menu
	340	(setq frames-menu (cons 'keymap frames-menu)))
	341	(setq foo1 buffers-menu foo2 frames-menu foo3
	342	(cons "Buffers"
	343	(if (and buffers-menu frames-menu)
	344	(list 'keymap "Buffers and Frames"
	345	(cons "Buffers" buffers-menu)
	346	(cons "Frames" frames-menu))
	347	(or buffers-menu frames-menu 'undefined))))
	348	(define-key global-map [menu-bar buffer]
	349	(cons "Buffers"
	350	(if (and buffers-menu frames-menu)
	351	(list 'keymap "Buffers and Frames"
	352	(cons 'buffers (cons "Buffers" buffers-menu))
	353	(cons 'frames (cons "Frames" frames-menu)))
	354	(or buffers-menu frames-menu 'undefined))))))
	355
	356	(add-hook 'menu-bar-update-hook 'menu-bar-update-buffers)
2f1139a4	357
40954111 RS	358	;; this version is too slow
	359	;;;(defun format-buffers-menu-line (buffer)
	360	;;; "Returns a string to represent the given buffer in the Buffer menu.
	361	;;;nil means the buffer shouldn't be listed. You can redefine this."
	362	;;; (if (string-match "\\` " (buffer-name buffer))
	363	;;; nil
	364	;;; (save-excursion
	365	;;; (set-buffer buffer)
	366	;;; (let ((size (buffer-size)))
	367	;;; (format "%s%s %-19s %6s %-15s %s"
	368	;;; (if (buffer-modified-p) "*" " ")
	369	;;; (if buffer-read-only "%" " ")
	370	;;; (buffer-name)
	371	;;; size
	372	;;; mode-name
	373	;;; (or (buffer-file-name) ""))))))
	374	\f
057d49d1	375	(defun menu-bar-mode (flag)
dfd29450	376	"Toggle display of a menu bar on each frame.
057d49d1 RS	377	This command applies to all frames that exist and frames to be
	378	created in the future.
	379	With a numeric argument, if the argument is negative,
dfd29450	380	turn off menu bars; otherwise, turn on menu bars."
dad8e392	381	(interactive "P")
dad8e392 RM	382
	383	;; Obtain the current setting by looking at default-frame-alist.
	384	(let ((menu-bar-mode
	385	(not (zerop (let ((assq (assq 'menu-bar-lines default-frame-alist)))
	386	(if assq (cdr assq) 0))))))
	387
	388	;; Tweedle it according to the argument.
	389	(setq menu-bar-mode (if (null flag) (not menu-bar-mode)
e48f95c9	390	(> (prefix-numeric-value flag) 0)))
dad8e392 RM	391
	392	;; Apply it to default-frame-alist.
	393	(let ((parameter (assq 'menu-bar-lines default-frame-alist)))
	394	(if (consp parameter)
	395	(setcdr parameter (if menu-bar-mode 1 0))
	396	(setq default-frame-alist
	397	(cons (cons 'menu-bar-lines (if menu-bar-mode 1 0))
	398	default-frame-alist))))
	399
	400	;; Apply it to existing frames.
	401	(let ((frames (frame-list)))
	402	(while frames
	403	(modify-frame-parameters (car frames)
	404	(list (cons 'menu-bar-lines
	405	(if menu-bar-mode 1 0))))
	406	(setq frames (cdr frames))))))
1db87953 RS	407
1db87953 RS	408	;; Make frames created from now on have a menu bar.
d0dbd3bf RS	409	(if window-system
d0dbd3bf RS	410	(menu-bar-mode t))
1db87953	411
bffa5d4d RS	412	(provide 'menu-bar)
bffa5d4d RS	413
235aa29b	414	;;; menu-bar.el ends here