comparison lisp/emacs-lisp/lmenu.el @ 2751:f95808ad4b95

(default-menubar): Make initial value nil. (kill-this-buffer, x-new-frame) (sensitize-file-and-edit-menus-hook, format-buffers-menu-line) (buffers-menu-max-size, complex-buffers-menu-p) (buffers-menu-switch-to-buffer-function, buffer-menu-save-buffer) (buffer-menu-write-file, build-buffers-menu-internal) (build-buffers-menu-hook): Functions and variables deleted.

2750:6f340eabf13f

				     (car pos))
			       menu))
    (setq cmd (lookup-key menu (vector answer)))
    (if cmd (call-interactively cmd))))

(defconst default-menubar
  '(("File"	["New Frame"		x-new-frame		t]
		["Open File..."		find-file		t]
		["Save Buffer"		save-buffer		t  nil]
		["Save Buffer As..."	write-file		t]
		["Revert Buffer"	revert-buffer		t  nil]
		"-----"
		["Print Buffer"		lpr-buffer		t  nil]
		"-----"
		["Delete Frame"		delete-frame		t]
;;		["Kill Buffer..."	kill-buffer		t]
		["Kill Buffer"		kill-this-buffer	t  nil]
		["Exit Emacs"		save-buffers-kill-emacs	t]
		)
    ("Edit"	["Undo"			advertised-undo		   t]
		["Cut"			x-kill-primary-selection   t]
		["Copy"			x-copy-primary-selection   t]
		["Paste"		x-yank-clipboard-selection t]
		["Clear"		x-delete-primary-selection t]
		)
    ("Buffers"	"")

    nil		; the partition: menus after this are flushright

    ("Help"	["Info"			info			t]
		["Describe Mode"	describe-mode		t]
		["Command Apropos..."	command-apropos		t]
		["List Keybindings"	describe-bindings	t]
		["Describe Key..."	describe-key		t]
		["Describe Function..."	describe-function	t]
		["Describe Variable..."	describe-variable	t]
		"-----"
		["Man..."		manual-entry		t]
		["Emacs Tutorial"	help-with-tutorial	t]
		["Emacs News"		view-emacs-news		t]
		)
    ))


(defun kill-this-buffer ()	; for the menubar
  "Kills the current buffer."
  (interactive)
  (kill-buffer (current-buffer)))

