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

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