[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]
	'("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" . 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 'yank-menu 'menu-enable '(cdr yank-menu))
(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 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 100
  "*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
		       (substring string 0 yank-menu-length))))
    ;; 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)

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