changeset 2231:1c7ad2a0f4d9

Initial revision

--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lisp/emacs-lisp/lmenu.el	Wed Mar 17 16:26:48 1993 +0000
@@ -0,0 +1,635 @@
+;;; Menubar support.
+;; Copyright (C) 1992, 1993 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.
+
+
+;; First, emulate the Lucid menubar support in GNU Emacs 19.
+
+;; Arrange to use current-menubar to set up part of the menu bar.
+
+(setq recompute-lucid-menubar 'recompute-lucid-menubar)
+(defun recompute-lucid-menubar ()
+  (define-key lucid-menubar-map [menu-bar]
+    (condition-case nil
+	(make-lucid-menu-keymap "menu-bar" current-menubar)
+      (error (message "Invalid data in current-menubar moved to lucid-failing-menubar")
+	     (sit-for 1)
+	     (setq lucid-failing-menubar current-menubar
+		   current-menubar nil))))
+  (setq lucid-menu-bar-dirty-flag nil))
+
+(defvar lucid-menubar-map (make-sparse-keymap))
+(or (assq 'current-menubar minor-mode-map-alist)
+    (setq minor-mode-map-alist
+	  (cons (cons 'current-menubar lucid-menubar-map)
+		minor-mode-map-alist)))
+
+(defun set-menubar-dirty-flag ()
+  (force-mode-line-update)
+  (setq lucid-menu-bar-dirty-flag t))
+
+(defvar add-menu-item-count 0)
+
+;; Return a menu keymap corresponding to a Lucid-style menu list
+;; MENU-ITEMS, and with name MENU-NAME.
+(defun make-lucid-menu-keymap (menu-name menu-items)
+  (let ((menu (make-sparse-keymap menu-name)))
+    ;; Process items in reverse order,
+    ;; since the define-key loop reverses them again.
+    (setq menu-items (reverse menu-items))
+    (while menu-items
+      (let* ((item (car menu-items))
+	     (callback (if (vectorp item) (aref item 1)))
+	     command enabler name)
+	(cond ((stringp item)
+	       (setq command nil)
+	       (setq name item))
+	      ((consp item)
+	       (setq command (make-lucid-menu-keymap (car item) (cdr item)))
+	       (setq name (car item)))
+	      ((vectorp item)
+	       (setq command (make-symbol (format "menu-function-%d"
+						  add-menu-item-count)))
+	       (setq enabler (make-symbol (format "menu-function-%d-enabler"
+						  add-menu-item-count)))
+	       (setq add-menu-item-count (1+ add-menu-item-count))
+	       (put command 'menu-enable enabler)
+	       (set enabler (aref item 2))
+	       (setq name (aref item 0))	       
+	       (if (symbolp callback)
+		   (fset command callback)
+		 (fset command (list 'lambda () '(interactive) callback)))))
+	(if name 
+	    (define-key menu (vector (intern name)) (cons name command))))
+      (setq menu-items (cdr menu-items)))
+    menu))
+
+(defun popup-menu (menu-desc)
+  "Pop up the given menu.
+A menu is a list of menu items, strings, and submenus.
+
+The first element of a menu must be a string, which is the name of the
+menu.  This is the string that will be displayed in the parent menu, if
+any.  For toplevel menus, it is ignored.  This string is not displayed
+in the menu itself.
+
+A menu item is a vector of three or four elements:
+
+ - the name of the menu item (a string);
+ - the `callback' of that item;
+ - whether this item is active (selectable);
+ - and an optional string to append to the name.
+
+If the `callback' of a menu item is a symbol, then it must name a command.
+It will be invoked with `call-interactively'.  If it is a list, then it is
+evaluated with `eval'.
+
+The fourth element of a menu item is a convenient way of adding the name
+of a command's ``argument'' to the menu, like ``Kill Buffer NAME''.
+
+If an element of a menu is a string, then that string will be presented in
+the menu as unselectable text.
+
+If an element of a menu is a string consisting solely of hyphens, then that
+item will be presented as a solid horizontal line.
+
+If an element of a menu is a list, it is treated as a submenu.  The name of
+that submenu (the first element in the list) will be used as the name of the
+item representing this menu on the parent.
+
+The syntax, more precisely:
+
+   form		:=  <something to pass to `eval'>
+   command	:=  <a symbol or string, to pass to `call-interactively'>
+   callback 	:=  command | form
+   active-p	:=  <t or nil, whether this thing is selectable>
+   text		:=  <string, non selectable>
+   name		:=  <string>
+   argument	:=  <string>
+   menu-item	:=  '['  name callback active-p [ argument ]  ']'
+   menu		:=  '(' name [ menu-item | menu | text ]+ ')'
+"
+  (let ((menu (make-lucid-menu-keymap (car menu-desc) (cdr menu-desc)))
+	(pos (mouse-position))
+	answer)
+    (setq answer (x-popup-menu (list (list (nth 1 pos) (nthcdr 2 pos))
+				     (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))
+
+(defun set-buffer-menubar (menubar)
+  "Set the buffer-local menubar to be menubar."
+  (make-local-variable 'current-menubar)
+  (setq current-menubar (copy-sequence menubar))
+  (set-menubar-dirty-flag))
+
+
+;;; menu manipulation functions
+
+(defun find-menu-item (menubar item-path-list &optional parent)
+  "Searches MENUBAR for item given by ITEM-PATH-LIST.
+Returns (ITEM . PARENT), where PARENT is the immediate parent of
+ the item found.
+Signals an error if the item is not found."
+  (or parent (setq item-path-list (mapcar 'downcase item-path-list)))
+  (if (not (consp menubar))
+      nil
+    (let ((rest menubar)
+	  result)
+      (while rest
+	(if (and (car rest)
+		 (equal (car item-path-list)
+			(downcase (if (vectorp (car rest))
+				      (aref (car rest) 0)
+				    (if (stringp (car rest))
+					(car rest)
+				      (car (car rest)))))))
+	    (setq result (car rest) rest nil)
+	  (setq rest (cdr rest))))
+      (if (cdr item-path-list)
+	  (if (consp result)
+	      (find-menu-item (cdr result) (cdr item-path-list) result)
+	    (if result
+		(signal 'error (list "not a submenu" result))
+	      (signal 'error (list "no such submenu" (car item-path-list)))))
+	(cons result parent)))))
+
+
+(defun disable-menu-item (path)
+  "Make the named menu item be unselectable.
+PATH is a list of strings which identify the position of the menu item in 
+the menu hierarchy.  (\"File\" \"Save\") means the menu item called \"Save\"
+under the toplevel \"File\" menu.  (\"Menu\" \"Foo\" \"Item\") means the 
+menu item called \"Item\" under the \"Foo\" submenu of \"Menu\"."
+  (let* ((menubar current-menubar)
+	 (pair (find-menu-item menubar path))
+	 (item (car pair))
+	 (menu (cdr pair)))
+    (or item
+	(signal 'error (list (if menu "No such menu item" "No such menu")
+			     path)))
+    (if (consp item) (error "can't disable menus, only menu items"))
+    (aset item 2 nil)
+    (set-menubar-dirty-flag)
+    item))
+
+
+(defun enable-menu-item (path)
+  "Make the named menu item be selectable.
+PATH is a list of strings which identify the position of the menu item in 
+the menu hierarchy.  (\"File\" \"Save\") means the menu item called \"Save\"
+under the toplevel \"File\" menu.  (\"Menu\" \"Foo\" \"Item\") means the 
+menu item called \"Item\" under the \"Foo\" submenu of \"Menu\"."
+  (let* ((menubar current-menubar)
+	 (pair (find-menu-item menubar path))
+	 (item (car pair))
+	 (menu (cdr pair)))
+    (or item
+	(signal 'error (list (if menu "No such menu item" "No such menu")
+			     path)))
+    (if (consp item) (error "%S is a menu, not a menu item" path))
+    (aset item 2 t)
+    (set-menubar-dirty-flag)
+    item))
+
+
+(defun add-menu-item-1 (item-p menu-path item-name item-data enabled-p before)
+  (if before (setq before (downcase before)))
+  (let* ((menubar current-menubar)
+	 (menu (condition-case ()
+		   (car (find-menu-item menubar menu-path))
+		 (error nil)))
+	 (item (if (listp menu)
+		   (car (find-menu-item (cdr menu) (list item-name)))
+		 (signal 'error (list "not a submenu" menu-path)))))
+    (or menu
+	(let ((rest menu-path)
+	      (so-far menubar))
+	  (while rest
+;;;	    (setq menu (car (find-menu-item (cdr so-far) (list (car rest)))))
+	    (setq menu
+		  (if (eq so-far menubar)
+		      (car (find-menu-item so-far (list (car rest))))
+		    (car (find-menu-item (cdr so-far) (list (car rest))))))
+	    (or menu
+		(let ((rest2 so-far))
+		  (while (and (cdr rest2) (car (cdr rest2)))
+		    (setq rest2 (cdr rest2)))
+		  (setcdr rest2
+		  (nconc (list (setq menu (list (car rest))))
+			 (cdr rest2)))))
+	    (setq so-far menu)
+	    (setq rest (cdr rest)))))
+    (or menu (setq menu menubar))
+    (if item
+	nil	; it's already there
+      (if item-p
+	  (setq item (vector item-name item-data enabled-p))
+	(setq item (cons item-name item-data)))
+      ;; if BEFORE is specified, try to add it there.
+      (if before
+	  (setq before (car (find-menu-item menu (list before)))))
+      (let ((rest menu)
+	    (added-before nil))
+	(while rest
+	  (if (eq before (car (cdr rest)))
+	      (progn
+		(setcdr rest (cons item (cdr rest)))
+		(setq rest nil added-before t))
+	    (setq rest (cdr rest))))
+	(if (not added-before)
+	    ;; adding before the first item on the menubar itself is harder
+	    (if (and (eq menu menubar) (eq before (car menu)))
+		(setq menu (cons item menu)
+		      current-menubar menu)
+	      ;; otherwise, add the item to the end.
+	      (nconc menu (list item))))))
+    (if item-p
+	(progn
+	  (aset item 1 item-data)
+	  (aset item 2 (not (null enabled-p))))
+      (setcar item item-name)
+      (setcdr item item-data))
+    (set-menubar-dirty-flag)
+    item))
+
+(defun add-menu-item (menu-path item-name function enabled-p &optional before)
+  "Add a menu item to some menu, creating the menu first if necessary.
+If the named item exists already, it is changed.
+MENU-PATH identifies the menu under which the new menu item should be inserted.
+ It is a list of strings; for example, (\"File\") names the top-level \"File\"
+ menu.  (\"File\" \"Foo\") names a hypothetical submenu of \"File\".
+ITEM-NAME is the string naming the menu item to be added.
+FUNCTION is the command to invoke when this menu item is selected.
+ If it is a symbol, then it is invoked with `call-interactively', in the same
+ way that functions bound to keys are invoked.  If it is a list, then the 
+ list is simply evaluated.
+ENABLED-P controls whether the item is selectable or not.
+BEFORE, if provided, is the name of a menu item before which this item should
+ be added, if this item is not on the menu already.  If the item is already
+ present, it will not be moved."
+  (or menu-path (error "must specify a menu path"))
+  (or item-name (error "must specify an item name"))
+  (add-menu-item-1 t menu-path item-name function enabled-p before))
+
+
+(defun delete-menu-item (path)
+  "Remove the named menu item from the menu hierarchy.
+PATH is a list of strings which identify the position of the menu item in 
+the menu hierarchy.  (\"File\" \"Save\") means the menu item called \"Save\"
+under the toplevel \"File\" menu.  (\"Menu\" \"Foo\" \"Item\") means the 
+menu item called \"Item\" under the \"Foo\" submenu of \"Menu\"."
+  (let* ((menubar current-menubar)
+	 (pair (find-menu-item menubar path))
+	 (item (car pair))
+	 (menu (or (cdr pair) menubar)))
+    (if (not item)
+	nil
+      ;; the menubar is the only special case, because other menus begin
+      ;; with their name.
+      (if (eq menu current-menubar)
+	  (setq current-menubar (delq item menu))
+	(delq item menu))
+      (set-menubar-dirty-flag)
+      item)))
+
+
+(defun relabel-menu-item (path new-name)
+  "Change the string of the specified menu item.
+PATH is a list of strings which identify the position of the menu item in 
+the menu hierarchy.  (\"File\" \"Save\") means the menu item called \"Save\"
+under the toplevel \"File\" menu.  (\"Menu\" \"Foo\" \"Item\") means the 
+menu item called \"Item\" under the \"Foo\" submenu of \"Menu\".
+NEW-NAME is the string that the menu item will be printed as from now on."
+  (or (stringp new-name)
+      (setq new-name (signal 'wrong-type-argument (list 'stringp new-name))))
+  (let* ((menubar current-menubar)
+	 (pair (find-menu-item menubar path))
+	 (item (car pair))
+	 (menu (cdr pair)))
+    (or item
+	(signal 'error (list (if menu "No such menu item" "No such menu")
+			     path)))
+    (if (and (consp item)
+	     (stringp (car item)))
+	(setcar item new-name)
+      (aset item 0 new-name))
+    (set-menubar-dirty-flag)
+    item))
+
+(defun add-menu (menu-path menu-name menu-items &optional before)
+  "Add a menu to the menubar or one of its submenus.
+If the named menu exists already, it is changed.
+MENU-PATH identifies the menu under which the new menu should be inserted.
+ It is a list of strings; for example, (\"File\") names the top-level \"File\"
+ menu.  (\"File\" \"Foo\") names a hypothetical submenu of \"File\".
+ If MENU-PATH is nil, then the menu will be added to the menubar itself.
+MENU-NAME is the string naming the menu to be added.
+MENU-ITEMS is a list of menu item descriptions.
+ Each menu item should be a vector of three elements:
+   - a string, the name of the menu item;
+   - a symbol naming a command, or a form to evaluate;
+   - and t or nil, whether this item is selectable.
+BEFORE, if provided, is the name of a menu before which this menu should
+ be added, if this menu is not on its parent already.  If the menu is already
+ present, it will not be moved."
+  (or menu-name (error "must specify a menu name"))
+  (or menu-items (error "must specify some menu items"))
+  (add-menu-item-1 nil menu-path menu-name menu-items t before))
+
+
+
+(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))))
+(or (assq 'menu-bar-lines default-frame-alist)
+    (setq default-frame-alist
+	  (cons '(menu-bar-lines . 1) default-frame-alist)))
+
+(set-menubar default-menubar)
+
+(provide 'menubar)
+

--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lisp/rlogin.el	Wed Mar 17 16:26:48 1993 +0000
@@ -0,0 +1,111 @@
+;;; rlogin.el -- emacs interface using comint routines from CMU
+;;;
+;;; Copyright (C) 1992 Free Software Foundation, Inc.
+;;;
+;;; This program 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.
+;;;
+;;; This program 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 this program; if not, you can either send email to this
+;;; program's author (see below) or write to:
+;;;
+;;;              The Free Software Foundation, Inc.
+;;;              675 Massachusetts Avenue.
+;;;              Cambridge, MA 02139, USA. 
+;;;
+;;; Please send bug reports, etc. to [e-mail]
+
+;;; Todo: add directory tracking using ange-ftp style patchnames for the cwd.
+
+(require 'comint)
+
+(defvar rlogin-program "rlogin"
+  "*Name of program to invoke rlogin")
+
+(defvar rlogin-mode-hook nil
+  "*Hooks to run after setting current buffer to rlogin-mode.")
+
+;; Initialize rlogin mode map.
+(defvar rlogin-mode-map '())
+(cond ((not rlogin-mode-map)
+       (setq rlogin-mode-map (full-copy-sparse-keymap comint-mode-map))
+       ;(define-key rlogin-mode-map "\M-\t" 'comint-dynamic-complete)
+       ;(define-key rlogin-mode-map "\M-?"  'comint-dynamic-list-completions)
+       (define-key rlogin-mode-map "\C-c\C-c" 'rlogin-send-Ctrl-C)
+       (define-key rlogin-mode-map "\C-c\C-z" 'rlogin-send-Ctrl-Z)
+       (define-key rlogin-mode-map "\C-c\C-\\" 'rlogin-send-Ctrl-backslash)
+       (define-key rlogin-mode-map "\C-d" 'rlogin-delchar-or-send-Ctrl-D)))
+
+(defun rlogin (host)
+  (interactive "sOpen rlogin connection to host: ")
+  (let* ((buffer-name (concat "rlogin-" host))
+         (*buffer-name* (concat "*" buffer-name "*")))
+    (cond ((not (comint-check-proc *buffer-name*))
+           (let* ((xargs-name (intern-soft "explicit-rlogin-args"))
+                  (xargs (and xargs-name (boundp xargs-name) (symbol-value xargs-name)))
+                  (process-connection-type nil)
+                  proc)
+             (if xargs
+                 (setq xargs (append xargs host))
+               (setq xargs (list host)))
+             (set-buffer (apply 'make-comint buffer-name rlogin-program nil xargs))
+             (setq proc (get-process buffer-name))
+             (set-process-filter proc 'rlogin-filter)
+             (rlogin-mode))))
+    (switch-to-buffer *buffer-name*)))
+
+(defun rlogin-mode ()
+  (interactive)
+  (comint-mode)
+  (setq comint-prompt-regexp shell-prompt-pattern)
+  (setq major-mode 'rlogin-mode)
+  (setq mode-name "Rlogin")
+  (use-local-map rlogin-mode-map)
+  (run-hooks 'rlogin-mode-hook))
+
+(defun rlogin-filter (proc string)
+  (let ((process-buffer (process-buffer proc))
+        (at-eobp (eobp)))
+    (save-excursion
+      (set-buffer process-buffer)
+      (goto-char (point-max))
+      (let ((now (point))
+            process-mark)
+        (insert string)
+        (subst-char-in-region now (point) ?\C-m ?\ )
+        (subst-char-in-region now (point) ?\M-r ?\ )
+        (setq process-mark (process-mark proc))
+        (and process-mark
+            (set-marker process-mark (point)))))
+    (and at-eobp
+         (eq process-buffer (current-buffer))
+         (goto-char (point-max)))))
+
+(defun rlogin-send-Ctrl-C ()
+  (interactive)
+  (send-string nil "\C-c"))
+
+(defun rlogin-send-Ctrl-Z ()
+  (interactive)
+  (send-string nil "\C-z"))
+
+(defun rlogin-send-Ctrl-backslash ()
+  (interactive)
+  (send-string nil "\C-\\"))
+
+(defun rlogin-delchar-or-send-Ctrl-D (arg)
+  "Delete ARG characters forward, or send a C-d to process if at end of
+buffer."  
+  (interactive "p") 
+  (if (eobp)
+      (send-string nil "\C-d")
+    (delete-char arg)))
+
+;; eof