(defun x-new-frame (&optional frame-name)
  "Creates a new Emacs frame (that is, a new X window.)"
  (interactive)
  (select-frame (x-create-frame
		  (append (if frame-name
			      (list (cons 'name frame-name))
			    nil)
			  frame-default-alist)))
  (switch-to-buffer (get-buffer-create "*scratch*"))
  )

(defun set-menubar (menubar)
  "Set the default menubar to be menubar."
  (setq-default current-menubar (copy-sequence menubar))
  (set-menubar-dirty-flag))



(defvar put-buffer-names-in-file-menu t)

(defun sensitize-file-and-edit-menus-hook ()
  "For use as a value of activate-menubar-hook.
This function changes the sensitivity of these File and Edit menu items:

  Cut    sensitive only when emacs owns the primary X Selection.
  Copy   sensitive only when emacs owns the primary X Selection.
  Clear  sensitive only when emacs owns the primary X Selection.
  Paste  sensitive only when there is an owner for the X Clipboard Selection.
  Undo   sensitive only when there is undo information.
         While in the midst of an undo, this is changed to \"Undo More\".

  Kill Buffer    has the name of the current buffer appended to it.
  Print Buffer   has the name of the current buffer appended to it.
  Save Buffer    has the name of the current buffer appended to it, and is
                 sensitive only when the current buffer is modified.
  Revert Buffer  has the name of the current buffer appended to it, and is
                 sensitive only when the current buffer has a file.
  Delete Frame   sensitive only when there is more than one visible frame."
  ;;
  ;; the hair in here to not update the menubar unless something has changed
  ;; isn't really necessary (the menubar code is fast enough) but it makes
  ;; me feel better (and creates marginally less list garbage.)
  (let* ((file-menu (cdr (car (find-menu-item current-menubar '("File")))))
	 (edit-menu (cdr (car (find-menu-item current-menubar '("Edit")))))
	 (save	(car (find-menu-item file-menu '("Save Buffer"))))
	 (rvt   (car (find-menu-item file-menu '("Revert Buffer"))))
	 (del   (car (find-menu-item file-menu '("Delete Frame"))))
	 (print (car (find-menu-item file-menu '("Print Buffer"))))
	 (kill  (car (find-menu-item file-menu '("Kill Buffer"))))
	 (cut   (car (find-menu-item edit-menu '("Cut"))))
	 (copy  (car (find-menu-item edit-menu '("Copy"))))
	 (paste (car (find-menu-item edit-menu '("Paste"))))
	 (clear (car (find-menu-item edit-menu '("Clear"))))
	 (undo  (or (car (find-menu-item edit-menu '("Undo")))
		    (car (find-menu-item edit-menu '("Undo More")))))
	 (name (buffer-name))
	 (emacs-owns-selection-p (x-selection-owner-p))
	 (clipboard-exists-p (x-selection-exists-p 'CLIPBOARD))
	 undo-available undoing-more
	 (undo-info-available (not (null (and (not (eq t buffer-undo-list))
				   (if (eq last-command 'undo)
				       (setq undoing-more
					     (and (boundp 'pending-undo-list)
					    pending-undo-list)
				     buffer-undo-list))))))
	 undo-name undo-state
	 (change-p
	  (or (and cut   (not (eq emacs-owns-selection-p (aref cut 2))))
	      (and copy  (not (eq emacs-owns-selection-p (aref copy 2))))
	      (and clear (not (eq emacs-owns-selection-p (aref clear 2))))
	      (and paste (not (eq clipboard-exists-p (aref paste 2))))
	      (and save  (not (eq (buffer-modified-p) (aref save 2))))
	      (and rvt   (not (eq (not (not buffer-file-name)) (aref rvt 2))))
	      (and del   (not (eq (null (cdr (visible-frame-list))) (aref del 2))))
	      )))
    (if (not put-buffer-names-in-file-menu)
	nil
      (if (= (length save)  4) (progn (aset save  3 name) (setq change-p t)))
      (if (= (length rvt)   4) (progn (aset rvt   3 name) (setq change-p t)))
      (if (= (length print) 4) (progn (aset print 3 name) (setq change-p t)))
      (if (= (length kill)  4) (progn (aset kill  3 name) (setq change-p t))))
    (if save  (aset save  2 (buffer-modified-p)))
    (if rvt   (aset rvt   2 (not (not buffer-file-name))))
    (if del   (aset del   2 (null (cdr (visible-frame-list)))))
    (if cut   (aset cut   2 emacs-owns-selection-p))
    (if copy  (aset copy  2 emacs-owns-selection-p))
    (if clear (aset clear 2 emacs-owns-selection-p))
    (if paste (aset paste 2 clipboard-exists-p))

    ;; we could also do this with the third field of the item.
    (if (eq last-command 'undo)
	(setq undo-name "Undo More"
	      undo-state (not (null (and (boundp 'pending-undo-list)
					 pending-undo-list))))
      (setq undo-name "Undo"
	    undo-state (and (not (eq buffer-undo-list t))
			    (not (null
				  (or buffer-undo-list
				      (and (boundp 'pending-undo-list)
					   pending-undo-list)))))))
    (if buffer-read-only (setq undo-state nil))
    (if (and undo
	     (or (not (equal undo-name (aref undo 0)))
		 (not (eq undo-state (aref undo 2)))))
	(progn (aset undo 0 undo-name)
	       (aset undo 2 undo-state)
	       (setq change-p t)))
    ;; if we made any changes, return nil
    ;; otherwise return t to indicate that we haven't done anything.
    (not change-p)))

;; 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) ""))))))
	   
(defun format-buffers-menu-line (buffer)
  (if (string-match "\\` " (setq buffer (buffer-name buffer)))
      nil
    buffer))

(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 will be
shown.  If this is nil, then all buffers will be shown.  Setting this to
a large number or nil will slow down menu responsiveness.")

(defvar complex-buffers-menu-p nil
  "*If true, the buffers menu will contain several commands, as submenus
of each buffer line.  If this is false, then there will be only one command:
select that buffer.")

(defvar buffers-menu-switch-to-buffer-function 'switch-to-buffer
  "*The function to call to select a buffer from the buffers menu.
`switch-to-buffer' is a good choice, as is `pop-to-buffer'.")


(defun buffer-menu-save-buffer (buffer)
  (save-excursion
    (set-buffer buffer)
    (save-buffer)))

(defun buffer-menu-write-file (buffer)
  (save-excursion
    (set-buffer buffer)
    (write-file (read-file-name
		 (concat "Write " (buffer-name (current-buffer))
			 " to file: ")))))


(defsubst build-buffers-menu-internal (buffers)
  (let (name line)
    (mapcar
     (if complex-buffers-menu-p
	 (function
	  (lambda (buffer)
	    (if (setq line (format-buffers-menu-line buffer))
		(list line
		      (vector "Switch to Buffer"
			      (list buffers-menu-switch-to-buffer-function
				    (setq name (buffer-name buffer)))
			      t)
		      (if (and (buffer-modified-p buffer)
			       (buffer-file-name buffer))
			  (vector "Save Buffer"
				  (list 'buffer-menu-save-buffer name) t)
			["Save Buffer" nil nil])
		      (vector "Save Buffer As..."
			      (list 'buffer-menu-write-file name) t)
		      (vector "Kill Buffer" (list 'kill-buffer name) t)))))
       (function (lambda (buffer)
		   (if (setq line (format-buffers-menu-line buffer))
		       (vector line
			       (list buffers-menu-switch-to-buffer-function
				     (buffer-name buffer))
			       t)))))
     buffers)))

(defun build-buffers-menu-hook ()
  "For use as a value of activate-menubar-hook.
This function changes the contents of the \"Buffers\" menu to correspond
to the current set of buffers.  Only the most-recently-used few buffers
will be listed on the menu, for efficiency reasons.  You can control how
many buffers will be shown by setting `buffers-menu-max-size'.
You can control the text of the menu items by redefining the function
`format-buffers-menu-line'."
  (let ((buffer-menu (car (find-menu-item current-menubar '("Buffers"))))
	name
	buffers)
    (if (not buffer-menu)
	nil
      (setq buffers (buffer-list))

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

      (setq buffers (build-buffers-menu-internal buffers))
      (setq buffers (nconc (delq nil buffers)
			   '("----" ["List All Buffers" list-buffers t])))
      ;; slightly (only slightly) more efficient to not install the menubar
      ;; if it hasn't visibly changed.
      (if (equal buffers (cdr buffer-menu))
	  t  ; return t meaning "no change"
	(setcdr buffer-menu buffers)
	(set-menubar-dirty-flag)
	nil))))

(add-hook 'activate-menubar-hook 'build-buffers-menu-hook)
(add-hook 'activate-menubar-hook 'sensitize-file-and-edit-menus-hook)

(let ((frames (frame-list)))
  (while frames
    (modify-frame-parameters (car frames) '((menu-bar-lines . 1)))
    (setq frames (cdr frames))))

2751:f95808ad4b95

				     (car pos))
			       menu))
    (setq cmd (lookup-key menu (vector answer)))
    (if cmd (call-interactively cmd))))

;; This is empty because the usual elements of the menu bar 
;; are provided by menu-bar.el instead.
;; It would not make sense to duplicate them here.
(defconst default-menubar nil)

(defun set-menubar (menubar)
  "Set the default menubar to be menubar."
  (setq-default current-menubar (copy-sequence menubar))
  (set-menubar-dirty-flag))



(defvar put-buffer-names-in-file-menu t)


(let ((frames (frame-list)))
  (while frames
    (modify-frame-parameters (car frames) '((menu-bar-lines . 1)))
    (setq frames (cdr frames))))