Initial revision

20 files changed, 4815 insertions, 0 deletions

diff --git a/lisp/=grow-vers.el b/lisp/=grow-vers.el
new file mode 100644
index 00000000000..bf55146c6a6
--- /dev/null
+++ b/lisp/=grow-vers.el
@@ -0,0 +1,30 @@
+;; Load this file to add a new level (starting at zero)
+;; to the Emacs version number recorded in version.el.
+;; Copyright (C) 1985 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 1, 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.
+
+
+(insert-file-contents "lisp/version.el")
+
+(re-search-forward "emacs-version \"[0-9.]*")
+(insert ".0")
+
+;; Delete the share-link with the current version
+;; so that we do not alter the current version.
+(delete-file "lisp/version.el")
+(write-region (point-min) (point-max) "lisp/version.el" nil 'nomsg)
diff --git a/lisp/=inc-vers.el b/lisp/=inc-vers.el
new file mode 100644
index 00000000000..13a4fb17e80
--- /dev/null
+++ b/lisp/=inc-vers.el
@@ -0,0 +1,43 @@
+;; Load this file to increment the recorded Emacs version number.
+;; Copyright (C) 1985, 1986 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 1, 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.
+
+
+(insert-file-contents "../lisp/version.el")
+
+(re-search-forward "emacs-version \"[^\"]*[0-9]+\"")
+(forward-char -1)
+(save-excursion
+  (save-restriction
+    (narrow-to-region (point)
+		      (progn (skip-chars-backward "0-9") (point)))
+    (goto-char (point-min))
+    (let ((version (read (current-buffer))))
+      (delete-region (point-min) (point-max))
+      (prin1 (1+ version) (current-buffer)))))
+(skip-chars-backward "^\"")
+(message "New Emacs version will be %s"
+	 (buffer-substring (point)
+			   (progn (skip-chars-forward "^\"") (point))))
+
+
+(write-region (point-min) (point-max) "../lisp/version.el" nil 'nomsg)
+(erase-buffer)
+(set-buffer-modified-p nil)
+
+(kill-emacs)
diff --git a/lisp/=mim-syntax.el b/lisp/=mim-syntax.el
new file mode 100644
index 00000000000..c9a95b50f2f
--- /dev/null
+++ b/lisp/=mim-syntax.el
@@ -0,0 +1,91 @@
+;; Syntax checker for Mim (MDL).
+;; Copyright (C) 1985 Free Software Foundation, Inc.
+;; Principal author K. Shane Hartman
+
+;; 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 1, 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.
+
+
+(require 'mim-mode)
+
+(defun slow-syntax-check-mim ()
+  "Check Mim syntax slowly.
+Points out the context of the error, if the syntax is incorrect."
+  (interactive)
+  (message "checking syntax...")
+  (let ((stop (point-max)) point-stack current last-bracket whoops last-point)
+    (save-excursion
+      (goto-char (point-min))
+      (while (and (not whoops)
+		  (re-search-forward "\\s(\\|\\s)\\|\"\\|[\\]" stop t))
+	(setq current (preceding-char))
+	(cond ((= current ?\")
+	       (condition-case nil
+		   (progn (re-search-forward "[^\\]\"")
+			  (setq current nil))
+		 (error (setq whoops (point)))))
+	      ((= current ?\\)
+	       (condition-case nil (forward-char 1) (error nil)))
+	      ((= (char-syntax current) ?\))
+	       (if (or (not last-bracket)
+		       (not (= (logand (lsh (aref (syntax-table) last-bracket) -8)
+				       ?\177)
+			       current)))
+		   (setq whoops (point))
+		 (setq last-point (car point-stack))
+		 (setq last-bracket (if last-point (char-after (1- last-point))))
+		 (setq point-stack (cdr point-stack))))
+	      (t
+	       (if last-point (setq point-stack (cons last-point point-stack)))
+	       (setq last-point (point))
+	       (setq last-bracket current)))))
+    (cond ((not (or whoops last-point))
+	   (message "Syntax correct"))
+	  (whoops
+	   (goto-char whoops)
+	   (cond ((equal current ?\")
+		  (error "Unterminated string"))
+		 ((not last-point)
+		  (error "Extraneous %s" (char-to-string current)))
+		 (t
+		  (error "Mismatched %s with %s"
+			   (save-excursion
+			     (setq whoops (1- (point)))
+			     (goto-char (1- last-point))
+			     (buffer-substring (point)
+					       (min (progn (end-of-line) (point))
+						    whoops)))
+			   (char-to-string current)))))
+	  (t
+	   (goto-char last-point)
+	   (error "Unmatched %s" (char-to-string last-bracket))))))
+      
+(defun fast-syntax-check-mim ()
+  "Checks Mim syntax quickly.
+Answers correct or incorrect, cannot point out the error context."
+  (interactive)
+  (save-excursion
+    (goto-char (point-min))
+    (let (state)
+      (while (and (not (eobp))
+		  (equal (car (setq state (parse-partial-sexp (point) (point-max) 0)))
+			 0)))
+      (if (equal (car state) 0)
+	  (message "Syntax correct")
+	(error "Syntax incorrect")))))
+
+
+	
diff --git a/lisp/=netunam.el b/lisp/=netunam.el
new file mode 100644
index 00000000000..44d828729ef
--- /dev/null
+++ b/lisp/=netunam.el
@@ -0,0 +1,152 @@
+;; HP-UX RFA Commands
+;; Copyright (C) 1988 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 1, 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.
+
+;;; Author: cph@zurich.ai.mit.edu
+
+;;; $Header: netunam.el,v 1.3 88/12/21 16:32:23 GMT cph Exp $
+
+(defconst rfa-node-directory "/net/"
+  "Directory in which RFA network special files are stored.
+By HP convention, this is \"/net/\".")
+
+(defvar rfa-default-node nil
+  "If not nil, this is the name of the default RFA network special file.")
+
+(defvar rfa-password-memoize-p t
+  "If non-nil, remember login user's passwords after they have been entered.")
+
+(defvar rfa-password-alist '()
+  "An association from node-name strings to password strings.
+Used if `rfa-password-memoize-p' is non-nil.")
+
+(defvar rfa-password-per-node-p t
+  "If nil, login user uses same password on all machines.
+Has no effect if `rfa-password-memoize-p' is nil.")
+
+(defun rfa-set-password (password &optional node user)
+  "Add PASSWORD to the RFA password database.
+Optional second arg NODE is a string specifying a particular nodename;
+ if supplied and not nil, PASSWORD applies to only that node.
+Optional third arg USER is a string specifying the (remote) user whose
+ password this is; if not supplied this defaults to (user-login-name)."
+  (if (not user) (setq user (user-login-name)))
+  (let ((node-entry (assoc node rfa-password-alist)))
+    (if node-entry
+	(let ((user-entry (assoc user (cdr node-entry))))
+	  (if user-entry
+	      (rplacd user-entry password)
+	      (rplacd node-entry
+		      (nconc (cdr node-entry)
+			     (list (cons user password))))))
+	(setq rfa-password-alist
+	      (nconc rfa-password-alist
+		     (list (list node (cons user password))))))))
+
+(defun rfa-open (node &optional user password)
+  "Open a network connection to a server using remote file access.
+First argument NODE is the network node for the remote machine.
+Second optional argument USER is the user name to use on that machine.
+  If called interactively, the user name is prompted for.
+Third optional argument PASSWORD is the password string for that user.
+  If not given, this is filled in from the value of
+`rfa-password-alist', or prompted for.  A prefix argument of - will
+cause the password to be prompted for even if previously memoized."
+  (interactive
+   (list (read-file-name "rfa-open: " rfa-node-directory rfa-default-node t)
+	 (read-string "user-name: " (user-login-name))))
+  (let ((node
+	 (and (or rfa-password-per-node-p
+		  (not (equal user (user-login-name))))
+	      node)))
+    (if (not password)
+	(setq password
+	      (let ((password
+		     (cdr (assoc user (cdr (assoc node rfa-password-alist))))))
+		(or (and (not current-prefix-arg) password)
+		    (rfa-password-read
+		     (format "password for user %s%s: "
+			     user
+			     (if node (format " on node \"%s\"" node) ""))
+		     password))))))
+  (let ((result
+	 (sysnetunam (expand-file-name node rfa-node-directory)
+		     (concat user ":" password))))
+    (if (interactive-p)
+	(if result
+	    (message "Opened network connection to %s as %s" node user)
+	    (error "Unable to open network connection")))
+    (if (and rfa-password-memoize-p result)
+	(rfa-set-password password node user))
+    result))
+
+(defun rfa-close (node)
+  "Close a network connection to a server using remote file access.
+NODE is the network node for the remote machine."
+  (interactive
+   (list (read-file-name "rfa-close: " rfa-node-directory rfa-default-node t)))
+  (let ((result (sysnetunam (expand-file-name node rfa-node-directory) "")))
+    (cond ((not (interactive-p)) result)
+	  ((not result) (error "Unable to close network connection"))
+	  (t (message "Closed network connection to %s" node)))))
+
+(defun rfa-password-read (prompt default)
+  (let ((rfa-password-accumulator (or default "")))
+    (read-from-minibuffer prompt
+			  (and default
+			       (let ((copy (concat default))
+				     (index 0)
+				     (length (length default)))
+				 (while (< index length)
+				   (aset copy index ?.)
+				   (setq index (1+ index)))
+				 copy))
+			  rfa-password-map)
+    rfa-password-accumulator))
+
+(defvar rfa-password-map nil)
+(if (not rfa-password-map)
+    (let ((char ? ))
+      (setq rfa-password-map (make-keymap))
+      (while (< char 127)
+	(define-key rfa-password-map (char-to-string char)
+	  'rfa-password-self-insert)
+	(setq char (1+ char)))
+      (define-key rfa-password-map "\C-g"
+	'abort-recursive-edit)
+      (define-key rfa-password-map "\177"
+	'rfa-password-rubout)
+      (define-key rfa-password-map "\n"
+	'exit-minibuffer)
+      (define-key rfa-password-map "\r"
+	'exit-minibuffer)))
+
+(defvar rfa-password-accumulator nil)
+
+(defun rfa-password-self-insert ()
+  (interactive)
+  (setq rfa-password-accumulator
+	(concat rfa-password-accumulator
+		(char-to-string last-command-char)))
+  (insert ?.))
+
+(defun rfa-password-rubout ()
+  (interactive)
+  (delete-char -1)
+  (setq rfa-password-accumulator
+	(substring rfa-password-accumulator 0 -1)))
diff --git a/lisp/=sun-keys.el b/lisp/=sun-keys.el
new file mode 100644
index 00000000000..59fba2a5791
--- /dev/null
+++ b/lisp/=sun-keys.el
@@ -0,0 +1,71 @@
+;;;
+;;; Support (cleanly) for Sun function keys.  Provides help facilities,
+;;; better diagnostics, etc.
+;;;
+;;; To use: make sure your .ttyswrc binds 'F1' to <ESC> * F1 <CR> and so on.
+;;;         load this lot from your start_up
+;;;
+;;; 
+;;;    Copyright (C) 1986 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 1, 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.
+;;;
+;;; Batten@uk.ac.bham.multics (Ian G. Batten)
+;;;
+
+(defun sun-function-keys-dispatch (arg)
+  "Dispatcher for function keys."
+  (interactive "p")
+  (let* ((key-stroke (read t))
+         (command (assq key-stroke sun-function-keys-command-list)))
+    (cond (command (funcall (cdr command) arg))
+          (t (error "Unbound function key %s" key-stroke)))))
+
+(defvar sun-function-keys-command-list 
+  '((F1 . sun-function-keys-describe-bindings)
+    (R8 . previous-line)                ; arrow keys
+    (R10 . backward-char)
+    (R12 . forward-char)
+    (R14 . next-line)))
+
+(defun sun-function-keys-bind-key (arg1 arg2)
+  "Bind a specified key."
+  (interactive "xFunction Key Cap Label:
+CCommand To Use:")
+  (setq sun-function-keys-command-list 
+        (cons (cons arg1 arg2) sun-function-keys-command-list)))
+
+(defun sun-function-keys-describe-bindings (arg)
+  "Describe the function key bindings we're running"
+  (interactive)
+  (with-output-to-temp-buffer "*Help*"
+    (sun-function-keys-write-bindings
+     (sort (copy-sequence sun-function-keys-command-list)
+           '(lambda (x y) (string-lessp (car x) (car y)))))))
+
+(defun sun-function-keys-write-bindings (list)
+  (cond ((null list)
+         t)
+        (t
+         (princ (format "%s: %s\n" 
+                        (car (car list))
+                        (cdr (car list))))
+         (sun-function-keys-write-bindings (cdr list)))))
+    
+(global-set-key "\e*" 'sun-function-keys-dispatch)
+
+(make-variable-buffer-local 'sun-function-keys-command-list)
diff --git a/lisp/=vmsx.el b/lisp/=vmsx.el
new file mode 100644
index 00000000000..a68c6de3796
--- /dev/null
+++ b/lisp/=vmsx.el
@@ -0,0 +1,137 @@
+;; Run asynchronous VMS subprocesses under Emacs
+;; Copyright (C) 1986 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 1, 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.
+
+;; Written by Mukesh Prasad.
+
+(defvar display-subprocess-window nil
+  "If non-nil, the suprocess window is displayed whenever input is received.")
+
+(defvar command-prefix-string "$ "
+  "String to insert to distinguish commands entered by user.")
+
+(defvar subprocess-running nil)
+(defvar command-mode-map nil)
+
+(if command-mode-map
+    nil
+  (setq command-mode-map (make-sparse-keymap))
+  (define-key command-mode-map "\C-m" 'command-send-input)
+  (define-key command-mode-map "\C-u" 'command-kill-line))
+
+(defun subprocess-input (name str)
+   "Handles input from a subprocess.  Called by Emacs."
+   (if display-subprocess-window
+      (display-buffer subprocess-buf))
+   (let ((old-buffer (current-buffer)))
+      (set-buffer subprocess-buf)
+      (goto-char (point-max))
+      (insert str)
+      (insert ?\n)
+      (set-buffer old-buffer)))
+
+(defun subprocess-exit (name)
+   "Called by Emacs upon subprocess exit."
+   (setq subprocess-running nil))
+
+(defun start-subprocess ()
+   "Spawns an asynchronous subprocess with output redirected to
+the buffer *COMMAND*.  Within this buffer, use C-m to send
+the last line to the subprocess or to bring another line to
+the end."
+   (if subprocess-running
+       (return t))
+   (setq subprocess-buf (get-buffer-create "*COMMAND*"))
+   (save-excursion
+	(set-buffer subprocess-buf)
+	(use-local-map command-mode-map))
+   (setq subprocess-running (spawn-subprocess 1 'subprocess-input
+                                               'subprocess-exit))
+   ;; Initialize subprocess so it doesn't panic and die upon
+   ;; encountering the first error.
+   (and subprocess-running
+        (send-command-to-subprocess 1 "ON SEVERE_ERROR THEN CONTINUE")))
+
+(defvar subprocess-command-to-buffer-tmpdir "SYS$SCRATCH:"
+  "*Put temporary files from subprocess-command-to-buffer here.")
+
+(defun subprocess-command-to-buffer (command buffer)
+  "Execute command and redirect output into buffer.
+
+BUGS: only the output up to the end of the first image activation is trapped."
+  (if (not subprocess-running) 
+	  (start-subprocess))
+  (save-excursion
+	(set-buffer buffer)
+	(let ((output-filename
+	       (concat subprocess-command-to-buffer-tmpdir
+		       "OUTPUT-FOR-" (getenv "USER") ".LISTING")))
+	  (while (file-attributes output-filename)
+	    (delete-file output-filename))
+	  (send-command-to-subprocess 1 (concat "DEFINE/USER SYS$OUTPUT "
+						output-filename "-NEW"))
+	  (send-command-to-subprocess 1 command)
+	  (send-command-to-subprocess 1 (concat "RENAME " output-filename 
+						"-NEW " output-filename))
+	  (while (not (file-attributes output-filename))
+	    (sleep-for 2))
+	  (insert-file output-filename))))
+
+(defun subprocess-command ()
+  "Starts asynchronous subprocess if not running and switches to its window."
+  (interactive)
+  (if (not subprocess-running)
+      (start-subprocess))
+  (and subprocess-running
+      (progn (pop-to-buffer subprocess-buf) (goto-char (point-max)))))
+
+(defun command-send-input ()
+  "If at last line of buffer, sends the current line to
+the spawned subprocess.  Otherwise brings back current
+line to the last line for resubmission."
+  (interactive)
+  (beginning-of-line)
+  (let ((current-line (buffer-substring (point)
+                                        (progn (end-of-line) (point)))))
+    (if (eobp)
+      (progn
+        (if (not subprocess-running)
+            (start-subprocess))
+        (if subprocess-running
+          (progn
+            (beginning-of-line)
+            (send-command-to-subprocess 1 current-line)
+            (if command-prefix-string
+              (progn (beginning-of-line) (insert command-prefix-string)))
+            (next-line 1))))
+      ;; else -- if not at last line in buffer
+      (end-of-buffer)
+      (backward-char)
+      (next-line 1)
+      (if (string-equal command-prefix-string
+                (substring current-line 0 (length command-prefix-string)))
+	  (insert (substring current-line (length command-prefix-string)))
+          (insert current-line)))))
+
+(defun command-kill-line()
+  "Kills the current line.  Used in command mode."
+  (interactive)
+  (beginning-of-line)
+  (kill-line))
+
+(define-key esc-map "$" 'subprocess-command)
diff --git a/lisp/electric.el b/lisp/electric.el
new file mode 100644
index 00000000000..be992c60f0d
--- /dev/null
+++ b/lisp/electric.el
@@ -0,0 +1,181 @@
+;; electric -- Window maker and Command loop for `electric' modes.
+;; Copyright (C) 1985, 1986 Free Software Foundation, Inc.
+;; Principal author K. Shane Hartman
+
+;; 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 1, 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.
+
+
+(provide 'electric)                           ; zaaaaaaap
+
+;; perhaps this should be in subr.el...
+(defun shrink-window-if-larger-than-buffer (window)
+  (save-excursion
+    (set-buffer (window-buffer window))
+    (let ((w (selected-window)) ;save-window-excursion can't win
+	  (buffer-file-name buffer-file-name)
+	  (p (point))
+	  (n 0)
+	  (window-min-height 0)
+	  (buffer-read-only nil)
+	  (modified (buffer-modified-p))
+	  (buffer (current-buffer)))
+      (unwind-protect
+	  (progn
+	    (select-window window)
+	    (goto-char (point-min))
+	    (while (pos-visible-in-window-p (point-max))
+	      ;; defeat file locking... don't try this at home, kids!
+	      (setq buffer-file-name nil)
+	      (insert ?\n) (setq n (1+ n)))
+	    (if (> n 0) (shrink-window (1- n))))
+	(delete-region (point-min) (point))
+	(set-buffer-modified-p modified)
+	(goto-char p)
+	(select-window w)
+	;; Make sure we unbind buffer-read-only
+	;; with the proper current buffer.
+	(set-buffer buffer)))))
+      
+;; This loop is the guts for non-standard modes which retain control
+;; until some event occurs.  It is a `do-forever', the only way out is to
+;; throw.  It assumes that you have set up the keymap, window, and
+;; everything else: all it does is read commands and execute them -
+;; providing error messages should one occur (if there is no loop
+;; function - which see).  The required argument is a tag which should
+;; expect a value of nil if the user decides to punt. The
+;; second argument is a prompt string (defaults to "->").  Given third
+;; argument non-nil, it INHIBITS quitting unless the user types C-g at
+;; toplevel.  This is so user can do things like C-u C-g and not get
+;; thrown out.  Fourth argument, if non-nil, should be a function of two
+;; arguments which is called after every command is executed.  The fifth
+;; argument, if provided, is the state variable for the function.  If the
+;; loop-function gets an error, the loop will abort WITHOUT throwing
+;; (moral: use unwind-protect around call to this function for any
+;; critical stuff).  The second argument for the loop function is the
+;; conditions for any error that occurred or nil if none.
+
+(defun Electric-command-loop (return-tag
+			      &optional prompt inhibit-quit
+					loop-function loop-state)
+  (if (not prompt) (setq prompt "->"))
+  (let (cmd (err nil))
+    (while t
+      (setq cmd (read-key-sequence (if (stringp prompt)
+				       prompt (funcall prompt))))
+      (setq last-command-char (aref cmd (1- (length cmd)))
+	    this-command (key-binding cmd)
+	    cmd this-command)
+      (if (or (prog1 quit-flag (setq quit-flag nil))
+	      (= last-input-char ?\C-g))
+	  (progn (setq unread-command-char -1
+		       prefix-arg nil)
+		 ;; If it wasn't cancelling a prefix character, then quit.
+		 (if (or (= (length (this-command-keys)) 1)
+			 (not inhibit-quit)) ; safety
+		     (progn (ding)
+			    (message "Quit")
+			    (throw return-tag nil))
+		   (setq cmd nil))))
+      (setq current-prefix-arg prefix-arg)
+      (if cmd
+	  (condition-case conditions
+	      (progn (command-execute cmd)
+		     (if (or (prog1 quit-flag (setq quit-flag nil))
+			     (= last-input-char ?\C-g))
+			 (progn (setq unread-command-char -1)
+				(if (not inhibit-quit)
+				    (progn (ding)
+					   (message "Quit")
+					   (throw return-tag nil))
+				  (ding)))))
+	    (buffer-read-only (if loop-function
+				  (setq err conditions)
+				(ding)
+				(message "Buffer is read-only")
+				(sit-for 2)))
+	    (beginning-of-buffer (if loop-function
+				     (setq err conditions)
+				   (ding)
+				   (message "Beginning of Buffer")
+				   (sit-for 2)))
+	    (end-of-buffer (if loop-function
+			       (setq err conditions)
+			     (ding)
+			     (message "End of Buffer")
+			     (sit-for 2)))
+	    (error (if loop-function
+		       (setq err conditions)
+		     (ding)
+		     (message "Error: %s"
+			      (if (eq (car conditions) 'error)
+				  (car (cdr conditions))
+				(prin1-to-string conditions)))
+		     (sit-for 2))))
+	(ding))
+      (if loop-function (funcall loop-function loop-state err))))
+  (ding)
+  (throw return-tag nil))
+
+;; This function is like pop-to-buffer, sort of. 
+;; The algorithm is
+;; If there is a window displaying buffer
+;; 	Select it
+;; Else if there is only one window
+;; 	Split it, selecting the window on the bottom with height being
+;; 	the lesser of max-height (if non-nil) and the number of lines in
+;;      the buffer to be displayed subject to window-min-height constraint.
+;; Else
+;; 	Switch to buffer in the current window.
+;;
+;; Then if max-height is nil, and not all of the lines in the buffer
+;; are displayed, grab the whole screen.
+;;
+;; Returns selected window on buffer positioned at point-min.
+
+(defun Electric-pop-up-window (buffer &optional max-height)
+  (let* ((win (or (get-buffer-window buffer) (selected-window)))
+	 (buf (get-buffer buffer))
+	 (one-window (one-window-p t))
+	 (pop-up-windows t)
+	 (target-height)
+	 (lines))
+    (if (not buf)
+	(error "Buffer %s does not exist" buffer)
+      (save-excursion
+	(set-buffer buf)
+	(setq lines (count-lines (point-min) (point-max)))
+	(setq target-height
+	      (min (max (if max-height (min max-height (1+ lines)) (1+ lines))
+			window-min-height)
+		   (save-window-excursion
+		     (delete-other-windows)
+		     (1- (window-height (selected-window)))))))
+      (cond ((and (eq (window-buffer win) buf))
+	     (select-window win))
+	    (one-window
+	     (goto-char (window-start win))
+	     (pop-to-buffer buffer)
+	     (setq win (selected-window))
+	     (enlarge-window (- target-height (window-height win))))
+	    (t
+	     (switch-to-buffer buf)))
+      (if (and (not max-height)
+	       (> target-height (window-height (selected-window))))
+	  (progn (goto-char (window-start win))
+		 (enlarge-window (- target-height (window-height win)))))
+      (goto-char (point-min))
+      win)))
diff --git a/lisp/emulation/mlsupport.el b/lisp/emulation/mlsupport.el
new file mode 100644
index 00000000000..14e7a3c9557
--- /dev/null
+++ b/lisp/emulation/mlsupport.el
@@ -0,0 +1,405 @@
+;; Run-time support for mocklisp code.
+;; Copyright (C) 1985 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 1, 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.
+
+
+(provide 'mlsupport)
+
+(defmacro ml-defun (&rest defs)
+  (list 'ml-defun-1 (list 'quote defs)))
+
+(defun ml-defun-1 (args)
+  (while args
+    (fset (car (car args)) (cons 'mocklisp (cdr (car args))))
+    (setq args (cdr args))))
+
+(defmacro declare-buffer-specific (&rest vars)
+  (cons 'progn (mapcar (function (lambda (var) (list 'make-variable-buffer-local (list 'quote var)))) vars)))
+
+(defun ml-set-default (varname value)
+  (set-default (intern varname) value))
+
+; Lossage: must make various things default missing args to the prefix arg
+; Alternatively, must make provide-prefix-argument do something hairy.
+
+(defun >> (val count) (lsh val (- count)))
+(defun novalue () nil)
+
+(defun ml-not (arg) (if (zerop arg) 1 0))
+
+(defun provide-prefix-arg (arg form)
+  (funcall (car form) arg))
+
+(defun define-keymap (name)
+  (fset (intern name) (make-keymap)))
+
+(defun ml-use-local-map (name)
+  (use-local-map (intern (concat name "-map"))))
+
+(defun ml-use-global-map (name)
+  (use-global-map (intern (concat name "-map"))))
+
+(defun local-bind-to-key (name key)
+  (or (current-local-map)
+      (use-local-map (make-keymap)))
+  (define-key (current-local-map)
+    (if (integerp key)
+	(if (>= key 128)
+	    (concat (char-to-string meta-prefix-char)
+		    (char-to-string (- key 128)))
+	  (char-to-string key))
+      key)
+    (intern name)))
+
+(defun bind-to-key (name key)
+  (define-key global-map (if (integerp key) (char-to-string key) key)
+    (intern name)))
+
+(defun ml-autoload (name file)
+  (autoload (intern name) file))
+
+(defun ml-define-string-macro (name defn)
+  (fset (intern name) defn))
+
+(defun push-back-character (char)
+  (setq unread-command-char char))
+
+(defun to-col (column)
+  (indent-to column 0))
+
+(defmacro is-bound (&rest syms)
+  (cons 'and (mapcar (function (lambda (sym) (list 'boundp (list 'quote sym)))) syms)))
+
+(defmacro declare-global (&rest syms)
+  (cons 'progn (mapcar (function (lambda (sym) (list 'defvar sym nil))) syms)))
+
+(defmacro error-occurred (&rest body)
+  (list 'condition-case nil (cons 'progn (append body '(nil))) '(error t)))
+
+(defun return-prefix-argument (value)
+  (setq prefix-arg value))
+
+(defun ml-prefix-argument ()
+  (if (null current-prefix-arg) 1
+    (if (listp current-prefix-arg) (car current-prefix-arg)
+      (if (eq current-prefix-arg '-) -1
+	current-prefix-arg))))
+
+(defun ml-print (varname)
+  (interactive "vPrint variable: ")
+  (if (boundp varname)
+    (message "%s => %s" (symbol-name varname) (symbol-value varname))
+    (message "%s has no value" (symbol-name varname))))
+
+(defun ml-set (str val) (set (intern str) val))
+
+(defun ml-message (&rest args) (message "%s" (apply 'concat args)))
+
+(defun kill-to-end-of-line ()
+  (ml-prefix-argument-loop
+    (if (eolp)
+	(kill-region (point) (1+ (point)))
+      (kill-region (point) (if (search-forward ?\n nil t)
+			       (1- (point)) (point-max))))))
+
+(defun set-auto-fill-hook (arg)
+  (setq auto-fill-function (intern arg)))
+
+(defun auto-execute (function pattern)
+  (if (/= (aref pattern 0) ?*)
+      (error "Only patterns starting with * supported in auto-execute"))
+  (setq auto-mode-alist (cons (cons (concat "\\." (substring pattern 1)
+					    "$")
+				    function)
+			      auto-mode-alist)))
+
+(defun move-to-comment-column ()
+  (indent-to comment-column))
+
+(defun erase-region ()
+  (delete-region (point) (mark)))
+
+(defun delete-region-to-buffer (bufname)
+  (copy-to-buffer bufname (point) (mark))
+  (delete-region (point) (mark)))
+
+(defun copy-region-to-buffer (bufname)
+  (copy-to-buffer bufname (point) (mark)))
+
+(defun append-region-to-buffer (bufname)
+  (append-to-buffer bufname (point) (mark)))
+
+(defun prepend-region-to-buffer (bufname)
+  (prepend-to-buffer bufname (point) (mark)))
+
+(defun delete-next-character ()
+  (delete-char (ml-prefix-argument)))
+
+(defun delete-next-word ()
+  (delete-region (point) (progn (forward-word (ml-prefix-argument)) (point))))
+
+(defun delete-previous-word ()
+  (delete-region (point) (progn (backward-word (ml-prefix-argument)) (point))))
+
+(defun delete-previous-character ()
+  (delete-backward-char (ml-prefix-argument)))
+
+(defun forward-character ()
+  (forward-char (ml-prefix-argument)))
+
+(defun backward-character ()
+  (backward-char (ml-prefix-argument)))
+
+(defun ml-newline ()
+  (newline (ml-prefix-argument)))
+
+(defun ml-next-line ()
+  (next-line (ml-prefix-argument)))
+
+(defun ml-previous-line ()
+  (previous-line (ml-prefix-argument)))
+
+(defun delete-to-kill-buffer ()
+  (kill-region (point) (mark)))
+
+(defun narrow-region ()
+  (narrow-to-region (point) (mark)))
+
+(defun ml-newline-and-indent ()
+  (let ((column (current-indentation)))
+    (newline (ml-prefix-argument))
+    (indent-to column)))
+
+(defun newline-and-backup ()
+  (open-line (ml-prefix-argument)))
+
+(defun quote-char ()
+  (quoted-insert (ml-prefix-argument)))
+
+(defun ml-current-column ()
+  (1+ (current-column)))
+
+(defun ml-current-indent ()
+  (1+ (current-indentation)))
+
+(defun region-around-match (&optional n)
+  (set-mark (match-beginning n))
+  (goto-char (match-end n)))
+
+(defun region-to-string ()
+  (buffer-substring (min (point) (mark)) (max (point) (mark))))
+
+(defun use-abbrev-table (name)
+  (let ((symbol (intern (concat name "-abbrev-table"))))
+    (or (boundp symbol)
+	(define-abbrev-table symbol nil))
+    (symbol-value symbol)))
+
+(defun define-hooked-local-abbrev (name exp hook)
+  (define-local-abbrev name exp (intern hook)))
+
+(defun define-hooked-global-abbrev (name exp hook)
+  (define-global-abbrev name exp (intern hook)))
+
+(defun case-word-lower ()
+  (ml-casify-word 'downcase-region))
+
+(defun case-word-upper ()
+  (ml-casify-word 'upcase-region))
+
+(defun case-word-capitalize ()
+  (ml-casify-word 'capitalize-region))
+
+(defun ml-casify-word (fun)
+  (save-excursion
+   (forward-char 1)
+   (forward-word -1)
+   (funcall fun (point)
+	    (progn (forward-word (ml-prefix-argument))
+		   (point)))))
+
+(defun case-region-lower ()
+  (downcase-region (point) (mark)))
+
+(defun case-region-upper ()
+  (upcase-region (point) (mark)))
+
+(defun case-region-capitalize ()
+  (capitalize-region (point) (mark)))
+
+(defvar saved-command-line-args nil)
+
+(defun argc ()
+  (or saved-command-line-args
+      (setq saved-command-line-args command-line-args
+	    command-line-args ()))
+  (length command-line-args))
+
+(defun argv (i)
+  (or saved-command-line-args
+      (setq saved-command-line-args command-line-args
+	    command-line-args ()))
+  (nth i saved-command-line-args))
+
+(defun invisible-argc ()
+  (length (or saved-command-line-args
+	      command-line-args)))
+
+(defun invisible-argv (i)
+  (nth i (or saved-command-line-args
+	     command-line-args)))
+
+(defun exit-emacs ()
+  (interactive)
+  (condition-case ()
+      (exit-recursive-edit)
+    (error (kill-emacs))))
+
+;; Lisp function buffer-size returns total including invisible;
+;; mocklisp wants just visible.
+(defun ml-buffer-size ()
+  (- (point-max) (point-min)))
+
+(defun previous-command ()
+  last-command)
+
+(defun beginning-of-window ()
+  (goto-char (window-start)))
+
+(defun end-of-window ()
+  (goto-char (window-start))
+  (vertical-motion (- (window-height) 2)))
+
+(defun ml-search-forward (string)
+  (search-forward string nil nil (ml-prefix-argument)))
+
+(defun ml-re-search-forward (string)
+  (re-search-forward string nil nil (ml-prefix-argument)))
+
+(defun ml-search-backward (string)
+  (search-backward string nil nil (ml-prefix-argument)))
+
+(defun ml-re-search-backward (string)
+  (re-search-backward string nil nil (ml-prefix-argument)))
+
+(defvar use-users-shell 1
+  "Mocklisp compatibility variable; 1 means use shell from SHELL env var.
+0 means use /bin/sh.")
+
+(defvar use-csh-option-f 1
+  "Mocklisp compatibility variable; 1 means pass -f when calling csh.")
+
+(defun filter-region (command)
+  (let ((shell (if (/= use-users-shell 0) shell-file-name "/bin/sh"))
+	(csh (equal (file-name-nondirectory shell) "csh")))
+    (call-process-region (point) (mark) shell t t nil
+			 (if (and csh use-csh-option-f) "-cf" "-c")
+			 (concat "exec " command))))
+
+(defun execute-monitor-command (command)
+  (let ((shell (if (/= use-users-shell 0) shell-file-name "/bin/sh"))
+	(csh (equal (file-name-nondirectory shell) "csh")))
+    (call-process shell nil t t
+		  (if (and csh use-csh-option-f) "-cf" "-c")
+		  (concat "exec " command))))
+
+(defun use-syntax-table (name)
+  (set-syntax-table (symbol-value (intern (concat name "-syntax-table")))))
+
+(defun line-to-top-of-window ()
+  (recenter (1- (ml-prefix-argument))))
+
+(defun ml-previous-page (&optional arg)
+  (let ((count (or arg (ml-prefix-argument))))
+    (while (> count 0)
+      (scroll-down nil)
+      (setq count (1- count)))
+    (while (< count 0)
+      (scroll-up nil)
+      (setq count (1+ count)))))
+
+(defun ml-next-page ()
+  (previous-page (- (ml-prefix-argument))))
+
+(defun page-next-window (&optional arg)
+  (let ((count (or arg (ml-prefix-argument))))
+    (while (> count 0)
+      (scroll-other-window nil)
+      (setq count (1- count)))
+    (while (< count 0)
+      (scroll-other-window '-)
+      (setq count (1+ count)))))
+
+(defun ml-next-window ()
+  (select-window (next-window)))
+
+(defun ml-previous-window ()
+  (select-window (previous-window)))
+
+(defun scroll-one-line-up ()
+  (scroll-up (ml-prefix-argument)))
+
+(defun scroll-one-line-down ()
+  (scroll-down (ml-prefix-argument)))
+
+(defun split-current-window ()
+  (split-window (selected-window)))
+
+(defun last-key-struck () last-command-char)
+
+(defun execute-mlisp-line (string)
+  (eval (read string)))
+
+(defun move-dot-to-x-y (x y)
+  (goto-char (window-start (selected-window)))
+  (vertical-motion (1- y))
+  (move-to-column (1- x)))
+
+(defun ml-modify-syntax-entry (string)
+  (let ((i 5)
+	(len (length string))
+	(datastring (substring string 0 2)))
+    (if (= (aref string 0) ?\-)
+	(aset datastring 0 ?\ ))
+    (if (= (aref string 2) ?\{)
+	(if (= (aref string 4) ?\ )
+	    (aset datastring 0 ?\<)
+	  (error "Two-char comment delimiter: use modify-syntax-entry directly")))
+    (if (= (aref string 3) ?\})
+	(if (= (aref string 4) ?\ )
+	    (aset datastring 0 ?\>)
+	  (error "Two-char comment delimiter: use modify-syntax-entry directly")))
+    (while (< i len)
+      (modify-syntax-entry (aref string i) datastring)
+      (setq i (1+ i))
+      (if (and (< i len)
+	       (= (aref string i) ?\-))
+	  (let ((c (aref string (1- i)))
+		(lim (aref string (1+ i))))
+	    (while (<= c lim)
+	      (modify-syntax-entry c datastring)
+	      (setq c (1+ c)))
+	    (setq i (+ 2 i)))))))
+
+
+
+(defun ml-substr (string from to)
+  (let ((length (length string)))
+    (if (< from 0) (setq from (+ from length)))
+    (if (< to 0) (setq to (+ to length)))
+    (substring string from (+ from to))))
diff --git a/lisp/loadup.el b/lisp/loadup.el
new file mode 100644
index 00000000000..9447c74891d
--- /dev/null
+++ b/lisp/loadup.el
@@ -0,0 +1,140 @@
+;;Load up standardly loaded Lisp files for Emacs.
+;; This is loaded into a bare Emacs to make a dumpable one.
+;; Copyright (C) 1985, 1986 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 1, 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.
+
+
+(load "subr")
+(garbage-collect)
+(load "loaddefs.el")  ;Don't get confused if someone compiled loaddefs by mistake.
+(garbage-collect)
+(load "simple")
+(garbage-collect)
+(load "help")
+(garbage-collect)
+(load "files")
+(garbage-collect)
+(load "indent")
+(load "window")
+(load "paths.el")  ;Don't get confused if someone compiled paths by mistake.
+(garbage-collect)
+(load "startup")
+(load "lisp")
+(garbage-collect)
+(load "page")
+(load "register")
+(garbage-collect)
+(load "paragraphs")
+(load "lisp-mode")
+(garbage-collect)
+(load "text-mode")
+(load "fill")
+(garbage-collect)
+(load "c-mode")
+(garbage-collect)
+(load "isearch")
+(garbage-collect)
+(load "replace")
+(if (eq system-type 'vax-vms)
+    (progn
+      (garbage-collect)
+      (load "vmsproc")))
+(garbage-collect)
+(load "abbrev")
+(garbage-collect)
+(load "buff-menu")
+(if (eq system-type 'vax-vms)
+    (progn
+      (garbage-collect)
+      (load "vms-patch")))
+(if (fboundp 'atan)	; preload some constants and 
+    (progn		; floating pt. functions if 
+      (garbage-collect)	; we have float support.
+      (load "float-sup")))
+
+;If you want additional libraries to be preloaded and their
+;doc strings kept in the DOC file rather than in core,
+;you may load them with a "site-load.el" file.
+;But you must also cause them to be scanned when the DOC file
+;is generated.  For VMS, you must edit ../etc/makedoc.com.
+;For other systems, you must edit ../src/ymakefile.
+(if (load "site-load" t)
+    (garbage-collect))
+
+(load "version.el")  ;Don't get confused if someone compiled version.el by mistake.
+
+;; Note: all compiled Lisp files loaded above this point
+;; must be among the ones parsed by make-docfile
+;; to construct DOC.  Any that are not processed
+;; for DOC will not have doc strings in the dumped Emacs.
+
+(message "Finding pointers to doc strings...")
+(if (fboundp 'dump-emacs)
+    (let ((name emacs-version))
+      (while (string-match "[^-+_.a-zA-Z0-9]+" name)
+	(setq name (concat (downcase (substring name 0 (match-beginning 0)))
+			   "-"
+			   (substring name (match-end 0)))))
+      (copy-file (expand-file-name "../etc/DOC")
+		 (concat (expand-file-name "../etc/DOC-") name)
+		 t)
+      (Snarf-documentation (concat "DOC-" name)))
+    (Snarf-documentation "DOC"))
+(message "Finding pointers to doc strings...done")
+
+;Note: You can cause additional libraries to be preloaded
+;by writing a site-init.el that loads them.
+;See also "site-load" above.
+(load "site-init" t)
+(garbage-collect)
+
+(if (or (equal (nth 3 command-line-args) "dump")
+	(equal (nth 4 command-line-args) "dump"))
+    (if (eq system-type 'vax-vms)
+	(progn 
+	  (message "Dumping data as file temacs.dump")
+	  (dump-emacs "temacs.dump" "temacs")
+	  (kill-emacs))
+      (let ((name (concat "emacs-" emacs-version)))
+	(while (string-match "[^-+_.a-zA-Z0-9]+" name)
+	  (setq name (concat (downcase (substring name 0 (match-beginning 0)))
+			     "-"
+			     (substring name (match-end 0)))))
+	(message "Dumping under names xemacs and %s" name))
+      (condition-case ()
+	  (delete-file "xemacs")
+	(file-error nil))
+      (dump-emacs "xemacs" "temacs")
+      ;; Recompute NAME now, so that it isn't set when we dump.
+      (let ((name (concat "emacs-" emacs-version)))
+	(while (string-match "[^-+_.a-zA-Z0-9]+" name)
+	  (setq name (concat (downcase (substring name 0 (match-beginning 0)))
+			     "-"
+			     (substring name (match-end 0)))))
+	(add-name-to-file "xemacs" name t))
+      (kill-emacs)))
+
+;; Avoid error if user loads some more libraries now.
+(setq purify-flag nil)
+
+;; For machines with CANNOT_DUMP defined in config.h,
+;; this file must be loaded each time Emacs is run.
+;; So run the startup code now.
+
+(or (fboundp 'dump-emacs)
+    (eval top-level))
diff --git a/lisp/mail/rmailmsc.el b/lisp/mail/rmailmsc.el
new file mode 100644
index 00000000000..c57b15c4c3a
--- /dev/null
+++ b/lisp/mail/rmailmsc.el
@@ -0,0 +1,45 @@
+;; Copyright (C) 1985 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 1, 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.
+
+
+(defun set-rmail-inbox-list (file-name)
+  "Set the inbox list of the current RMAIL file to FILE-NAME.
+This may be a list of file names separated by commas.
+If FILE-NAME is empty, remove any inbox list."
+  (interactive "sSet mailbox list to (comma-separated list of filenames): ")
+  (save-excursion
+    (let ((names (rmail-parse-file-inboxes))
+	  (standard-output nil))
+      (if (or (not names)
+	      (y-or-n-p (concat "Replace "
+				(mapconcat 'identity names ", ")
+				"? ")))
+	  (let ((buffer-read-only nil))
+	    (widen)
+	    (goto-char (point-min))
+	    (search-forward "\n\^_")
+	    (re-search-backward "^Mail" nil t)
+	    (forward-line 0)
+	    (if (looking-at "Mail:")
+		(delete-region (point)
+			       (progn (forward-line 1)
+				      (point))))
+	    (if (not (string= file-name ""))
+		(insert "Mail: " file-name "\n"))))))
+  (setq rmail-inbox-list (rmail-parse-file-inboxes))
+  (rmail-show-message rmail-current-message))
diff --git a/lisp/mail/rnews.el b/lisp/mail/rnews.el
new file mode 100644
index 00000000000..64b98ca407b
--- /dev/null
+++ b/lisp/mail/rnews.el
@@ -0,0 +1,979 @@
+;;; USENET news reader for gnu emacs
+;; Copyright (C) 1985, 1986, 1987 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 1, 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.
+
+;; Created Sun Mar 10,1985 at 21:35:01 ads and sundar@hernes.ai.mit.edu
+;; Should do the point pdl stuff sometime
+;; finito except pdl.... Sat Mar 16,1985 at 06:43:44
+;; lets keep the summary stuff out until we get it working ..
+;;	sundar@hermes.ai.mit.edu Wed Apr 10,1985 at 16:32:06
+;; hack slash maim. mly@prep.ai.mit.edu Thu 18 Apr, 1985 06:11:14
+;; modified to correct reentrance bug, to not bother with groups that
+;;   received no new traffic since last read completely, to find out
+;;   what traffic a group has available much more quickly when
+;;   possible, to do some completing reads for group names - should
+;;   be much faster...
+;;	KING@KESTREL.arpa, Thu Mar 13 09:03:28 1986
+;; made news-{next,previous}-group skip groups with no new messages; and
+;; added checking for unsubscribed groups to news-add-news-group
+;;	tower@prep.ai.mit.edu Jul 18 1986
+;; bound rmail-output to C-o; and changed header-field commands binding to
+;; agree with the new C-c C-f usage in sendmail
+;; 	tower@prep Sep  3 1986
+;; added news-rotate-buffer-body
+;;	tower@prep Oct 17 1986
+;; made messages more user friendly, cleanuped news-inews
+;; move posting and mail code to new file rnewpost.el
+;;	tower@prep Oct 29 1986
+;; added caesar-region, rename news-caesar-buffer-body, hacked accordingly
+;;	tower@prep Nov 21 1986
+;; added (provide 'rnews)	tower@prep 22 Apr 87
+(provide 'rnews)
+(require 'mail-utils)
+
+(autoload 'rmail-output "rmailout"
+  "Append this message to Unix mail file named FILE-NAME."
+  t)
+
+(autoload 'news-reply "rnewspost"
+  "Compose and post a reply to the current article on USENET.
+While composing the reply, use \\[mail-yank-original] to yank the original
+message into it."
+  t)
+
+(autoload 'news-mail-other-window "rnewspost"
+  "Send mail in another window.
+While composing the message, use \\[mail-yank-original] to yank the
+original message into it."
+  t)
+
+(autoload 'news-post-news "rnewspost"
+  "Begin editing a new USENET news article to be posted."
+  t)
+
+(autoload 'news-mail-reply "rnewspost"
+  "Mail a reply to the author of the current article.
+While composing the reply, use \\[mail-yank-original] to yank the original
+message into it."
+  t)
+
+(defvar news-group-hook-alist nil
+  "Alist of (GROUP-REGEXP . HOOK) pairs.
+Just before displaying a message, each HOOK is called
+if its GROUP-REGEXP matches the current newsgroup name.")
+
+(defvar rmail-last-file (expand-file-name "~/mbox.news"))
+
+;Now in paths.el.
+;(defvar news-path "/usr/spool/news/"
+;  "The root directory below which all news files are stored.")
+
+(defvar news-startup-file "$HOME/.newsrc" "Contains ~/.newsrc")
+(defvar news-certification-file "$HOME/.news-dates" "Contains ~/.news-dates")
+
+;; random headers that we decide to ignore.
+(defvar news-ignored-headers
+  "^Path:\\|^Posting-Version:\\|^Article-I.D.:\\|^Expires:\\|^Date-Received:\\|^References:\\|^Control:\\|^Xref:\\|^Lines:\\|^Posted:\\|^Relay-Version:\\|^Message-ID:\\|^Nf-ID:\\|^Nf-From:\\|^Approved:\\|^Sender:"
+  "All random fields within the header of a message.")
+
+(defvar news-mode-map nil)
+(defvar news-read-first-time-p t)
+;; Contains the (dotified) news groups of which you are a member. 
+(defvar news-user-group-list nil)
+
+(defvar news-current-news-group nil)
+(defvar news-current-group-begin nil)
+(defvar news-current-group-end  nil)
+(defvar news-current-certifications nil
+   	"An assoc list of a group name and the time at which it is
+known that the group had no new traffic")
+(defvar news-current-certifiable nil
+	"The time when the directory we are now working on was written")
+
+(defvar news-message-filter nil
+  "User specifiable filter function that will be called during
+formatting of the news file")
+
+;(defvar news-mode-group-string "Starting-Up"
+;  "Mode line group name info is held in this variable")
+(defvar news-list-of-files nil
+  "Global variable in which we store the list of files
+associated with the current newsgroup")
+(defvar news-list-of-files-possibly-bogus nil
+  "variable indicating we only are guessing at which files are available.
+Not currently used.")
+
+;; association list in which we store lists of the form
+;; (pointified-group-name (first last old-last))
+(defvar news-group-article-assoc nil)
+  
+(defvar news-current-message-number 0 "Displayed Article Number")
+(defvar news-total-current-group 0 "Total no of messages in group")
+
+(defvar news-unsubscribe-groups ())
+(defvar news-point-pdl () "List of visited news messages.")
+(defvar news-no-jumps-p t)
+(defvar news-buffer () "Buffer into which news files are read.")
+
+(defmacro news-push (item ref)
+  (list 'setq ref (list 'cons item ref)))
+
+(defmacro news-cadr (x) (list 'car (list 'cdr x)))
+(defmacro news-cdar (x) (list 'cdr (list 'car x)))
+(defmacro news-caddr (x) (list 'car (list 'cdr (list 'cdr x))))
+(defmacro news-cadar (x) (list 'car (list 'cdr (list 'car x))))
+(defmacro news-caadr (x) (list 'car (list 'car (list 'cdr x))))
+(defmacro news-cdadr (x) (list 'cdr (list 'car (list 'cdr x))))
+
+(defmacro news-wins (pfx index)
+  (` (file-exists-p (concat (, pfx) "/" (int-to-string (, index))))))
+
+(defvar news-max-plausible-gap 2
+	"* In an rnews directory, the maximum possible gap size.
+A gap is a sequence of missing messages between two messages that exist.
+An empty file does not contribute to a gap -- it ends one.")
+
+(defun news-find-first-and-last (prefix base)
+  (and (news-wins prefix base)
+       (cons (news-find-first-or-last prefix base -1)
+	     (news-find-first-or-last prefix base 1))))
+
+(defmacro news-/ (a1 a2)
+;; a form of / that guarantees that (/ -1 2) = 0
+  (if (zerop (/ -1 2))
+      (` (/ (, a1) (, a2)))
+    (` (if (< (, a1) 0)
+	   (- (/ (- (, a1)) (, a2)))
+	 (/ (, a1) (, a2))))))
+
+(defun news-find-first-or-last (pfx base dirn)
+  ;; first use powers of two to find a plausible ceiling
+  (let ((original-dir dirn))
+    (while (news-wins pfx (+ base dirn))
+      (setq dirn (* dirn 2)))
+    (setq dirn (news-/ dirn 2))
+    ;; Then use a binary search to find the high water mark
+    (let ((offset (news-/ dirn 2)))
+      (while (/= offset 0)
+	(if (news-wins pfx (+ base dirn offset))
+	    (setq dirn (+ dirn offset)))
+	(setq offset (news-/ offset 2))))
+    ;; If this high-water mark is bogus, recurse.
+    (let ((offset (* news-max-plausible-gap original-dir)))
+      (while (and (/= offset 0) (not (news-wins pfx (+ base dirn offset))))
+	(setq offset (- offset original-dir)))
+      (if (= offset 0)
+	  (+ base dirn)
+	(news-find-first-or-last pfx (+ base dirn offset) original-dir)))))
+
+(defun rnews ()
+"Read USENET news for groups for which you are a member and add or
+delete groups.
+You can reply to articles posted and send articles to any group.
+
+Type \\[describe-mode] once reading news to get a list of rnews commands."
+  (interactive)
+  (let ((last-buffer (buffer-name)))
+    (make-local-variable 'rmail-last-file)
+    (switch-to-buffer (setq news-buffer (get-buffer-create "*news*")))
+    (news-mode)
+    (setq news-buffer-save last-buffer)
+    (setq buffer-read-only nil)
+    (erase-buffer)
+    (setq buffer-read-only t)
+    (set-buffer-modified-p t)
+    (sit-for 0)
+    (message "Getting new USENET news...")
+    (news-set-mode-line)
+    (news-get-certifications)
+    (news-get-new-news)))
+
+(defun news-group-certification (group)
+  (cdr-safe (assoc group news-current-certifications)))
+
+
+(defun news-set-current-certifiable ()
+  ;; Record the date that corresponds to the directory you are about to check
+  (let ((file (concat news-path
+		      (string-subst-char ?/ ?. news-current-news-group))))
+    (setq news-current-certifiable
+	  (nth 5 (file-attributes
+		  (or (file-symlink-p file) file))))))
+
+(defun news-get-certifications ()
+  ;; Read the certified-read file from last session
+  (save-excursion
+    (save-window-excursion
+      (setq news-current-certifications
+	    (car-safe
+	     (condition-case var
+		 (let*
+		     ((file (substitute-in-file-name news-certification-file))
+		      (buf (find-file-noselect file)))
+		   (and (file-exists-p file)
+			(progn
+			  (switch-to-buffer buf 'norecord)
+			  (unwind-protect
+			      (read-from-string (buffer-string))
+			    (kill-buffer buf)))))
+	       (error nil)))))))
+
+(defun news-write-certifications ()
+  ;; Write a certification file.
+  ;; This is an assoc list of group names with doubletons that represent
+  ;; mod times of the directory when group is read completely.
+  (save-excursion
+    (save-window-excursion
+      (with-output-to-temp-buffer
+	  "*CeRtIfIcAtIoNs*"
+	  (print news-current-certifications))
+      (let ((buf (get-buffer "*CeRtIfIcAtIoNs*")))
+	(switch-to-buffer buf)
+	(write-file (substitute-in-file-name news-certification-file))
+	(kill-buffer buf)))))
+
+(defun news-set-current-group-certification ()
+  (let ((cgc (assoc news-current-news-group news-current-certifications)))
+    (if cgc (setcdr cgc news-current-certifiable)
+      (news-push (cons news-current-news-group news-current-certifiable)
+		 news-current-certifications))))
+
+(defun news-set-minor-modes ()
+  "Creates a minor mode list that has group name, total articles,
+and attribute for current article."
+  (setq news-minor-modes (list (cons 'foo
+				     (concat news-current-message-number
+					     "/"
+					     news-total-current-group
+					     (news-get-attribute-string)))))
+  ;; Detect Emacs versions 18.16 and up, which display
+  ;; directly from news-minor-modes by using a list for mode-name.
+  (or (boundp 'minor-mode-alist)
+      (setq minor-modes news-minor-modes)))
+
+(defun news-set-message-counters ()
+  "Scan through current news-groups filelist to figure out how many messages
+are there. Set counters for use with minor mode display."
+    (if (null news-list-of-files)
+	(setq news-current-message-number 0)))
+
+(if news-mode-map
+    nil
+  (setq news-mode-map (make-keymap))
+  (suppress-keymap news-mode-map)
+  (define-key news-mode-map "." 'beginning-of-buffer)
+  (define-key news-mode-map " " 'scroll-up)
+  (define-key news-mode-map "\177" 'scroll-down)
+  (define-key news-mode-map "n" 'news-next-message)
+  (define-key news-mode-map "c" 'news-make-link-to-message)
+  (define-key news-mode-map "p" 'news-previous-message)
+  (define-key news-mode-map "j" 'news-goto-message)
+  (define-key news-mode-map "q" 'news-exit)
+  (define-key news-mode-map "e" 'news-exit)
+  (define-key news-mode-map "\ej" 'news-goto-news-group)
+  (define-key news-mode-map "\en" 'news-next-group)
+  (define-key news-mode-map "\ep" 'news-previous-group)
+  (define-key news-mode-map "l" 'news-list-news-groups)
+  (define-key news-mode-map "?" 'describe-mode)
+  (define-key news-mode-map "g" 'news-get-new-news)
+  (define-key news-mode-map "f" 'news-reply)
+  (define-key news-mode-map "m" 'news-mail-other-window)
+  (define-key news-mode-map "a" 'news-post-news)
+  (define-key news-mode-map "r" 'news-mail-reply)
+  (define-key news-mode-map "o" 'news-save-item-in-file)
+  (define-key news-mode-map "\C-o" 'rmail-output)
+  (define-key news-mode-map "t" 'news-show-all-headers)
+  (define-key news-mode-map "x" 'news-force-update)
+  (define-key news-mode-map "A" 'news-add-news-group)
+  (define-key news-mode-map "u" 'news-unsubscribe-current-group)
+  (define-key news-mode-map "U" 'news-unsubscribe-group)
+  (define-key news-mode-map "\C-c\C-r" 'news-caesar-buffer-body))
+
+(defun news-mode ()
+  "News Mode is used by M-x rnews for reading USENET Newsgroups articles.
+New readers can find additional help in newsgroup: news.announce.newusers .
+All normal editing commands are turned off.
+Instead, these commands are available:
+
+.	move point to front of this news article (same as Meta-<).
+Space	scroll to next screen of this news article.
+Delete  scroll down previous page of this news article.
+n	move to next news article, possibly next group.
+p	move to previous news article, possibly previous group.
+j	jump to news article specified by numeric position.
+M-j     jump to news group.
+M-n     goto next news group.
+M-p     goto previous news group.
+l       list all the news groups with current status.
+?       print this help message.
+C-c C-r caesar rotate all letters by 13 places in the article's body (rot13).
+g       get new USENET news.
+f       post a reply article to USENET.
+a       post an original news article.
+A       add a newsgroup. 
+o	save the current article in the named file (append if file exists).
+C-o	output this message to a Unix-format mail file (append it).
+c       \"copy\" (actually link) current or prefix-arg msg to file.
+	warning: target directory and message file must be on same device
+		(UNIX magic)
+t       show all the headers this news article originally had.
+q	quit reading news after updating .newsrc file.
+e	exit updating .newsrc file.
+m	mail a news article.  Same as C-x 4 m.
+x       update last message seen to be the current message.
+r	mail a reply to this news article.  Like m but initializes some fields.
+u       unsubscribe from current newsgroup.
+U       unsubscribe from specified newsgroup."
+  (interactive)
+  (kill-all-local-variables)
+  (make-local-variable 'news-read-first-time-p)
+  (setq news-read-first-time-p t)
+  (make-local-variable 'news-current-news-group)
+;  (setq news-current-news-group "??")
+  (make-local-variable 'news-current-group-begin)
+  (setq news-current-group-begin 0)
+  (make-local-variable 'news-current-message-number)
+  (setq news-current-message-number 0)
+  (make-local-variable 'news-total-current-group)
+  (make-local-variable 'news-buffer-save)
+  (make-local-variable 'version-control)
+  (setq version-control 'never)
+  (make-local-variable 'news-point-pdl)
+;  This breaks it.  I don't have time to figure out why. -- RMS
+;  (make-local-variable 'news-group-article-assoc)
+  (setq major-mode 'news-mode)
+  (if (boundp 'minor-mode-alist)
+      ;; Emacs versions 18.16 and up.
+      (setq mode-name '("NEWS" news-minor-modes))
+    ;; Earlier versions display minor-modes via a special mechanism.
+    (setq mode-name "NEWS"))
+  (news-set-mode-line)
+  (set-syntax-table text-mode-syntax-table)
+  (use-local-map news-mode-map)
+  (setq local-abbrev-table text-mode-abbrev-table)
+  (run-hooks 'news-mode-hook))
+
+(defun string-subst-char (new old string)
+  (let (index)
+    (setq old (regexp-quote (char-to-string old))
+	  string (substring string 0))
+    (while (setq index (string-match old string))
+      (aset string index new)))
+  string)
+
+;; update read message number
+(defmacro news-update-message-read (ngroup nno)
+  (list 'setcar
+	(list 'news-cdadr
+	      (list 'assoc ngroup 'news-group-article-assoc))
+	nno))
+
+(defun news-parse-range (number-string)
+  "Parse string representing range of numbers of he form <a>-<b>
+to a list (a . b)"
+  (let ((n (string-match "-" number-string)))
+    (if n
+	(cons (string-to-int (substring number-string 0 n))
+	      (string-to-int (substring number-string (1+ n))))
+      (setq n (string-to-int number-string))
+      (cons n n))))
+
+;(defun is-in (elt lis)
+;  (catch 'foo
+;    (while lis
+;      (if (equal (car lis) elt)
+;	  (throw 'foo t)
+;	(setq lis (cdr lis))))))
+
+(defun news-get-new-news ()
+  "Get new USENET news, if there is any for the current user."
+  (interactive)
+  (if (not (null news-user-group-list))
+      (news-update-newsrc-file))
+  (setq news-group-article-assoc ())
+  (setq news-user-group-list ())
+  (message "Looking up %s file..." news-startup-file)
+  (let ((file (substitute-in-file-name news-startup-file))
+	(temp-user-groups ()))
+    (save-excursion
+      (let ((newsrcbuf (find-file-noselect file))
+	    start end endofline tem)
+	(set-buffer newsrcbuf)
+	(goto-char 0)
+	(while (search-forward ": " nil t)
+	  (setq end (point))
+	  (beginning-of-line)
+	  (setq start (point))
+	  (end-of-line)
+	  (setq endofline (point))
+	  (setq tem (buffer-substring start (- end 2)))
+	  (let ((range (news-parse-range
+			(buffer-substring end endofline))))
+	    (if (assoc tem news-group-article-assoc)
+		(message "You are subscribed twice to %s; I ignore second"
+			 tem)	      
+	      (setq temp-user-groups (cons tem temp-user-groups)
+		    news-group-article-assoc
+		    (cons (list tem (list (car range)
+					  (cdr range)
+					  (cdr range)))
+			  news-group-article-assoc)))))
+	(kill-buffer newsrcbuf)))      
+    (setq temp-user-groups (nreverse temp-user-groups))
+    (message "Prefrobnicating...")
+    (switch-to-buffer news-buffer)
+    (setq news-user-group-list temp-user-groups)
+    (while (and temp-user-groups
+		(not (news-read-files-into-buffer
+		      (car temp-user-groups) nil)))
+      (setq temp-user-groups (cdr temp-user-groups)))
+    (if (null temp-user-groups)
+	(message "No news is good news.")
+      (message ""))))
+
+(defun news-list-news-groups ()
+  "Display all the news groups to which you belong."
+  (interactive)
+  (with-output-to-temp-buffer "*Newsgroups*"
+    (save-excursion
+      (set-buffer standard-output)
+      (insert
+	"News Group        Msg No.       News Group        Msg No.\n")
+      (insert
+	"-------------------------       -------------------------\n")
+      (let ((temp news-user-group-list)
+	    (flag nil))
+	(while temp
+	  (let ((item (assoc (car temp) news-group-article-assoc)))
+	    (insert (car item))
+	    (indent-to (if flag 52 20))
+	    (insert (int-to-string (news-cadr (news-cadr item))))
+	    (if flag
+		(insert "\n")
+	      (indent-to 33))
+	    (setq temp (cdr temp) flag (not flag))))))))
+
+;; Mode line hack
+(defun news-set-mode-line ()
+  "Set mode line string to something useful."
+  (setq mode-line-process
+	(concat " "
+		(if (integerp news-current-message-number)
+		    (int-to-string news-current-message-number)
+		 "??")
+		"/"
+		(if (integerp news-current-group-end)
+		    (int-to-string news-current-group-end)
+		  news-current-group-end)))
+  (setq mode-line-buffer-identification
+	(concat "NEWS: "
+		news-current-news-group
+		;; Enough spaces to pad group name to 17 positions.
+		(substring "                 "
+			   0 (max 0 (- 17 (length news-current-news-group))))))
+  (set-buffer-modified-p t)
+  (sit-for 0))
+
+(defun news-goto-news-group (gp)
+  "Takes a string and goes to that news group."
+  (interactive (list (completing-read "NewsGroup: "
+				      news-group-article-assoc)))
+  (message "Jumping to news group %s..." gp)
+  (news-select-news-group gp)
+  (message "Jumping to news group %s... done." gp))
+
+(defun news-select-news-group (gp)
+  (let ((grp (assoc gp news-group-article-assoc)))
+    (if (null grp)
+ 	(error "Group %s not subscribed to" gp)
+      (progn
+	(news-update-message-read news-current-news-group
+				  (news-cdar news-point-pdl))
+	(news-read-files-into-buffer  (car grp) nil)
+	(news-set-mode-line)))))
+
+(defun news-goto-message (arg)
+  "Goes to the article ARG in current newsgroup."
+  (interactive "p")
+  (if (null current-prefix-arg)
+      (setq arg (read-no-blanks-input "Go to article: " "")))
+  (news-select-message arg))
+
+(defun news-select-message (arg)
+  (if (stringp arg) (setq arg (string-to-int arg)))
+  (let ((file (concat news-path
+		      (string-subst-char ?/ ?. news-current-news-group)
+		      "/" arg)))
+    (if (file-exists-p file)
+	(let ((buffer-read-only ()))
+	  (if (= arg 
+		 (or (news-cadr (memq (news-cdar news-point-pdl) news-list-of-files))
+		     0))
+	      (setcdr (car news-point-pdl) arg))
+	  (setq news-current-message-number arg)
+	  (news-read-in-file file)
+	  (news-set-mode-line))
+      (error "Article %d nonexistent" arg))))
+
+(defun news-force-update ()
+  "updates the position of last article read in the current news group"
+  (interactive)
+  (setcdr (car news-point-pdl) news-current-message-number)
+  (message "Updated to %d" news-current-message-number))
+
+(defun news-next-message (arg)
+  "Move ARG messages forward within one newsgroup.
+Negative ARG moves backward.
+If ARG is 1 or -1, moves to next or previous newsgroup if at end."
+  (interactive "p")
+  (let ((no (+ arg news-current-message-number)))
+    (if (or (< no news-current-group-begin) 
+	    (> no news-current-group-end))
+	(cond ((= arg 1)
+	       (news-set-current-group-certification)
+	       (news-next-group))
+	      ((= arg -1)
+	       (news-previous-group))
+	      (t (error "Article out of range")))
+      (let ((plist (news-get-motion-lists
+		     news-current-message-number
+		     news-list-of-files)))
+	(if (< arg 0)
+	    (news-select-message (nth (1- (- arg)) (car (cdr plist))))
+	  (news-select-message (nth (1- arg) (car plist))))))))
+
+(defun news-previous-message (arg)
+  "Move ARG messages backward in current newsgroup.
+With no arg or arg of 1, move one message
+and move to previous newsgroup if at beginning.
+A negative ARG means move forward."
+  (interactive "p")
+  (news-next-message (- arg)))
+
+(defun news-move-to-group (arg)
+  "Given arg move forward or backward to a new newsgroup."
+  (let ((cg news-current-news-group))
+    (let ((plist (news-get-motion-lists cg news-user-group-list))
+	  ngrp)
+      (if (< arg 0)
+	  (or (setq ngrp (nth (1- (- arg)) (news-cadr plist)))
+	      (error "No previous news groups"))
+	(or (setq ngrp (nth arg (car plist)))
+	    (error "No more news groups")))
+      (news-select-news-group ngrp))))
+
+(defun news-next-group ()
+  "Moves to the next user group."
+  (interactive)
+;  (message "Moving to next group...")
+  (news-move-to-group 0)
+  (while (null news-list-of-files)
+    (news-move-to-group 0)))
+;  (message "Moving to next group... done.")
+
+(defun news-previous-group ()
+  "Moves to the previous user group."
+  (interactive)
+;  (message "Moving to previous group...")
+  (news-move-to-group -1)
+  (while (null news-list-of-files)
+    (news-move-to-group -1)))
+;  (message "Moving to previous group... done.")
+
+(defun news-get-motion-lists (arg listy)
+  "Given a msgnumber/group this will return a list of two lists;
+one for moving forward and one for moving backward."
+  (let ((temp listy)
+	(result ()))
+    (catch 'out
+      (while temp
+	(if (equal (car temp) arg)
+	    (throw 'out (cons (cdr temp) (list result)))
+	  (setq result (nconc (list (car temp)) result))
+	  (setq temp (cdr temp)))))))
+
+;; miscellaneous io routines
+(defun news-read-in-file (filename)
+  (erase-buffer)
+  (let ((start (point)))
+  (insert-file-contents filename)
+  (news-convert-format)
+  ;; Run each hook that applies to the current newsgroup.
+  (let ((hooks news-group-hook-alist))
+    (while hooks
+      (goto-char start)
+      (if (string-match (car (car hooks)) news-group-name)
+	  (funcall (cdr (car hooks))))
+      (setq hooks (cdr hooks))))
+  (goto-char start)
+  (forward-line 1)
+  (if (eobp)
+      (message "(Empty file?)")
+    (goto-char start))))
+
+(defun news-convert-format ()
+  (save-excursion
+    (save-restriction
+      (let* ((start (point))
+	     (end (condition-case ()
+		      (progn (search-forward "\n\n") (point))
+		    (error nil)))
+	     has-from has-date)
+       (cond (end
+	      (narrow-to-region start end)
+	      (goto-char start)
+	      (setq has-from (search-forward "\nFrom:" nil t))
+	      (cond ((and (not has-from) has-date)
+		     (goto-char start)
+		     (search-forward "\nDate:")
+		     (beginning-of-line)
+		     (kill-line) (kill-line)))
+	      (news-delete-headers start)
+	      (goto-char start)))))))
+
+(defun news-show-all-headers ()
+  "Redisplay current news item with all original headers"
+  (interactive)
+  (let (news-ignored-headers
+	(buffer-read-only ()))
+    (erase-buffer)
+    (news-set-mode-line)
+    (news-read-in-file
+     (concat news-path
+	     (string-subst-char ?/ ?. news-current-news-group)
+	     "/" (int-to-string news-current-message-number)))))
+
+(defun news-delete-headers (pos)
+  (goto-char pos)
+  (and (stringp news-ignored-headers)
+       (while (re-search-forward news-ignored-headers nil t)
+	 (beginning-of-line)
+	 (delete-region (point)
+			(progn (re-search-forward "\n[^ \t]")
+			       (forward-char -1)
+			       (point))))))
+
+(defun news-exit ()
+  "Quit news reading session and update the .newsrc file."
+  (interactive)
+  (if (y-or-n-p "Do you really wanna quit reading news ? ")
+      (progn (message "Updating %s..." news-startup-file)
+	     (news-update-newsrc-file)
+	     (news-write-certifications)
+	     (message "Updating %s... done" news-startup-file)
+	     (message "Now do some real work")
+	     (and (fboundp 'bury-buffer) (bury-buffer (current-buffer)))
+	     (switch-to-buffer news-buffer-save)
+	     (setq news-user-group-list ()))
+    (message "")))
+
+(defun news-update-newsrc-file ()
+  "Updates the .newsrc file in the users home dir."
+  (let ((newsrcbuf (find-file-noselect
+		     (substitute-in-file-name news-startup-file)))
+	(tem news-user-group-list)
+	group)
+    (save-excursion
+      (if (not (null news-current-news-group))
+	  (news-update-message-read news-current-news-group
+				    (news-cdar news-point-pdl)))
+      (set-buffer newsrcbuf)
+      (while tem
+	(setq group (assoc (car tem) news-group-article-assoc))
+	(if (= (news-cadr (news-cadr group)) (news-caddr (news-cadr group)))
+	    nil
+	  (goto-char 0)
+	  (if (search-forward (concat (car group) ": ") nil t)
+	      (kill-line nil)
+	    (insert (car group) ": \n") (backward-char 1))
+	  (insert (int-to-string (car (news-cadr group))) "-"
+		  (int-to-string (news-cadr (news-cadr group)))))
+	(setq tem (cdr tem)))
+     (while news-unsubscribe-groups
+       (setq group (assoc (car news-unsubscribe-groups)
+			  news-group-article-assoc))
+       (goto-char 0)
+       (if (search-forward (concat (car group) ": ") nil t)
+	   (progn
+	      (backward-char 2)
+	      (kill-line nil)
+	      (insert "! " (int-to-string (car (news-cadr group)))
+		      "-" (int-to-string (news-cadr (news-cadr group))))))
+       (setq news-unsubscribe-groups (cdr news-unsubscribe-groups)))
+     (save-buffer)
+     (kill-buffer (current-buffer)))))
+
+
+(defun news-unsubscribe-group (group)
+  "Removes you from newgroup GROUP."
+  (interactive (list (completing-read  "Unsubscribe from group: "
+				      news-group-article-assoc)))
+  (news-unsubscribe-internal group))
+
+(defun news-unsubscribe-current-group ()
+  "Removes you from the newsgroup you are now reading."
+  (interactive)
+  (if (y-or-n-p "Do you really want to unsubscribe from this group ? ")
+      (news-unsubscribe-internal news-current-news-group)))
+
+(defun news-unsubscribe-internal (group)
+  (let ((tem (assoc group news-group-article-assoc)))
+    (if tem
+	(progn
+	  (setq news-unsubscribe-groups (cons group news-unsubscribe-groups))
+	  (news-update-message-read group (news-cdar news-point-pdl))
+	  (if (equal group news-current-news-group)
+	      (news-next-group))
+	  (message ""))
+      (error "Not subscribed to group: %s" group))))
+
+(defun news-save-item-in-file (file)
+  "Save the current article that is being read by appending to a file."
+  (interactive "FSave item in file: ")
+  (append-to-file (point-min) (point-max) file))
+
+(defun news-get-pruned-list-of-files (gp-list end-file-no)
+  "Given a news group it finds all files in the news group.
+The arg must be in slashified format.
+Using ls was found to be too slow in a previous version."
+  (let
+      ((answer
+	(and
+	 (not (and end-file-no
+		   (equal (news-set-current-certifiable)
+		     (news-group-certification gp-list))
+		   (setq news-list-of-files nil
+			 news-list-of-files-possibly-bogus t)))
+	 (let* ((file-directory (concat news-path
+					(string-subst-char ?/ ?. gp-list)))
+		tem
+		(last-winner
+		 (and end-file-no
+		      (news-wins file-directory end-file-no)
+		      (news-find-first-or-last file-directory end-file-no 1))))
+	   (setq news-list-of-files-possibly-bogus t news-list-of-files nil)
+	   (if last-winner
+	       (progn
+		 (setq news-list-of-files-possibly-bogus t
+		       news-current-group-end last-winner)
+		 (while (> last-winner end-file-no)
+		   (news-push last-winner news-list-of-files)
+		   (setq last-winner (1- last-winner)))
+		 news-list-of-files)
+	     (if (or (not (file-directory-p file-directory))
+		     (not (file-readable-p file-directory)))
+		 nil
+	       (setq news-list-of-files
+		     (condition-case error
+			 (directory-files file-directory)
+		       (file-error
+			(if (string= (nth 2 error) "permission denied")
+			    (message "Newsgroup %s is read-protected"
+				     gp-list)
+			  (signal 'file-error (cdr error)))
+			nil)))
+	       (setq tem news-list-of-files)
+	       (while tem
+		 (if (or (not (string-match "^[0-9]*$" (car tem)))
+			 ;; dont get confused by directories that look like numbers
+			 (file-directory-p
+			  (concat file-directory "/" (car tem)))
+			 (<= (string-to-int (car tem)) end-file-no))
+		     (setq news-list-of-files
+			   (delq (car tem) news-list-of-files)))
+		 (setq tem (cdr tem)))
+	       (if (null news-list-of-files)
+		   (progn (setq news-current-group-end 0)
+			  nil)
+		 (setq news-list-of-files
+		       (mapcar 'string-to-int news-list-of-files))
+		 (setq news-list-of-files (sort news-list-of-files '<))
+		 (setq news-current-group-end
+		       (elt news-list-of-files
+			    (1- (length news-list-of-files))))
+		 news-list-of-files)))))))
+    (or answer (progn (news-set-current-group-certification) nil))))
+
+(defun news-read-files-into-buffer (group reversep)
+  (let* ((files-start-end (news-cadr (assoc group news-group-article-assoc)))
+	 (start-file-no (car files-start-end))
+	 (end-file-no (news-cadr files-start-end))
+	 (buffer-read-only nil))
+    (setq news-current-news-group group)
+    (setq news-current-message-number nil)
+    (setq news-current-group-end nil)
+    (news-set-mode-line)
+    (news-get-pruned-list-of-files group end-file-no)
+    (news-set-mode-line)
+    ;; @@ should be a lot smarter than this if we have to move
+    ;; @@ around correctly.
+    (setq news-point-pdl (list (cons (car files-start-end)
+				     (news-cadr files-start-end))))
+    (if (null news-list-of-files)
+	(progn (erase-buffer)
+	       (setq news-current-group-end end-file-no)
+	       (setq news-current-group-begin end-file-no)
+	       (setq news-current-message-number end-file-no)
+	       (news-set-mode-line)
+;	       (message "No new articles in " group " group.")
+	       nil)
+      (setq news-current-group-begin (car news-list-of-files))
+      (if reversep
+	  (setq news-current-message-number news-current-group-end)
+	(if (> (car news-list-of-files) end-file-no)
+	    (setcdr (car news-point-pdl) (car news-list-of-files)))
+	(setq news-current-message-number news-current-group-begin))
+      (news-set-message-counters)
+      (news-set-mode-line)
+      (news-read-in-file (concat news-path
+				 (string-subst-char ?/ ?. group)
+				 "/"
+				 (int-to-string
+				   news-current-message-number)))
+      (news-set-message-counters)
+      (news-set-mode-line)
+      t)))
+
+(defun news-add-news-group (gp)
+  "Resubscribe to or add a USENET news group named GROUP (a string)."
+; @@ (completing-read ...)
+; @@ could be based on news library file ../active (slightly facist)
+; @@ or (expensive to compute) all directories under the news spool directory
+  (interactive "sAdd news group: ")
+  (let ((file-dir (concat news-path (string-subst-char ?/ ?. gp))))
+    (save-excursion
+      (if (null (assoc gp news-group-article-assoc))
+	  (let ((newsrcbuf (find-file-noselect
+			    (substitute-in-file-name news-startup-file))))
+	    (if (file-directory-p file-dir)
+		(progn
+		  (switch-to-buffer newsrcbuf)
+		  (goto-char 0)
+		  (if (search-forward (concat gp "! ") nil t)
+		      (progn
+			(message "Re-subscribing to group %s." gp)
+			;;@@ news-unsubscribe-groups isn't being used
+			;;(setq news-unsubscribe-groups
+			;;    (delq gp news-unsubscribe-groups))
+			(backward-char 2)
+			(delete-char 1)
+			(insert ":"))
+		    (progn
+		      (message
+		       "Added %s to your list of newsgroups." gp)
+		      (end-of-buffer)
+		      (insert gp ": 1-1\n")))
+		  (search-backward gp nil t)
+		  (let (start end endofline tem)
+		    (search-forward ": " nil t)
+		    (setq end (point))
+		    (beginning-of-line)
+		    (setq start (point))
+		    (end-of-line)
+		    (setq endofline (point))
+		    (setq tem (buffer-substring start (- end 2)))
+		    (let ((range (news-parse-range
+				  (buffer-substring end endofline))))
+		      (setq news-group-article-assoc
+			    (cons (list tem (list (car range)
+						  (cdr range)
+						  (cdr range)))
+				  news-group-article-assoc))))
+		  (save-buffer)
+		  (kill-buffer (current-buffer)))
+	      (message "Newsgroup %s doesn't exist." gp)))
+	(message "Already subscribed to group %s." gp)))))
+
+(defun news-make-link-to-message (number newname)
+	"Forges a link to an rnews message numbered number (current if no arg)
+Good for hanging on to a message that might or might not be
+automatically deleted."
+  (interactive "P
+FName to link to message: ")
+  (add-name-to-file
+   (concat news-path
+	   (string-subst-char ?/ ?. news-current-news-group)
+	   "/" (if number
+		   (prefix-numeric-value number)
+		 news-current-message-number))
+   newname))
+
+;;; caesar-region written by phr@prep.ai.mit.edu  Nov 86
+;;; modified by tower@prep Nov 86
+(defun caesar-region (&optional n)
+  "Caesar rotation of region by N, default 13, for decrypting netnews."
+  (interactive (if current-prefix-arg	; Was there a prefix arg?
+		   (list (prefix-numeric-value current-prefix-arg))
+		 (list nil)))
+  (cond ((not (numberp n)) (setq n 13))
+	((< n 0) (setq n (- 26 (% (- n) 26))))
+	(t (setq n (% n 26))))		;canonicalize N
+  (if (not (zerop n))		; no action needed for a rot of 0
+      (progn
+	(if (or (not (boundp 'caesar-translate-table))
+		(/= (aref caesar-translate-table ?a) (+ ?a n)))
+	    (let ((i 0) (lower "abcdefghijklmnopqrstuvwxyz") upper)
+	      (message "Building caesar-translate-table...")
+	      (setq caesar-translate-table (make-vector 256 0))
+	      (while (< i 256)
+		(aset caesar-translate-table i i)
+		(setq i (1+ i)))
+	      (setq lower (concat lower lower) upper (upcase lower) i 0)
+	      (while (< i 26)
+		(aset caesar-translate-table (+ ?a i) (aref lower (+ i n)))
+		(aset caesar-translate-table (+ ?A i) (aref upper (+ i n)))
+		(setq i (1+ i)))
+	      (message "Building caesar-translate-table... done")))
+	(let ((from (region-beginning))
+	      (to (region-end))
+	      (i 0) str len)
+	  (setq str (buffer-substring from to))
+	  (setq len (length str))
+	  (while (< i len)
+	    (aset str i (aref caesar-translate-table (aref str i)))
+	    (setq i (1+ i)))
+	  (goto-char from)
+	  (kill-region from to)
+	  (insert str)))))
+
+;;; news-caesar-buffer-body written by paul@media-lab.mit.edu  Wed Oct 1, 1986
+;;; hacked further by tower@prep.ai.mit.edu
+(defun news-caesar-buffer-body (&optional rotnum)
+  "Caesar rotates all letters in the current buffer by 13 places.
+Used to encode/decode possibly offensive messages (commonly in net.jokes).
+With prefix arg, specifies the number of places to rotate each letter forward.
+Mail and USENET news headers are not rotated."
+  (interactive (if current-prefix-arg	; Was there a prefix arg?
+		   (list (prefix-numeric-value current-prefix-arg))
+		 (list nil)))
+  (save-excursion
+    (let ((buffer-status buffer-read-only))
+      (setq buffer-read-only nil)
+      ;; setup the region
+      (set-mark (if (progn (goto-char (point-min))
+			    (search-forward
+			     (concat "\n"
+				     (if (equal major-mode 'news-mode)
+					 ""
+				       mail-header-separator)
+				     "\n") nil t))
+		     (point)
+		   (point-min)))
+      (goto-char (point-max))
+      (caesar-region rotnum)
+      (setq buffer-read-only buffer-status))))
diff --git a/lisp/mail/rnewspost.el b/lisp/mail/rnewspost.el
new file mode 100644
index 00000000000..adb65e6f3ab
--- /dev/null
+++ b/lisp/mail/rnewspost.el
@@ -0,0 +1,390 @@
+;;; USENET news poster/mailer for GNU Emacs
+;; Copyright (C) 1985, 1986, 1987 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 1, 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.
+
+;; moved posting and mail code from rnews.el
+;;	tower@prep.ai.mit.edu Wed Oct 29 1986
+;; brought posting code almost up to the revision of RFC 850 for News 2.11
+;; - couldn't see handling the special meaning of the Keyword: poster
+;; - not worth the code space to support the old A news Title: (which
+;;   Subject: replaced) and Article-I.D.: (which Message-ID: replaced)
+;;	tower@prep Nov 86
+;; changed C-c C-r key-binding due to rename of news-caesar-buffer-body
+;;	tower@prep 21 Nov 86
+;; added (require 'rnews)	tower@prep 22 Apr 87
+;; restricted call of news-show-all-headers in news-post-news & news-reply
+;;	tower@prep 28 Apr 87
+;; commented out Posting-Front-End to save USENET bytes tower@prep Jul 31 87
+;; commented out -n and -t args in news-inews     tower@prep 15 Oct 87
+(require 'sendmail)
+(require 'rnews)
+
+;Now in paths.el.
+;(defvar news-inews-program "inews"
+;  "Function to post news.")
+
+;; Replying and posting news items are done by these functions.
+;; imported from rmail and modified to work with rnews ...
+;; Mon Mar 25,1985 at 03:07:04 ads@mit-hermes.
+;; this is done so that rnews can operate independently from rmail.el and
+;; sendmail and dosen't have to autoload these functions.
+;;
+;;; >> Nuked by Mly to autoload those functions again, as the duplication of
+;;; >>  code was making maintenance too difficult.
+
+(defvar news-reply-mode-map () "Mode map used by news-reply.")
+
+(or news-reply-mode-map
+    (progn
+      (setq news-reply-mode-map (make-keymap))
+      (define-key news-reply-mode-map "\C-c?" 'describe-mode)
+      (define-key news-reply-mode-map "\C-c\C-f\C-d" 'news-reply-distribution)
+      (define-key news-reply-mode-map "\C-c\C-f\C-k" 'news-reply-keywords)
+      (define-key news-reply-mode-map "\C-c\C-f\C-n" 'news-reply-newsgroups)
+      (define-key news-reply-mode-map "\C-c\C-f\C-f" 'news-reply-followup-to)
+      (define-key news-reply-mode-map "\C-c\C-f\C-s" 'mail-subject)
+      (define-key news-reply-mode-map "\C-c\C-f\C-a" 'news-reply-summary)
+      (define-key news-reply-mode-map "\C-c\C-r" 'news-caesar-buffer-body)
+      (define-key news-reply-mode-map "\C-c\C-w" 'news-reply-signature)
+      (define-key news-reply-mode-map "\C-c\C-y" 'news-reply-yank-original)
+      (define-key news-reply-mode-map "\C-c\C-q" 'mail-fill-yanked-message)
+      (define-key news-reply-mode-map "\C-c\C-c" 'news-inews)
+      (define-key news-reply-mode-map "\C-c\C-s" 'news-inews)))
+
+(defun news-reply-mode ()
+  "Major mode for editing news to be posted on USENET.
+First-time posters are asked to please read the articles in newsgroup:
+                                                     news.announce.newusers .
+Like Text Mode but with these additional commands:
+
+C-c C-s  news-inews (post the message)    C-c C-c  news-inews
+C-c C-f	 move to a header field (and create it if there isn't):
+	 C-c C-f C-n  move to Newsgroups:	C-c C-f C-s  move to Subj:
+	 C-c C-f C-f  move to Followup-To:      C-c C-f C-k  move to Keywords:
+	 C-c C-f C-d  move to Distribution:	C-c C-f C-a  move to Summary:
+C-c C-y  news-reply-yank-original (insert current message, in NEWS).
+C-c C-q  mail-fill-yanked-message (fill what was yanked).
+C-c C-r  caesar rotate all letters by 13 places in the article's body (rot13)."
+  (interactive)
+  ;; require...
+  (or (fboundp 'mail-setup) (load "sendmail"))
+  (kill-all-local-variables)
+  (make-local-variable 'mail-reply-buffer)
+  (setq mail-reply-buffer nil)
+  (set-syntax-table text-mode-syntax-table)
+  (use-local-map news-reply-mode-map)
+  (setq local-abbrev-table text-mode-abbrev-table)
+  (setq major-mode 'news-reply-mode)
+  (setq mode-name "News")
+  (make-local-variable 'paragraph-separate)
+  (make-local-variable 'paragraph-start)
+  (setq paragraph-start (concat "^" mail-header-separator "$\\|"
+				paragraph-start))
+  (setq paragraph-separate (concat "^" mail-header-separator "$\\|"
+				   paragraph-separate))
+  (run-hooks 'text-mode-hook 'news-reply-mode-hook))
+
+(defvar news-reply-yank-from
+  "Save From: field for news-reply-yank-original."
+  "")
+
+(defvar news-reply-yank-message-id
+  "Save Message-Id: field for news-reply-yank-original."
+  "")
+
+(defun news-reply-yank-original (arg)
+  "Insert the message being replied to, if any (in rmail).
+Puts point before the text and mark after.
+Indents each nonblank line ARG spaces (default 3).
+Just \\[universal-argument] as argument means don't indent
+and don't delete any header fields."
+  (interactive "P")
+  (mail-yank-original arg)
+  (exchange-point-and-mark)
+  (run-hooks 'news-reply-header-hook))
+
+(defvar news-reply-header-hook
+  '(lambda ()
+	 (insert "In article " news-reply-yank-message-id
+			 " " news-reply-yank-from " writes:\n\n"))
+  "Hook for inserting a header at the top of a yanked message.")
+
+(defun news-reply-newsgroups ()
+  "Move point to end of Newsgroups: field.
+RFC 850 constrains the Newsgroups: field to be a comma separated list of valid
+newsgroups names at your site:
+Newsgroups: news.misc,comp.misc,rec.misc"
+  (interactive)
+  (expand-abbrev)
+  (goto-char (point-min))
+  (mail-position-on-field "Newsgroups"))
+
+(defun news-reply-followup-to ()
+  "Move point to end of Followup-To: field.  Create the field if none.
+One usually requests followups to only one newsgroup.
+RFC 850 constrains the Followup-To: field to be a comma separated list of valid
+newsgroups names at your site, that are also in the Newsgroups: field:
+Newsgroups: news.misc,comp.misc,rec.misc,misc.misc,soc.misc
+Followup-To: news.misc,comp.misc,rec.misc"
+  (interactive)
+  (expand-abbrev)
+  (or (mail-position-on-field "Followup-To" t)
+      (progn (mail-position-on-field "newsgroups")
+	     (insert "\nFollowup-To: ")))
+	 ;; @@ could do a completing read based on the Newsgroups: field to
+	 ;; @@ fill in the Followup-To: field
+)
+
+(defun news-reply-distribution ()
+  "Move point to end of Distribution: optional field.
+Create the field if none.  Without this field the posting goes to all of
+USENET.  The field is used to restrict the posting to parts of USENET."
+  (interactive)
+  (expand-abbrev)
+  (mail-position-on-field "Distribution")
+  ;; @@could do a completing read based on the news library file:
+  ;; @@    ../distributions  to fill in the field.
+  )
+
+(defun news-reply-keywords ()
+  "Move point to end of Keywords: optional field.  Create the field if none.
+Used as an aid to the news reader, it can contain a few, well selected keywords
+identifying the message."
+  (interactive)
+  (expand-abbrev)
+  (mail-position-on-field "Keywords"))
+
+(defun news-reply-summary ()
+  "Move point to end of Summary: optional field.  Create the field if none.
+Used as an aid to the news reader, it can contain a succinct
+summary (abstract) of the message."
+  (interactive)
+  (expand-abbrev)
+  (mail-position-on-field "Summary"))
+
+(defun news-reply-signature ()
+  "The inews program appends ~/.signature automatically."
+  (interactive)
+  (message "~/.signature will be appended automatically."))
+
+(defun news-setup (to subject in-reply-to newsgroups replybuffer)
+  "Setup the news reply or posting buffer with the proper headers and in
+news-reply-mode."
+  (setq mail-reply-buffer replybuffer)
+  (let ((mail-setup-hook nil))
+    (if (null to)
+	;; this hack is needed so that inews wont be confused by 
+	;; the fcc: and bcc: fields
+	(let ((mail-self-blind nil)
+	      (mail-archive-file-name nil))
+	  (mail-setup to subject in-reply-to nil replybuffer nil)
+	  (beginning-of-line)
+	  (kill-line 1)
+	  (goto-char (point-max)))
+      (mail-setup to subject in-reply-to nil replybuffer nil))
+    ;;;(mail-position-on-field "Posting-Front-End")
+    ;;;(insert (emacs-version))
+    (goto-char (point-max))
+    (if (let ((case-fold-search t))
+	  (re-search-backward "^Subject:" (point-min) t))
+	(progn (beginning-of-line)
+	       (insert "Newsgroups: " (or newsgroups "") "\n")
+	       (if (not newsgroups)
+		   (backward-char 1)
+		 (goto-char (point-max)))))
+    (run-hooks 'news-setup-hook)))
+   
+(defun news-inews ()
+  "Send a news message using inews."
+  (interactive)
+  (let* (newsgroups subject
+		    (case-fold-search nil))
+    (save-excursion
+      (save-restriction
+	(goto-char (point-min))
+	(search-forward (concat "\n" mail-header-separator "\n"))
+	(narrow-to-region (point-min) (point))
+	(setq newsgroups (mail-fetch-field "newsgroups")
+	      subject (mail-fetch-field "subject")))
+      (widen)
+      (goto-char (point-min))
+      (run-hooks 'news-inews-hook)
+      (goto-char (point-min))
+      (search-forward (concat "\n" mail-header-separator "\n"))
+      (replace-match "\n\n")
+      (goto-char (point-max))
+      ;; require a newline at the end for inews to append .signature to
+      (or (= (preceding-char) ?\n)
+	  (insert ?\n))
+      (message "Posting to USENET...")
+      (call-process-region (point-min) (point-max) 
+			   news-inews-program nil 0 nil
+			   "-h")	; take all header lines!
+			   ;@@ setting of subject and newsgroups still needed?
+			   ;"-t" subject
+			   ;"-n" newsgroups
+      (message "Posting to USENET... done")
+      (goto-char (point-min))		;restore internal header separator
+      (search-forward "\n\n")
+      (replace-match (concat "\n" mail-header-separator "\n"))
+      (set-buffer-modified-p nil))
+    (and (fboundp 'bury-buffer) (bury-buffer))))
+
+;@@ shares some code with news-reply and news-post-news
+(defun news-mail-reply ()
+  "Mail a reply to the author of the current article.
+While composing the reply, use \\[news-reply-yank-original] to yank the
+original message into it."
+  (interactive)
+  (let (from cc subject date to reply-to
+	     (buffer (current-buffer)))
+    (save-restriction
+      (narrow-to-region (point-min) (progn (goto-line (point-min))
+					   (search-forward "\n\n")
+					   (- (point) 1)))
+      (setq from (mail-fetch-field "from")
+	    subject (mail-fetch-field "subject")
+	    reply-to (mail-fetch-field "reply-to")
+	    date (mail-fetch-field "date"))
+      (setq to from)
+      (pop-to-buffer "*mail*")
+      (mail nil
+	    (if reply-to reply-to to)
+	    subject
+	    (let ((stop-pos (string-match "  *at \\|  *@ \\| *(\\| *<" from)))
+	      (concat (if stop-pos (substring from 0 stop-pos) from)
+		      "'s message of "
+		      date))
+	    nil
+	   buffer))))
+
+;@@ the guts of news-reply and news-post-news should be combined. -tower
+(defun news-reply ()
+  "Compose and post a reply (aka a followup) to the current article on USENET.
+While composing the followup, use \\[news-reply-yank-original] to yank the
+original message into it."
+  (interactive)
+  (if (y-or-n-p "Are you sure you want to followup to all of USENET? ")
+      (let (from cc subject date to followup-to newsgroups message-of
+		 references distribution message-id
+		 (buffer (current-buffer)))
+	(save-restriction
+	  (and (not (= 0 (buffer-size))) ;@@real problem is non-existence of
+					;@@	of article file
+	       (equal major-mode 'news-mode) ;@@ if rmail-mode,
+					;@@	should show full headers
+	       (progn
+		 (news-show-all-headers) ;@@ should save/restore header state,
+					;@@	but rnews.el lacks support
+		 (narrow-to-region (point-min) (progn (goto-char (point-min))
+						      (search-forward "\n\n")
+						      (- (point) 1)))))
+	  (setq from (mail-fetch-field "from")
+		news-reply-yank-from from
+		;; @@ not handling old Title: field
+		subject (mail-fetch-field "subject")
+		date (mail-fetch-field "date")
+		followup-to (mail-fetch-field "followup-to")
+		newsgroups (or followup-to
+			       (mail-fetch-field "newsgroups"))
+		references (mail-fetch-field "references")
+		;; @@ not handling old Article-I.D.: field
+		distribution (mail-fetch-field "distribution")
+		message-id (mail-fetch-field "message-id")
+		news-reply-yank-message-id message-id)
+	  (pop-to-buffer "*post-news*")
+	  (news-reply-mode)
+	  (if (and (buffer-modified-p)
+		   (not
+		    (y-or-n-p "Unsent article being composed; erase it? ")))
+	      ()
+	    (progn
+	      (erase-buffer)
+	      (and subject
+		   (progn (if (string-match "\\`Re: " subject)
+			      (while (string-match "\\`Re: " subject)
+				(setq subject (substring subject 4))))
+			  (setq subject (concat "Re: " subject))))
+	      (and from
+		   (progn
+		     (let ((stop-pos
+			    (string-match "  *at \\|  *@ \\| *(\\| *<" from)))
+		       (setq message-of
+			     (concat
+			      (if stop-pos (substring from 0 stop-pos) from)
+			      "'s message of "
+			      date)))))
+	      (news-setup
+	       nil
+	       subject
+	       message-of
+	       newsgroups
+	       buffer)
+	      (if followup-to
+		  (progn (news-reply-followup-to)
+			 (insert followup-to)))
+	      (if distribution
+		  (progn
+		    (mail-position-on-field "Distribution")
+		    (insert distribution)))
+	      (mail-position-on-field "References")
+	      (if references
+		  (insert references))
+	      (if (and references message-id)
+		  (insert " "))
+	      (if message-id
+		  (insert message-id))
+	      (goto-char (point-max))))))
+    (message "")))
+
+;@@ the guts of news-reply and news-post-news should be combined. -tower
+(defun news-post-news ()
+  "Begin editing a new USENET news article to be posted.
+Type \\[describe-mode] once editing the article to get a list of commands."
+  (interactive)
+  (if (y-or-n-p "Are you sure you want to post to all of USENET? ")
+      (let ((buffer (current-buffer)))
+	(save-restriction
+	  (and (not (= 0 (buffer-size))) ;@@real problem is non-existence of
+					;@@	of article file
+	       (equal major-mode 'news-mode) ;@@ if rmail-mode,
+					;@@	should show full headers
+	       (progn
+		 (news-show-all-headers) ;@@ should save/restore header state,
+					;@@	but rnews.el lacks support
+		 (narrow-to-region (point-min) (progn (goto-char (point-min))
+						      (search-forward "\n\n")
+						      (- (point) 1)))))
+	  (setq news-reply-yank-from (mail-fetch-field "from")
+		;; @@ not handling old Article-I.D.: field
+		news-reply-yank-message-id (mail-fetch-field "message-id")))
+	(pop-to-buffer "*post-news*")
+	(news-reply-mode)
+	(if (and (buffer-modified-p)
+		 (not (y-or-n-p "Unsent article being composed; erase it? ")))
+	    ()				;@@ not saving point from last time
+	  (progn (erase-buffer)
+		 (news-setup () () () () buffer))))
+  (message "")))
+
+(defun news-mail-other-window ()
+  "Send mail in another window.
+While composing the message, use \\[news-reply-yank-original] to yank the
+original message into it."
+  (interactive)
+  (mail-other-window nil nil nil nil nil (current-buffer)))
diff --git a/lisp/mail/undigest.el b/lisp/mail/undigest.el
new file mode 100644
index 00000000000..583251e990f
--- /dev/null
+++ b/lisp/mail/undigest.el
@@ -0,0 +1,105 @@
+;; "RMAIL" mail reader for Emacs.
+;; Copyright (C) 1985, 1986 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 1, 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.
+
+;; note Interent RFP934
+
+(defun undigestify-rmail-message ()
+  "Break up a digest message into its constituent messages.
+Leaves original message, deleted, before the undigestified messages."
+  (interactive)
+  (widen)
+  (let ((buffer-read-only nil)
+	(msg-string (buffer-substring (rmail-msgbeg rmail-current-message)
+				      (rmail-msgend rmail-current-message))))
+    (goto-char (rmail-msgend rmail-current-message))
+    (narrow-to-region (point) (point))
+    (insert msg-string)
+    (narrow-to-region (point-min) (1- (point-max))))
+  (let ((error t)
+	(buffer-read-only nil))
+    (unwind-protect
+	(progn
+	  (save-restriction
+	    (goto-char (point-min))
+	    (delete-region (point-min)
+			   (progn (search-forward "\n*** EOOH ***\n")
+				  (point)))
+	    (insert "\^_\^L\n0, unseen,,\n*** EOOH ***\n")
+	    (narrow-to-region (point)
+			      (point-max))
+	    (let* ((fill-prefix "")
+		   (case-fold-search t)
+		   (digest-name
+		    (mail-strip-quoted-names
+		     (or (save-restriction
+			   (search-forward "\n\n")
+			   (narrow-to-region (point-min) (point))
+			   (goto-char (point-max))
+			   (or (mail-fetch-field "Reply-To")
+			       (mail-fetch-field "To")
+			       (mail-fetch-field "Apparently-To")
+			       (mail-fetch-field "From")))
+			 (error "Message is not a digest")))))
+	      (save-excursion
+		(goto-char (point-max))
+		(skip-chars-backward " \t\n")
+		(let ((count 10) found)
+		  ;; compensate for broken un*x digestifiers.  Sigh Sigh.
+		  (while (and (> count 0) (not found))
+		    (forward-line -1)
+		    (setq count (1- count))
+		    (if (looking-at (concat "End of.*Digest.*\n"
+					    (regexp-quote "*********") "*"
+					    "\\(\n------*\\)*"))
+			(setq found t)))
+		  (if (not found) (error "Message is not a digest"))))
+	      (re-search-forward (concat "^" (make-string 55 ?-) "-*\n*"))
+	      (replace-match "\^_\^L\n0, unseen,,\n*** EOOH ***\n")
+	      (save-restriction
+		(narrow-to-region (point)
+				  (progn (search-forward "\n\n")
+					 (point)))
+		(if (mail-fetch-field "To") nil
+		  (goto-char (point-min))
+		  (insert "To: " digest-name "\n")))
+	      (while (re-search-forward
+		      (concat "\n\n" (make-string 27 ?-) "-*\n*")
+		      nil t)
+		(replace-match "\n\n\^_\^L\n0, unseen,,\n*** EOOH ***\n")
+		(save-restriction
+		  (if (looking-at "End ")
+		      (insert "To: " digest-name "\n\n")
+		    (narrow-to-region (point)
+				      (progn (search-forward "\n\n"
+							     nil 'move)
+					     (point))))
+		  (if (mail-fetch-field "To") nil
+		    (goto-char (point-min))
+		    (insert "To: " digest-name "\n"))))))
+	  (setq error nil)
+	  (message "Message successfully undigestified")
+	  (let ((n rmail-current-message))
+	    (rmail-forget-messages)
+	    (rmail-show-message n)
+	    (rmail-delete-forward)))
+      (cond (error
+	     (narrow-to-region (point-min) (1+ (point-max)))
+	     (delete-region (point-min) (point-max))
+	     (rmail-show-message rmail-current-message))))))
+
diff --git a/lisp/misc.el b/lisp/misc.el
new file mode 100644
index 00000000000..db7b3f223b5
--- /dev/null
+++ b/lisp/misc.el
@@ -0,0 +1,51 @@
+;; Basic editing commands for Emacs
+;; Copyright (C) 1989 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 1, 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.
+
+
+(defun copy-from-above-command (&optional arg)
+  "Copy characters from previous nonblank line, starting just above point.
+Copy ARG characters, but not past the end of that line.
+If no argument given, copy the entire rest of the line.
+The characters copied are inserted in the buffer before point."
+  (interactive "P")
+  (let ((cc (current-column))
+	n
+	(string ""))
+    (save-excursion
+      (beginning-of-line)
+      (backward-char 1)
+      (skip-chars-backward "\ \t\n")
+      (move-to-column cc)
+      ;; Default is enough to copy the whole rest of the line.
+      (setq n (if arg (prefix-numeric-value arg) (point-max)))
+      ;; If current column winds up in middle of a tab,
+      ;; copy appropriate number of "virtual" space chars.
+      (if (< cc (current-column))
+	  (if (= (preceding-char) ?\t)
+	      (progn
+		(setq string (make-string (min n (- (current-column) cc)) ?\ ))
+		(setq n (- n (min n (- (current-column) cc)))))
+	    ;; In middle of ctl char => copy that whole char.
+	    (backward-char 1)))
+      (setq string (concat string
+			   (buffer-substring
+			    (point)
+			    (min (save-excursion (end-of-line) (point))
+				 (+ n (point)))))))
+    (insert string)))
diff --git a/lisp/sun-curs.el b/lisp/sun-curs.el
new file mode 100644
index 00000000000..f290e1b3a76
--- /dev/null
+++ b/lisp/sun-curs.el
@@ -0,0 +1,207 @@
+;; Cursor definitions for Sun windows
+;; Copyright (C) 1987 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 1, 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.
+
+;;;
+;;; Added some more cursors and moved the hot spots
+;;; Cursor defined by 16 pairs of 16-bit numbers
+;;;
+;;; 9-dec-86 Jeff Peck, Sun Microsystems Inc. <peck@sun.com>
+
+(provide 'sm-cursors)
+
+(defvar sc::cursors nil "List of known cursors")
+
+(defmacro defcursor (name x y string)
+  (if (not (memq name sc::cursors)) 
+      (setq sc::cursors (cons name sc::cursors)))
+  (list 'defconst name (list 'vector x y string)))
+
+;;; push should be defined in common lisp, but if not use this:
+;(defmacro push (v l)
+;  "The ITEM is evaluated and consed onto LIST, a list-valued atom"
+;  (list 'setq l (list 'cons v l)))
+
+;;;
+;;; The standard default cursor
+;;;
+(defcursor sc:right-arrow 15 0
+  (concat '(0 1 0 3 0 7 0 15 0 31 0 63 0 127 0 15
+	      0 27 0 25 0 48 0 48 0 96 0 96 0 192 0 192)))
+
+;;(sc:set-cursor sc:right-arrow)
+
+(defcursor sc:fat-left-arrow 0 8
+  (concat '(1 0 3 0 7 0 15 0 31 0 63 255 127 255 255 255
+	      255 255 127 255 63 255 31 0 15 0 7 0 3 0 1 0)))
+
+(defcursor sc:box 8 8
+  (concat '(15 252 8 4 8 4 8 4 8 4 8 4 8 4 8 4
+	       8 132 8 4 8 4 8 4 8 4 8 4 8 4 15 252)))
+
+(defcursor sc:hourglass 8 8
+  (concat "\177\376\100\002\040\014\032\070"
+	  "\017\360\007\340\003\300\001\200"
+	  "\001\200\002\100\005\040\010\020"
+	  "\021\210\043\304\107\342\177\376"))
+
+(defun sc:set-cursor (icon)
+  "Change the Sun mouse cursor to ICON.
+If ICON is nil, switch to the system default cursor,
+Otherwise, ICON should be a vector or the name of a vector of [x y 32-chars]"
+  (interactive "XIcon Name: ")
+  (if (symbolp icon) (setq icon (symbol-value icon)))
+  (sun-change-cursor-icon icon))
+
+(make-local-variable '*edit-icon*)
+(make-variable-buffer-local 'icon-edit)
+(setq-default icon-edit nil)
+(or (assq 'icon-edit minor-mode-alist)
+    (push '(icon-edit " IconEdit") minor-mode-alist))
+
+(defun sc:edit-cursor (icon)
+  "convert icon to rectangle, edit, and repack"
+  (interactive "XIcon Name: ")
+  (if (not icon) (setq icon (sc::menu-choose-cursor (selected-window) 1 1)))
+  (if (symbolp icon) (setq icon (symbol-value icon)))
+  (if (get-buffer "icon-edit") (kill-buffer "icon-edit"))
+  (switch-to-buffer "icon-edit")
+  (local-set-mouse '(text right) 'sc::menu-function)
+  (local-set-mouse '(text left) '(sc::pic-ins-at-mouse 32))
+  (local-set-mouse '(text middle) '(sc::pic-ins-at-mouse 64))
+  (local-set-mouse '(text left middle) 'sc::hotspot)
+  (sc::display-icon icon)
+  (picture-mode)
+  (setq icon-edit t)	; for mode line display
+)
+
+(defun sc::pic-ins-at-mouse (char)
+  "Picture insert char at mouse location"
+  (mouse-move-point *mouse-window* (min 15 *mouse-x*) (min 15 *mouse-y*))
+  (move-to-column-force (1+ (min 15 (current-column))))
+  (delete-char -1)
+  (insert char)
+  (sc::goto-hotspot))
+    
+(defun sc::menu-function (window x y)
+  (sun-menu-evaluate window (1+ x) y sc::menu))
+
+(defmenu sc::menu
+  ("Cursor Menu")
+  ("Pack & Use" sc::pack-buffer-to-cursor)
+  ("Pack to Icon" sc::pack-buffer-to-icon 
+		  (sc::menu-choose-cursor *menu-window* *menu-x* *menu-y*))
+  ("New Icon" call-interactively 'sc::make-cursor)
+  ("Edit Icon" sc:edit-cursor 
+	       (sc::menu-choose-cursor *menu-window* *menu-x* *menu-y*))
+  ("Set Cursor" sc:set-cursor
+		(sc::menu-choose-cursor *menu-window* *menu-x* *menu-y*)) 
+  ("Reset Cursor" sc:set-cursor nil)
+  ("Help". sc::edit-icon-help-menu)
+  ("Quit" sc::quit-edit)
+  )
+
+(defun sc::quit-edit ()
+  (interactive)
+  (bury-buffer (current-buffer))
+  (switch-to-buffer (other-buffer) 'no-record))
+
+(defun sc::make-cursor (symbol)
+  (interactive "SIcon Name: ")
+  (eval (list 'defcursor symbol 0 0 ""))
+  (sc::pack-buffer-to-icon (symbol-value symbol)))
+
+(defmenu sc::edit-icon-help-menu
+  ("Simple Icon Editor")
+  ("Left     => CLEAR")
+  ("Middle   => SET")
+  ("L & M    => HOTSPOT")
+  ("Right    => MENU"))
+
+(defun sc::edit-icon-help ()
+  (message "Left=> CLEAR  Middle=> SET  Left+Middle=> HOTSPOT  Right=> MENU"))
+
+(defun sc::pack-buffer-to-cursor ()
+    (sc::pack-buffer-to-icon *edit-icon*)
+    (sc:set-cursor *edit-icon*))
+
+(defun sc::menu-choose-cursor (window x y)
+  "Presents a menu of cursor names, and returns one or nil"
+  (let ((curs sc::cursors) 
+	(items))
+    (while curs
+      (push (sc::menu-item-for-cursor (car curs)) items)
+      (setq curs (cdr curs)))
+    (push (list "Choose Cursor") items)
+    (setq menu (menu-create items))
+    (sun-menu-evaluate window x y menu)))
+
+(defun sc::menu-item-for-cursor (cursor)
+  "apply function to selected cursor"
+  (list (symbol-name cursor) 'quote cursor))
+
+(defun sc::hotspot (window x y)
+  (aset *edit-icon* 0 x)
+  (aset *edit-icon* 1 y)
+  (sc::goto-hotspot))
+
+(defun sc::goto-hotspot ()
+  (goto-line (1+ (aref *edit-icon* 1)))
+  (move-to-column (aref *edit-icon* 0)))
+
+(defun sc::display-icon (icon)
+  (setq *edit-icon* (copy-sequence icon))
+  (let ((string (aref *edit-icon* 2))
+	(index 0))
+    (while (< index 32)
+      (let ((char (aref string index))
+	    (bit 128))
+	(while (> bit 0)
+	  (insert (sc::char-at-bit char bit))
+	  (setq bit (lsh bit -1))))
+      (if (eq 1 (% index 2)) (newline))
+      (setq index (1+ index))))
+  (sc::goto-hotspot))
+
+(defun sc::char-at-bit (char bit)
+  (if (> (logand char bit) 0) "@" " "))
+
+(defun sc::pack-buffer-to-icon (icon)
+  "Pack 16 x 16 field into icon string"
+  (goto-char (point-min))
+  (aset icon 0 (aref *edit-icon* 0))
+  (aset icon 1 (aref *edit-icon* 1))
+  (aset icon 2 (mapconcat 'sc::pack-one-line "1234567890123456" ""))
+  (sc::goto-hotspot)
+  )
+  
+(defun sc::pack-one-line (dummy)
+  (let* (char chr1 chr2)
+    (setq char 0 chr1 (mapconcat 'sc::pack-one-char "12345678" "") chr1 char)
+    (setq char 0 chr2 (mapconcat 'sc::pack-one-char "12345678" "") chr2 char)
+    (forward-line 1)
+    (concat (char-to-string chr1) (char-to-string chr2))
+    ))
+
+(defun sc::pack-one-char (dummy)
+  "pack following char into char, unless eolp"
+  (if (or (eolp) (char-equal (following-char) 32))
+      (setq char (lsh char 1)) 
+    (setq char (1+ (lsh char 1))))
+  (if (not (eolp))(forward-char)))
+
diff --git a/lisp/sun-fns.el b/lisp/sun-fns.el
new file mode 100644
index 00000000000..b2ca59203f6
--- /dev/null
+++ b/lisp/sun-fns.el
@@ -0,0 +1,630 @@
+;; Subroutines of Mouse handling for Sun windows
+;; Copyright (C) 1987 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 1, 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.
+
+;;; Submitted Mar. 1987, Jeff Peck
+;;;		 	 Sun Microsystems Inc. <peck@sun.com>
+;;; Conceived Nov. 1986, Stan Jefferson,
+;;;                      Computer Science Lab, SRI International.
+;;; GoodIdeas Feb. 1987, Steve Greenbaum
+;;; & UpClicks           Reasoning Systems, Inc.
+;;;
+(provide 'sun-fns)
+(require 'sun-mouse)
+;;;
+;;; Functions for manipulating via the mouse and mouse-map definitions
+;;; for accessing them.  Also definitons of mouse menus.
+;;; This file you should freely modify to reflect you personal tastes.
+;;;
+;;; First half of file defines functions to implement mouse commands,
+;;; Don't delete any of those, just add what ever else you need.
+;;; Second half of file defines mouse bindings, do whatever you want there.
+
+;;;
+;;;         Mouse Functions.
+;;;
+;;; These functions follow the sun-mouse-handler convention of being called
+;;; with three arguements: (window x-pos y-pos)
+;;; This makes it easy for a mouse executed command to know where the mouse is.
+;;; Use the macro "eval-in-window" to execute a function 
+;;; in a temporarily selected window.
+;;;
+;;; If you have a function that must be called with other arguments
+;;; bind the mouse button to an s-exp that contains the necessary parameters.
+;;; See "minibuffer" bindings for examples.
+;;;
+(defconst cursor-pause-milliseconds 300
+  "*Number of milliseconds to display alternate cursor (usually the mark)")
+
+(defun indicate-region (&optional pause)
+  "Bounce cursor to mark for cursor-pause-milliseconds and back again"
+  (or pause (setq pause cursor-pause-milliseconds))
+  (let ((point (point)))
+    (goto-char (mark))
+    (sit-for-millisecs pause)
+    ;(update-display)
+    ;(sleep-for-millisecs pause)
+    (goto-char point)))
+
+
+;;;
+;;; Text buffer operations
+;;;
+(defun mouse-move-point (window x y)
+  "Move point to mouse cursor."
+  (select-window window)
+  (move-to-loc x y)
+  (if (memq last-command	; support the mouse-copy/delete/yank
+	    '(mouse-copy mouse-delete mouse-yank-move))
+      (setq this-command 'mouse-yank-move))
+  )
+
+(defun mouse-set-mark (window x y)
+  "Set mark at mouse cursor."
+  (eval-in-window window	;; use this to get the unwind protect
+    (let ((point (point)))
+      (move-to-loc x y)
+      (set-mark (point))
+      (goto-char point)
+      (indicate-region)))
+  )
+
+(defun mouse-set-mark-and-select (window x y)
+  "Set mark at mouse cursor, and select that window."
+  (select-window window)
+  (mouse-set-mark window x y)
+  )
+
+(defun mouse-set-mark-and-stuff (w x y)
+  "Set mark at mouse cursor, and put region in stuff buffer."
+  (mouse-set-mark-and-select w x y)
+  (sun-select-region (region-beginning) (region-end)))
+
+;;;
+;;; Simple mouse dragging stuff: marking with button up
+;;;
+
+(defvar *mouse-drag-window* nil)
+(defvar *mouse-drag-x* -1)
+(defvar *mouse-drag-y* -1)
+
+(defun mouse-drag-move-point (window x y)
+  "Move point to mouse cursor, and allow dragging."
+  (mouse-move-point window x y)
+  (setq *mouse-drag-window* window
+	*mouse-drag-x* x
+	*mouse-drag-y* y))
+
+(defun mouse-drag-set-mark-stuff (window x y)
+  "The up click handler that goes with mouse-drag-move-point.
+If mouse is in same WINDOW but at different X or Y than when
+mouse-drag-move-point was last executed, set the mark at mouse
+and put the region in the stuff buffer."
+  (if (and (eq *mouse-drag-window* window)
+	   (not (and (equal *mouse-drag-x* x)
+		     (equal *mouse-drag-y* y))))
+      (mouse-set-mark-and-stuff window x y)
+    (setq this-command last-command))	; this was just an upclick no-op.
+  )
+
+(defun mouse-select-or-drag-move-point (window x y)
+  "Select window if not selected, otherwise do mouse-drag-move-point."
+  (if (eq (selected-window) window)
+      (mouse-drag-move-point window x y)
+    (mouse-select-window window x y)))
+
+;;;
+;;; esoteria:
+;;;
+(defun mouse-exch-pt-and-mark (window x y)
+  "Exchange point and mark."
+  (select-window window)
+  (exchange-point-and-mark)
+  )
+
+(defun mouse-call-kbd-macro (window x y)
+  "Invokes last keyboard macro at mouse cursor."
+  (mouse-move-point window x y)
+  (call-last-kbd-macro)
+  )
+
+(defun mouse-mark-thing (window x y)
+  "Set point and mark to text object using syntax table.
+The resulting region is put in the sun-window stuff buffer.
+Left or right Paren syntax marks an s-expression.  
+Clicking at the end of a line marks the line including a trailing newline.  
+If it doesn't recognize one of these it marks the character at point."
+  (mouse-move-point window x y)
+  (if (eobp) (open-line 1))
+  (let* ((char (char-after (point)))
+         (syntax (char-syntax char)))
+    (cond
+     ((eq syntax ?w)			; word.
+      (forward-word 1)
+      (set-mark (point))
+      (forward-word -1))
+     ;; try to include a single following whitespace (is this a good idea?)
+     ;; No, not a good idea since inconsistent.
+     ;;(if (eq (char-syntax (char-after (mark))) ?\ )
+     ;;    (set-mark (1+ (mark))))
+     ((eq syntax ?\( )			; open paren.
+      (mark-sexp 1))
+     ((eq syntax ?\) )			; close paren.
+      (forward-char 1)
+      (mark-sexp -1)
+      (exchange-point-and-mark))
+     ((eolp)				; mark line if at end.
+      (set-mark (1+ (point)))
+      (beginning-of-line 1))
+     (t					; mark character
+      (set-mark (1+ (point)))))
+    (indicate-region))			; display region boundary.
+  (sun-select-region (region-beginning) (region-end))
+  )
+
+(defun mouse-kill-thing (window x y)
+  "Kill thing at mouse, and put point there."
+  (mouse-mark-thing window x y)
+  (kill-region-and-unmark (region-beginning) (region-end))
+  )
+
+(defun mouse-kill-thing-there (window x y)
+  "Kill thing at mouse, leave point where it was.
+See mouse-mark-thing for a description of the objects recognized."
+  (eval-in-window window 
+    (save-excursion
+      (mouse-mark-thing window x y)
+      (kill-region (region-beginning) (region-end))))
+  )
+
+(defun mouse-save-thing (window x y &optional quiet)
+  "Put thing at mouse in kill ring.
+See mouse-mark-thing for a description of the objects recognized."
+  (mouse-mark-thing window x y)
+  (copy-region-as-kill (region-beginning) (region-end))
+  (if (not quiet) (message "Thing saved"))
+  )
+
+(defun mouse-save-thing-there (window x y &optional quiet)
+  "Put thing at mouse in kill ring, leave point as is.
+See mouse-mark-thing for a description of the objects recognized."
+  (eval-in-window window
+    (save-excursion
+      (mouse-save-thing window x y quiet))))
+
+;;;
+;;; Mouse yanking...
+;;;
+(defun mouse-copy-thing (window x y)
+  "Put thing at mouse in kill ring, yank to point.
+See mouse-mark-thing for a description of the objects recognized."
+  (setq last-command 'not-kill)	 ;Avoids appending to previous kills.
+  (mouse-save-thing-there window x y t)
+  (yank)
+  (setq this-command 'yank))
+
+(defun mouse-move-thing (window x y)
+  "Kill thing at mouse, yank it to point.
+See mouse-mark-thing for a description of the objects recognized."
+  (setq last-command 'not-kill)	 ;Avoids appending to previous kills.
+  (mouse-kill-thing-there window x y)
+  (yank)
+  (setq this-command 'yank))
+
+(defun mouse-yank-at-point (&optional window x y)
+  "Yank from kill-ring at point; then cycle thru kill ring."
+  (if (eq last-command 'yank)
+      (let ((before (< (point) (mark))))
+	(delete-region (point) (mark))
+	(rotate-yank-pointer 1)
+	(insert (car kill-ring-yank-pointer))
+	(if before (exchange-point-and-mark)))
+    (yank))
+  (setq this-command 'yank))
+
+(defun mouse-yank-at-mouse (window x y)
+  "Yank from kill-ring at mouse; then cycle thru kill ring."
+  (mouse-move-point window x y)
+  (mouse-yank-at-point window x y))
+
+(defun mouse-save/delete/yank (&optional window x y)
+  "Context sensitive save/delete/yank.
+Consecutive clicks perform as follows:
+    * first click saves region to kill ring,
+    * second click kills region,
+    * third click yanks from kill ring,
+    * subsequent clicks cycle thru kill ring.
+If mouse-move-point is performed after the first or second click,
+the next click will do a yank, etc.  Except for a possible mouse-move-point,
+this command is insensitive to mouse location."
+  (cond
+   ((memq last-command '(mouse-delete yank mouse-yank-move))	; third+ click
+    (mouse-yank-at-point))
+   ((eq last-command 'mouse-copy)	; second click
+    (kill-region (region-beginning) (region-end))
+    (setq this-command 'mouse-delete))
+   (t					; first click
+    (copy-region-as-kill (region-beginning) (region-end))
+    (message "Region saved")
+    (setq this-command 'mouse-copy))
+   ))
+
+
+(defun mouse-split-horizontally (window x y)
+  "Splits the window horizontally at mouse cursor."
+  (eval-in-window window (split-window-horizontally (1+ x))))
+
+(defun mouse-split-vertically (window x y)
+  "Split the window vertically at the mouse cursor."
+  (eval-in-window window (split-window-vertically (1+ y))))
+
+(defun mouse-select-window (window x y)
+  "Selects the window, restoring point."
+  (select-window window))
+
+(defun mouse-delete-other-windows (window x y)
+  "Deletes all windows except the one mouse is in."
+  (delete-other-windows window))
+
+(defun mouse-delete-window (window x y)
+  "Deletes the window mouse is in."
+  (delete-window window))
+
+(defun mouse-undo (window x y)
+  "Invokes undo in the window mouse is in."
+  (eval-in-window window (undo)))
+
+;;;
+;;; Scroll operations
+;;;
+
+;;; The move-to-window-line is used below because otherwise
+;;; scrolling a non-selected process window with the mouse, after
+;;; the process has written text past the bottom of the window,
+;;; gives an "End of buffer" error, and then scrolls.  The
+;;; move-to-window-line seems to force recomputing where things are.
+(defun mouse-scroll-up (window x y)
+  "Scrolls the window upward."
+  (eval-in-window window (move-to-window-line 1) (scroll-up nil)))
+
+(defun mouse-scroll-down (window x y)
+  "Scrolls the window downward."
+  (eval-in-window window (scroll-down nil)))
+
+(defun mouse-scroll-proportional (window x y)
+  "Scrolls the window proportionally corresponding to window
+relative X divided by window width."
+  (eval-in-window window 
+    (if (>= x (1- (window-width)))
+	;; When x is maximun (equal to or 1 less than window width),
+	;; goto end of buffer.  We check for this special case
+	;; becuase the calculated goto-char often goes short of the
+	;; end due to roundoff error, and we often really want to go
+	;; to the end.
+	(goto-char (point-max))
+      (progn
+	(goto-char (+ (point-min)	; For narrowed regions.
+		      (* x (/ (- (point-max) (point-min))
+			      (1- (window-width))))))
+	(beginning-of-line))
+      )
+    (what-cursor-position)		; Report position.
+    ))
+
+(defun mouse-line-to-top (window x y)
+  "Scrolls the line at the mouse cursor up to the top."
+  (eval-in-window window (scroll-up y)))
+
+(defun mouse-top-to-line (window x y)
+  "Scrolls the top line down to the mouse cursor."
+  (eval-in-window window (scroll-down y)))
+
+(defun mouse-line-to-bottom (window x y)
+  "Scrolls the line at the mouse cursor to the bottom."
+  (eval-in-window window (scroll-up (+ y (- 2 (window-height))))))
+
+(defun mouse-bottom-to-line (window x y)
+  "Scrolls the bottom line up to the mouse cursor."
+  (eval-in-window window (scroll-down (+ y (- 2 (window-height))))))
+
+(defun mouse-line-to-middle (window x y)
+  "Scrolls the line at the mouse cursor to the middle."
+  (eval-in-window window (scroll-up (- y -1 (/ (window-height) 2)))))
+
+(defun mouse-middle-to-line (window x y)
+  "Scrolls the line at the middle to the mouse cursor."
+  (eval-in-window window (scroll-up (- (/ (window-height) 2) y 1))))
+
+
+;;;
+;;; main emacs menu.
+;;;
+(defmenu expand-menu
+  ("Vertically" mouse-expand-vertically *menu-window*)
+  ("Horizontally" mouse-expand-horizontally *menu-window*))
+
+(defmenu delete-window-menu
+  ("This One" delete-window *menu-window*)
+  ("All Others" delete-other-windows *menu-window*))
+
+(defmenu mouse-help-menu
+  ("Text Region"
+   mouse-help-region *menu-window* *menu-x* *menu-y* 'text)
+  ("Scrollbar"
+   mouse-help-region *menu-window* *menu-x* *menu-y* 'scrollbar)
+  ("Modeline"
+   mouse-help-region *menu-window* *menu-x* *menu-y* 'modeline)
+  ("Minibuffer"
+   mouse-help-region *menu-window* *menu-x* *menu-y* 'minibuffer)
+  )
+  
+(defmenu emacs-quit-menu
+  ("Suspend" suspend-emacstool)
+  ("Quit" save-buffers-kill-emacs))
+
+(defmenu emacs-menu
+  ("Emacs Menu")
+  ("Stuff Selection" sun-yank-selection)
+  ("Expand" . expand-menu)
+  ("Delete Window" . delete-window-menu)
+  ("Previous Buffer" mouse-select-previous-buffer *menu-window*)
+  ("Save Buffers" save-some-buffers)
+  ("List Directory" list-directory nil)
+  ("Dired" dired nil)
+  ("Mouse Help" . mouse-help-menu)
+  ("Quit" . emacs-quit-menu))
+
+(defun emacs-menu-eval (window x y)
+  "Pop-up menu of editor commands."
+  (sun-menu-evaluate window (1+ x) (1- y) 'emacs-menu))
+
+(defun mouse-expand-horizontally (window)
+  (eval-in-window window
+    (enlarge-window 4 t)
+    (update-display)		; Try to redisplay, since can get confused.
+    ))
+
+(defun mouse-expand-vertically (window)
+  (eval-in-window window (enlarge-window 4)))
+
+(defun mouse-select-previous-buffer (window)
+  "Switch buffer in mouse window to most recently selected buffer."
+  (eval-in-window window (switch-to-buffer (other-buffer))))
+
+;;;
+;;; minibuffer menu
+;;;
+(defmenu minibuffer-menu 
+  ("Minibuffer" message "Just some miscellanous minibuffer commands")
+  ("Stuff" sun-yank-selection)
+  ("Do-It" exit-minibuffer)
+  ("Abort" abort-recursive-edit)
+  ("Suspend" suspend-emacs))
+
+(defun minibuffer-menu-eval (window x y)
+  "Pop-up menu of commands."
+  (sun-menu-evaluate window x (1- y) 'minibuffer-menu))
+
+(defun mini-move-point (window x y)
+  ;; -6 is good for most common cases
+  (mouse-move-point window (- x 6) 0))
+
+(defun mini-set-mark-and-stuff (window x y)
+  ;; -6 is good for most common cases
+  (mouse-set-mark-and-stuff window (- x 6) 0))
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 
+;;; Buffer-mode Mouse commands
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 
+
+(defun Buffer-at-mouse (w x y)
+  "Calls Buffer-menu-buffer from mouse click."
+  (save-window-excursion 
+    (mouse-move-point w x y)
+    (beginning-of-line)
+    (Buffer-menu-buffer t)))
+
+(defun mouse-buffer-bury (w x y)
+  "Bury the indicated buffer."
+  (bury-buffer (Buffer-at-mouse w x y))
+  )
+
+(defun mouse-buffer-select (w x y)
+  "Put the indicated buffer in selected window."
+  (switch-to-buffer (Buffer-at-mouse w x y))
+  (list-buffers)
+  )
+
+(defun mouse-buffer-delete (w x y)
+  "mark indicated buffer for delete"
+  (save-window-excursion
+    (mouse-move-point w x y)
+    (Buffer-menu-delete)
+    ))
+
+(defun mouse-buffer-execute (w x y)
+  "execute buffer-menu selections"
+  (save-window-excursion
+    (mouse-move-point w x y)
+    (Buffer-menu-execute)
+    ))
+  
+(defun enable-mouse-in-buffer-list ()
+  "Call this to enable mouse selections in *Buffer List*
+    LEFT puts the indicated buffer in the selected window.
+    MIDDLE buries the indicated buffer.
+    RIGHT marks the indicated buffer for deletion.
+    MIDDLE-RIGHT deletes the marked buffers.
+To unmark a buffer marked for deletion, select it with LEFT."
+  (save-window-excursion
+    (list-buffers)			; Initialize *Buffer List*
+    (set-buffer "*Buffer List*")
+    (local-set-mouse '(text middle) 'mouse-buffer-bury)
+    (local-set-mouse '(text left) 'mouse-buffer-select)	    
+    (local-set-mouse '(text right) 'mouse-buffer-delete)
+    (local-set-mouse '(text middle right) 'mouse-buffer-execute)
+    )
+  )
+
+
+;;;*******************************************************************
+;;;
+;;;           Global Mouse Bindings.
+;;;
+;;; There is some sense to this mouse binding madness:
+;;; LEFT and RIGHT scrolls are inverses.
+;;; SHIFT makes an opposite meaning in the scroll bar.
+;;; SHIFT is an alternative to DOUBLE (but double chords do not exist).
+;;; META makes the scrollbar functions work in the text region.
+;;; MIDDLE operates the mark
+;;; LEFT operates at point
+
+;;; META commands are generally non-destructive,
+;;; SHIFT is a little more dangerous.
+;;; CONTROL is for the really complicated ones.
+
+;;; CONTROL-META-SHIFT-RIGHT gives help on that region.
+
+;;;
+;;; Text Region mousemap
+;;;
+;; The basics: Point, Mark, Menu, Sun-Select:
+(global-set-mouse '(text        left)	'mouse-drag-move-point)
+(global-set-mouse '(text     up left)	'mouse-drag-set-mark-stuff)
+(global-set-mouse '(text shift  left)	'mouse-exch-pt-and-mark)
+(global-set-mouse '(text double left)	'mouse-exch-pt-and-mark)
+
+(global-set-mouse '(text	middle)	'mouse-set-mark-and-stuff)
+
+(global-set-mouse '(text	right)	'emacs-menu-eval)
+(global-set-mouse '(text shift	right)	'(sun-yank-selection))
+(global-set-mouse '(text double	right)	'(sun-yank-selection))
+
+;; The Slymoblics multi-command for Save, Kill, Copy, Move:
+(global-set-mouse '(text shift	middle)	'mouse-save/delete/yank)
+(global-set-mouse '(text double	middle)	'mouse-save/delete/yank)
+
+;; Save, Kill, Copy, Move Things:
+;; control-left composes with control middle/right to produce copy/move
+(global-set-mouse '(text control middle	    )	'mouse-save-thing-there)
+(global-set-mouse '(text control right      )	'mouse-kill-thing-there)
+(global-set-mouse '(text control 	left)	'mouse-yank-at-point)
+(global-set-mouse '(text control middle	left)	'mouse-copy-thing)
+(global-set-mouse '(text control right	left)	'mouse-move-thing)
+(global-set-mouse '(text control right middle)	'mouse-mark-thing)
+
+;; The Universal mouse help command (press all buttons):
+(global-set-mouse '(text shift  control meta right)	'mouse-help-region)
+(global-set-mouse '(text double control meta right)	'mouse-help-region)
+
+;;; Meta in Text Region is like meta version in scrollbar:
+(global-set-mouse '(text meta        left)	'mouse-line-to-top)
+(global-set-mouse '(text meta shift  left)	'mouse-line-to-bottom)
+(global-set-mouse '(text meta double left)	'mouse-line-to-bottom)
+(global-set-mouse '(text meta         middle)	'mouse-line-to-middle)
+(global-set-mouse '(text meta shift   middle)	'mouse-middle-to-line)
+(global-set-mouse '(text meta double  middle)	'mouse-middle-to-line)
+(global-set-mouse '(text meta control middle)	'mouse-split-vertically)
+(global-set-mouse '(text meta        right)	'mouse-top-to-line)
+(global-set-mouse '(text meta shift  right)	'mouse-bottom-to-line)
+(global-set-mouse '(text meta double right)	'mouse-bottom-to-line)
+
+;; Miscellaneous:
+(global-set-mouse '(text meta control left)	'mouse-call-kbd-macro)
+(global-set-mouse '(text meta control right)	'mouse-undo)
+
+;;;
+;;; Scrollbar mousemap.
+;;; Are available in the Scrollbar Region, or with Meta Text (or Meta Scrollbar)
+;;;
+(global-set-mouse '(scrollbar        left)	'mouse-line-to-top)
+(global-set-mouse '(scrollbar shift  left)	'mouse-line-to-bottom)
+(global-set-mouse '(scrollbar double left)	'mouse-line-to-bottom)
+
+(global-set-mouse '(scrollbar         middle)	'mouse-line-to-middle)
+(global-set-mouse '(scrollbar shift   middle)	'mouse-middle-to-line)
+(global-set-mouse '(scrollbar double  middle)	'mouse-middle-to-line)
+(global-set-mouse '(scrollbar control middle)	'mouse-split-vertically)
+
+(global-set-mouse '(scrollbar        right)	'mouse-top-to-line)
+(global-set-mouse '(scrollbar shift  right)	'mouse-bottom-to-line)
+(global-set-mouse '(scrollbar double right)	'mouse-bottom-to-line)
+
+(global-set-mouse '(scrollbar meta        left)		'mouse-line-to-top)
+(global-set-mouse '(scrollbar meta shift  left)		'mouse-line-to-bottom)
+(global-set-mouse '(scrollbar meta double left)		'mouse-line-to-bottom)
+(global-set-mouse '(scrollbar meta         middle)	'mouse-line-to-middle)
+(global-set-mouse '(scrollbar meta shift   middle)	'mouse-middle-to-line)
+(global-set-mouse '(scrollbar meta double  middle)	'mouse-middle-to-line)
+(global-set-mouse '(scrollbar meta control middle)	'mouse-split-vertically)
+(global-set-mouse '(scrollbar meta        right)	'mouse-top-to-line)
+(global-set-mouse '(scrollbar meta shift  right)	'mouse-bottom-to-line)
+(global-set-mouse '(scrollbar meta double right)	'mouse-bottom-to-line)
+
+;; And the help menu:
+(global-set-mouse '(scrollbar shift  control meta right) 'mouse-help-region)
+(global-set-mouse '(scrollbar double control meta right) 'mouse-help-region)
+
+;;;
+;;; Modeline mousemap.
+;;;
+;;; Note: meta of any single button selects window.
+
+(global-set-mouse '(modeline      left)	'mouse-scroll-up)
+(global-set-mouse '(modeline meta left)	'mouse-select-window)
+
+(global-set-mouse '(modeline         middle)	'mouse-scroll-proportional)
+(global-set-mouse '(modeline meta    middle)	'mouse-select-window)
+(global-set-mouse '(modeline control middle)	'mouse-split-horizontally)
+
+(global-set-mouse '(modeline      right)	'mouse-scroll-down)
+(global-set-mouse '(modeline meta right)	'mouse-select-window)
+
+;;; control-left selects this window, control-right deletes it.
+(global-set-mouse '(modeline control left)	'mouse-delete-other-windows)
+(global-set-mouse '(modeline control right)	'mouse-delete-window)
+
+;; in case of confusion, just select it:
+(global-set-mouse '(modeline control left right)'mouse-select-window)
+
+;; even without confusion (and without the keyboard) select it:
+(global-set-mouse '(modeline left right)	'mouse-select-window)
+
+;; And the help menu:
+(global-set-mouse '(modeline shift  control meta right)	'mouse-help-region)
+(global-set-mouse '(modeline double control meta right)	'mouse-help-region)
+
+;;;
+;;; Minibuffer Mousemap
+;;; Demonstrating some variety:
+;;;
+(global-set-mouse '(minibuffer left)		'mini-move-point)
+
+(global-set-mouse '(minibuffer         middle)	'mini-set-mark-and-stuff)
+
+(global-set-mouse '(minibuffer shift   middle) '(select-previous-complex-command))
+(global-set-mouse '(minibuffer double  middle) '(select-previous-complex-command))
+(global-set-mouse '(minibuffer control middle) '(next-complex-command 1))
+(global-set-mouse '(minibuffer meta    middle) '(previous-complex-command 1))
+
+(global-set-mouse '(minibuffer right)	'minibuffer-menu-eval)
+
+(global-set-mouse '(minibuffer shift  control meta right)  'mouse-help-region)
+(global-set-mouse '(minibuffer double control meta right)  'mouse-help-region)
+
diff --git a/lisp/term/sun-mouse.el b/lisp/term/sun-mouse.el
new file mode 100644
index 00000000000..bed2b416c1f
--- /dev/null
+++ b/lisp/term/sun-mouse.el
@@ -0,0 +1,668 @@
+;; Mouse handling for Sun windows
+;; Copyright (C) 1987 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 1, 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.
+
+;;; Jeff Peck, Sun Microsystems, Jan 1987.
+;;; Original idea by Stan Jefferson
+
+(provide 'sun-mouse)
+
+;;;
+;;;     Modelled after the GNUEMACS keymap interface.
+;;;
+;;; User Functions:
+;;;   make-mousemap, copy-mousemap, 
+;;;   define-mouse, global-set-mouse, local-set-mouse,
+;;;   use-global-mousemap, use-local-mousemap,
+;;;   mouse-lookup, describe-mouse-bindings
+;;;
+;;; Options:
+;;;   extra-click-wait, scrollbar-width
+;;;
+
+(defvar extra-click-wait 150
+  "*Number of milliseconds to wait for an extra click.
+Set this to zero if you don't want chords or double clicks.")
+
+(defvar scrollbar-width 5
+  "*The character width of the scrollbar.
+The cursor is deemed to be in the right edge scrollbar if it is this near the
+right edge, and more than two chars past the end of the indicated line.
+Setting to nil limits the scrollbar to the edge or vertical dividing bar.")
+
+;;;
+;;; Mousemaps
+;;;
+(defun make-mousemap ()
+  "Returns a new mousemap."
+  (cons 'mousemap nil))
+
+(defun copy-mousemap (mousemap)
+  "Return a copy of mousemap."
+  (copy-alist mousemap))
+
+(defun define-mouse (mousemap mouse-list def)
+  "Args MOUSEMAP, MOUSE-LIST, DEF.  Define MOUSE-LIST in MOUSEMAP as DEF.
+MOUSE-LIST is a list of atoms specifing a mouse hit according to these rules:
+  * One of these atoms specifies the active region of the definition.
+	text, scrollbar, modeline, minibuffer
+  * One or two or these atoms specify the button or button combination.
+        left, middle, right, double
+  * Any combination of these atoms specify the active shift keys.
+        control, shift, meta
+  * With a single unshifted button, you can add
+	up
+    to indicate an up-click.
+The atom `double' is used with a button designator to denote a double click.
+Two button chords are denoted by listing the two buttons.
+See sun-mouse-handler for the treatment of the form DEF."
+  (mousemap-set (mouse-list-to-mouse-code mouse-list) mousemap def))
+
+(defun global-set-mouse (mouse-list def)
+  "Give MOUSE-EVENT-LIST a local definition of DEF.
+See define-mouse for a description of MOUSE-EVENT-LIST and DEF.
+Note that if MOUSE-EVENT-LIST has a local definition in the current buffer,
+that local definition will continue to shadow any global definition."
+  (interactive "xMouse event: \nxDefinition: ")
+  (define-mouse current-global-mousemap mouse-list def))
+
+(defun local-set-mouse (mouse-list def)
+  "Give MOUSE-EVENT-LIST a local definition of DEF.
+See define-mouse for a description of the arguments.
+The definition goes in the current buffer's local mousemap.
+Normally buffers in the same major mode share a local mousemap."
+  (interactive "xMouse event: \nxDefinition: ")
+  (if (null current-local-mousemap)
+      (setq current-local-mousemap (make-mousemap)))
+  (define-mouse current-local-mousemap mouse-list def))
+
+(defun use-global-mousemap (mousemap)
+  "Selects MOUSEMAP as the global mousemap."
+  (setq current-global-mousemap mousemap))
+
+(defun use-local-mousemap (mousemap)
+  "Selects MOUSEMAP as the local mousemap.
+nil for MOUSEMAP means no local mousemap."
+  (setq current-local-mousemap mousemap))
+
+
+;;;
+;;; Interface to the Mouse encoding defined in Emacstool.c
+;;;
+;;; Called when mouse-prefix is sent to emacs, additional
+;;; information is read in as a list (button x y time-delta)
+;;;
+;;; First, some generally useful functions:
+;;;
+
+(defun logtest (x y)
+  "True if any bits set in X are also set in Y.
+Just like the Common Lisp function of the same name."
+  (not (zerop (logand x y))))
+
+
+;;;
+;;; Hit accessors.
+;;;
+
+(defconst sm::ButtonBits 7)		; Lowest 3 bits.
+(defconst sm::ShiftmaskBits 56)		; Second lowest 3 bits (56 = 63 - 7).
+(defconst sm::DoubleBits 64)		; Bit 7.
+(defconst sm::UpBits 128)		; Bit 8.
+
+;;; All the useful code bits
+(defmacro sm::hit-code (hit)
+  (` (nth 0 (, hit))))
+;;; The button, or buttons if a chord.
+(defmacro sm::hit-button (hit)
+  (` (logand sm::ButtonBits (nth 0 (, hit)))))
+;;; The shift, control, and meta flags.
+(defmacro sm::hit-shiftmask (hit)
+  (` (logand sm::ShiftmaskBits (nth 0 (, hit)))))
+;;; Set if a double click (but not a chord).
+(defmacro sm::hit-double (hit)
+  (` (logand sm::DoubleBits (nth 0 (, hit)))))
+;;; Set on button release (as opposed to button press).
+(defmacro sm::hit-up (hit)
+  (` (logand sm::UpBits (nth 0 (, hit)))))
+;;; Screen x position.
+(defmacro sm::hit-x (hit) (list 'nth 1 hit))
+;;; Screen y position.
+(defmacro sm::hit-y (hit) (list 'nth 2 hit))
+;;; Millisconds since last hit.
+(defmacro sm::hit-delta (hit) (list 'nth 3 hit))
+
+(defmacro sm::hit-up-p (hit)		; A predicate.
+  (` (not (zerop (sm::hit-up (, hit))))))
+
+;;;
+;;; Loc accessors.  for sm::window-xy
+;;;
+(defmacro sm::loc-w (loc) (list 'nth 0 loc))
+(defmacro sm::loc-x (loc) (list 'nth 1 loc))
+(defmacro sm::loc-y (loc) (list 'nth 2 loc))
+
+(defmacro eval-in-buffer (buffer &rest forms)
+  "Macro to switches to BUFFER, evaluates FORMS, returns to original buffer."
+  ;; When you don't need the complete window context of eval-in-window
+  (` (let ((StartBuffer (current-buffer)))
+    (unwind-protect
+	(progn
+	  (set-buffer (, buffer))
+	  (,@ forms))
+    (set-buffer StartBuffer)))))
+
+(put 'eval-in-buffer 'lisp-indent-function 1)
+
+;;; this is used extensively by sun-fns.el
+;;;
+(defmacro eval-in-window (window &rest forms)
+  "Switch to WINDOW, evaluate FORMS, return to original window."
+  (` (let ((OriginallySelectedWindow (selected-window)))
+       (unwind-protect
+	   (progn
+	     (select-window (, window))
+	     (,@ forms))
+	 (select-window OriginallySelectedWindow)))))
+(put 'eval-in-window 'lisp-indent-function 1)
+
+;;;
+;;; handy utility, generalizes window_loop
+;;;
+
+;;; It's a macro (and does not evaluate its arguments).
+(defmacro eval-in-windows (form &optional yesmini)
+  "Switches to each window and evaluates FORM.  Optional argument
+YESMINI says to include the minibuffer as a window.
+This is a macro, and does not evaluate its arguments."
+  (` (let ((OriginallySelectedWindow (selected-window)))
+       (unwind-protect 
+	   (while (progn
+		    (, form)
+		    (not (eq OriginallySelectedWindow
+			     (select-window
+			      (next-window nil (, yesmini)))))))
+	 (select-window OriginallySelectedWindow)))))
+(put 'eval-in-window 'lisp-indent-function 0)
+
+(defun move-to-loc (x y)
+  "Move cursor to window location X, Y.
+Handles wrapped and horizontally scrolled lines correctly."
+  (move-to-window-line y)
+  ;; window-line-end expects this to return the window column it moved to.
+  (let ((cc (current-column))
+	(nc (move-to-column
+	     (if (zerop (window-hscroll))
+		 (+ (current-column)
+		    (min (- (window-width) 2)	; To stay on the line.
+			 x))
+	       (+ (window-hscroll) -1
+		  (min (1- (window-width))	; To stay on the line.
+		       x))))))
+    (- nc cc)))
+
+
+(defun minibuffer-window-p (window)
+  "True iff this WINDOW is minibuffer."
+  (= (screen-height)
+     (nth 3 (window-edges window))	; The bottom edge.
+     ))
+
+
+(defun sun-mouse-handler (&optional hit)
+  "Evaluates the function or list associated with a mouse hit.
+Expecting to read a hit, which is a list: (button x y delta).  
+A form bound to button by define-mouse is found by mouse-lookup. 
+The variables: *mouse-window*, *mouse-x*, *mouse-y* are bound.  
+If the form is a symbol (symbolp), it is funcall'ed with *mouse-window*,
+*mouse-x*, and *mouse-y* as arguments; if the form is a list (listp),
+the form is eval'ed; if the form is neither of these, it is an error.
+Returns nil."
+  (interactive)
+  (if (null hit) (setq hit (sm::combined-hits)))
+  (let ((loc (sm::window-xy (sm::hit-x hit) (sm::hit-y hit))))
+    (let ((*mouse-window* (sm::loc-w loc))
+	  (*mouse-x* (sm::loc-x loc))
+	  (*mouse-y* (sm::loc-y loc))
+	  (mouse-code (mouse-event-code hit loc)))
+      (let ((form (eval-in-buffer (window-buffer *mouse-window*)
+		    (mouse-lookup mouse-code))))
+	(cond ((null form)
+	       (if (not (sm::hit-up-p hit))	; undefined up hits are ok.
+		   (error "Undefined mouse event: %s" 
+			  (prin1-to-string 
+			   (mouse-code-to-mouse-list mouse-code)))))
+	      ((symbolp form)
+	       (setq this-command form)
+	       (funcall form *mouse-window* *mouse-x* *mouse-y*))
+	      ((listp form)
+	       (setq this-command (car form))
+	       (eval form))
+	      (t
+	       (error "Mouse action must be symbol or list, but was: %s"
+		      form))))))
+  ;; Don't let 'sun-mouse-handler get on last-command,
+  ;; since this function should be transparent.
+  (if (eq this-command 'sun-mouse-handler)
+      (setq this-command last-command))
+  ;; (message (prin1-to-string this-command))	; to see what your buttons did
+  nil)
+
+(defun sm::combined-hits ()
+  "Read and return next mouse-hit, include possible double click"
+  (let ((hit1 (mouse-hit-read)))
+    (if (not (sm::hit-up-p hit1))	; Up hits dont start doubles or chords.
+	(let ((hit2 (mouse-second-hit extra-click-wait)))
+	  (if hit2	; we cons'd it, we can smash it.
+	      ; (setf (sm::hit-code hit1) (logior (sm::hit-code hit1) ...))
+	      (setcar hit1 (logior (sm::hit-code hit1) 
+				   (sm::hit-code hit2)
+				   (if (= (sm::hit-button hit1) 
+					  (sm::hit-button hit2))
+				       sm::DoubleBits 0))))))
+    hit1))
+
+(defun mouse-hit-read ()
+  "Read mouse-hit list from keyboard.  Like (read 'read-char),
+but that uses minibuffer, and mucks up last-command."
+  (let ((char-list nil) (char nil))
+    (while (not (equal 13		; Carriage return.
+		       (prog1 (setq char (read-char)) 
+			 (setq char-list (cons char char-list))))))
+    (read (mapconcat 'char-to-string (nreverse char-list) ""))
+    ))
+
+;;; Second Click Hackery....
+;;; if prefix is not mouse-prefix, need a way to unread the char...
+;;; or else have mouse flush input queue, or else need a peek at next char.
+
+;;; There is no peek, but since one character can be unread, we only
+;;; have to flush the queue when the command after a mouse click
+;;; starts with mouse-prefix1 (see below).
+;;;   Something to do later:  We could buffer the read commands and
+;;; execute them ourselves after doing the mouse command (using
+;;; lookup-key ??).
+
+(defvar mouse-prefix1 24		; C-x
+  "First char of mouse-prefix.  Used to detect double clicks and chords.")
+
+(defvar mouse-prefix2 0			; C-@
+  "Second char of mouse-prefix.  Used to detect double clicks and chords.")
+
+
+(defun mouse-second-hit (hit-wait)
+  "Returns the next mouse hit occurring within HIT-WAIT milliseconds."
+  (if (sit-for-millisecs hit-wait) nil	; No input within hit-wait millisecs.
+    (let ((pc1 (read-char)))
+      (if (or (not (equal pc1 mouse-prefix1))
+	      (sit-for-millisecs 3))	; a mouse prefix will have second char
+	  (progn (setq unread-command-char pc1)	; Can get away with one unread.
+		 nil)			; Next input not mouse event.
+	(let ((pc2 (read-char)))
+	  (if (not (equal pc2 mouse-prefix2))
+	      (progn (setq unread-command-char pc1) ; put back the ^X
+;;; Too bad can't do two: (setq unread-command-char (list pc1 pc2))
+		(ding)			; user will have to retype that pc2.
+		nil)			; This input is not a mouse event.
+	    ;; Next input has mouse prefix and is within time limit.
+	    (let ((new-hit (mouse-hit-read))) ; Read the new hit.
+		(if (sm::hit-up-p new-hit)	; Ignore up events when timing.
+		    (mouse-second-hit (- hit-wait (sm::hit-delta new-hit)))
+		  new-hit		; New down hit within limit, return it.
+		  ))))))))
+
+(defun sm::window-xy (x y)
+  "Find window containing screen coordinates X and Y.
+Returns list (window x y) where x and y are relative to window."
+  (or
+   (catch 'found
+     (eval-in-windows 
+      (let ((we (window-edges (selected-window))))
+	(let ((le (nth 0 we))
+	      (te (nth 1 we))
+	      (re (nth 2 we))
+	      (be (nth 3 we)))
+	  (if (= re (screen-width))
+	      ;; include the continuation column with this window
+	      (setq re (1+ re)))
+	  (if (= be (screen-height))
+	      ;; include partial line at bottom of screen with this window
+	      ;; id est, if window is not multple of char size.
+	      (setq be (1+ be)))
+
+	  (if (and (>= x le) (< x re)
+		   (>= y te) (< y be))
+	      (throw 'found 
+		     (list (selected-window) (- x le) (- y te))))))
+      t))				; include minibuffer in eval-in-windows
+   ;;If x,y from a real mouse click, we shouldn't get here.
+   (list nil x y)
+   ))
+
+(defun sm::window-region (loc)
+  "Parse LOC into a region symbol.
+Returns one of (text scrollbar modeline minibuffer)"
+  (let ((w (sm::loc-w loc))
+	(x (sm::loc-x loc))
+	(y (sm::loc-y loc)))
+    (let ((right (1- (window-width w)))
+	  (bottom (1- (window-height w))))
+      (cond ((minibuffer-window-p w) 'minibuffer)
+	    ((>= y bottom) 'modeline)
+	    ((>= x right) 'scrollbar)
+	    ;; far right column (window seperator) is always a scrollbar
+	    ((and scrollbar-width
+		  ;; mouse within scrollbar-width of edge.
+		  (>= x (- right scrollbar-width))
+		  ;; mouse a few chars past the end of line.
+		  (>= x (+ 2 (window-line-end w x y))))
+	     'scrollbar)
+	    (t 'text)))))
+
+(defun window-line-end (w x y)
+  "Return WINDOW column (ignore X) containing end of line Y"
+  (eval-in-window w (save-excursion (move-to-loc (screen-width) y))))
+
+;;;
+;;; The encoding of mouse events into a mousemap.
+;;; These values must agree with coding in emacstool:
+;;;
+(defconst sm::keyword-alist 
+  '((left . 1) (middle . 2) (right . 4)
+    (shift . 8) (control . 16) (meta . 32) (double . 64) (up . 128)
+    (text . 256) (scrollbar . 512) (modeline . 1024) (minibuffer . 2048)
+    ))
+
+(defun mouse-event-code (hit loc)
+  "Maps MOUSE-HIT and LOC into a mouse-code."
+;;;Region is a code for one of text, modeline, scrollbar, or minibuffer.
+  (logior (sm::hit-code hit)
+	  (mouse-region-to-code (sm::window-region loc))))
+
+(defun mouse-region-to-code (region)
+  "Returns partial mouse-code for specified REGION."
+  (cdr (assq region sm::keyword-alist)))
+
+(defun mouse-list-to-mouse-code (mouse-list)
+  "Map a MOUSE-LIST to a mouse-code."
+  (apply 'logior
+	 (mapcar (function (lambda (x)
+			     (cdr (assq x sm::keyword-alist))))
+		  mouse-list)))
+
+(defun mouse-code-to-mouse-list (mouse-code)
+  "Map a MOUSE-CODE to a mouse-list."
+  (apply 'nconc (mapcar
+		 (function (lambda (x)
+			     (if (logtest mouse-code (cdr x))
+				 (list (car x)))))
+		 sm::keyword-alist)))
+
+(defun mousemap-set (code mousemap value)
+  (let* ((alist (cdr mousemap))
+	 (assq-result (assq code alist)))
+    (if assq-result
+	(setcdr assq-result value)
+      (setcdr mousemap (cons (cons code value) alist)))))
+
+(defun mousemap-get (code mousemap)
+  (cdr (assq code (cdr mousemap))))
+
+(defun mouse-lookup (mouse-code)
+  "Look up MOUSE-EVENT and return the definition. nil means undefined."
+  (or (mousemap-get mouse-code current-local-mousemap)
+      (mousemap-get mouse-code current-global-mousemap)))
+
+;;;
+;;; I (jpeck) don't understand the utility of the next four functions
+;;; ask Steven Greenbaum <froud@kestrel>
+;;;
+(defun mouse-mask-lookup (mask list)
+  "Args MASK (a bit mask) and LIST (a list of (code . form) pairs).
+Returns a list of elements of LIST whose code or'ed with MASK is non-zero."
+  (let ((result nil))
+    (while list
+      (if (logtest mask (car (car list)))
+	  (setq result (cons (car list) result)))
+      (setq list (cdr list)))
+    result))
+
+(defun mouse-union (l l-unique)
+  "Return the union of list of mouse (code . form) pairs L and L-UNIQUE,
+where L-UNIQUE is considered to be union'ized already."
+  (let ((result l-unique))
+    (while l
+      (let ((code-form-pair (car l)))
+	(if (not (assq (car code-form-pair) result))
+	    (setq result (cons code-form-pair result))))
+      (setq l (cdr l)))
+    result))
+
+(defun mouse-union-first-prefered (l1 l2)
+  "Return the union of lists of mouse (code . form) pairs L1 and L2,
+based on the code's, with preference going to elements in L1."
+  (mouse-union l2 (mouse-union l1 nil)))
+
+(defun mouse-code-function-pairs-of-region (region)
+  "Return a list of (code . function) pairs, where each code is
+currently set in the REGION."
+  (let ((mask (mouse-region-to-code region)))
+    (mouse-union-first-prefered
+     (mouse-mask-lookup mask (cdr current-local-mousemap))
+     (mouse-mask-lookup mask (cdr current-global-mousemap))
+     )))
+
+;;;
+;;; Functions for DESCRIBE-MOUSE-BINDINGS
+;;; And other mouse documentation functions
+;;; Still need a good procedure to print out a help sheet in readable format.
+;;;
+
+(defun one-line-doc-string (function)
+  "Returns first line of documentation string for FUNCTION.
+If there is no documentation string, then the string
+\"No documentation\" is returned."
+  (while (consp function) (setq function (car function)))
+  (let ((doc (documentation function)))
+    (if (null doc)
+	"No documentation."
+      (string-match "^.*$" doc)
+      (substring doc 0 (match-end 0)))))
+
+(defun print-mouse-format (binding)
+  (princ (car binding))
+  (princ ": ")
+  (mapcar (function
+	   (lambda (mouse-list)
+	     (princ mouse-list)
+	     (princ " ")))
+	  (cdr binding))
+  (terpri)
+  (princ "  ")
+  (princ (one-line-doc-string (car binding)))
+  (terpri)
+  )
+
+(defun print-mouse-bindings (region)
+  "Prints mouse-event bindings for REGION."
+  (mapcar 'print-mouse-format (sm::event-bindings region)))
+
+(defun sm::event-bindings (region)
+  "Returns an alist of (function . (mouse-list1 ... mouse-listN)) for REGION,
+where each mouse-list is bound to the function in REGION."
+  (let ((mouse-bindings (mouse-code-function-pairs-of-region region))
+	(result nil))
+    (while mouse-bindings
+      (let* ((code-function-pair (car mouse-bindings))
+	     (current-entry (assoc (cdr code-function-pair) result)))
+	(if current-entry
+	    (setcdr current-entry
+		    (cons (mouse-code-to-mouse-list (car code-function-pair))
+			  (cdr current-entry)))
+	  (setq result (cons (cons (cdr code-function-pair)
+				   (list (mouse-code-to-mouse-list
+					  (car code-function-pair))))
+			     result))))
+      (setq mouse-bindings (cdr mouse-bindings))
+      )
+    result))
+
+(defun describe-mouse-bindings ()
+  "Lists all current mouse-event bindings."
+  (interactive)
+  (with-output-to-temp-buffer "*Help*"
+    (princ "Text Region") (terpri)
+    (princ "---- ------") (terpri)
+    (print-mouse-bindings 'text) (terpri)
+    (princ "Modeline Region") (terpri)
+    (princ "-------- ------") (terpri)
+    (print-mouse-bindings 'modeline) (terpri)
+    (princ "Scrollbar Region") (terpri)
+    (princ "--------- ------") (terpri)
+    (print-mouse-bindings 'scrollbar)))
+
+(defun describe-mouse-briefly (mouse-list)
+  "Print a short description of the function bound to MOUSE-LIST."
+  (interactive "xDescibe mouse list briefly: ")
+  (let ((function (mouse-lookup (mouse-list-to-mouse-code mouse-list))))
+    (if function
+	(message "%s runs the command %s" mouse-list function)
+      (message "%s is undefined" mouse-list))))
+
+(defun mouse-help-menu (function-and-binding)
+  (cons (prin1-to-string (car function-and-binding))
+	(menu-create	; Two sub-menu items of form ("String" . nil)
+	 (list (list (one-line-doc-string (car function-and-binding)))
+	       (list (prin1-to-string (cdr function-and-binding)))))))
+
+(defun mouse-help-region (w x y &optional region)
+  "Displays a menu of mouse functions callable in this region."
+  (let* ((region (or region (sm::window-region (list w x y))))
+	 (mlist (mapcar (function mouse-help-menu)
+			(sm::event-bindings region)))
+	 (menu (menu-create (cons (list (symbol-name region)) mlist)))
+	 (item (sun-menu-evaluate w 0 y menu))
+	 )))
+
+;;;
+;;; Menu interface functions
+;;;
+;;; use defmenu, because this interface is subject to change
+;;; really need a menu-p, but we use vectorp and the context...
+;;;
+(defun menu-create (items)
+  "Functional form for defmenu, given a list of ITEMS returns a menu.
+Each ITEM is a (STRING . VALUE) pair."
+  (apply 'vector items)
+  )
+
+(defmacro defmenu (menu &rest itemlist)
+  "Defines MENU to be a menu, the ITEMS are (STRING . VALUE) pairs.
+See sun-menu-evaluate for interpretation of ITEMS."
+  (list 'defconst menu (funcall 'menu-create itemlist))
+  )
+
+(defun sun-menu-evaluate (*menu-window* *menu-x* *menu-y* menu)
+  "Display a pop-up menu in WINDOW at X Y and evaluate selected item
+of MENU.  MENU (or its symbol-value) should be a menu defined by defmenu.
+  A menu ITEM is a (STRING . FORM) pair;
+the FORM associated with the selected STRING is evaluated,
+and the resulting value is returned.  Generally these FORMs are
+evaluated for their side-effects rather than their values.
+  If the selected form is a menu or a symbol whose value is a menu, 
+then it is displayed and evaluated as a pullright menu item.
+  If the the FORM of the first ITEM is nil, the STRING of the item
+is used as a label for the menu, i.e. it's inverted and not selectible."
+
+  (if (symbolp menu) (setq menu (symbol-value menu)))
+  (eval (sun-menu-internal *menu-window* *menu-x* *menu-y* 4 menu)))
+
+(defun sun-get-frame-data (code)
+  "Sends the tty-sub-window escape sequence CODE to terminal,
+and returns a cons of the two numbers in returned escape sequence.
+That is it returns (cons <car> <cdr>) from \"\\E[n;<car>;<cdr>t\". 
+CODE values: 13 = Tool-Position, 14 = Size-in-Pixels, 18 = Size-in-Chars."
+  (send-string-to-terminal (concat "\033[" (int-to-string code) "t"))
+  (let (char str x y)
+    (while (not (equal 116 (setq char (read-char)))) ; #\t = 116
+      (setq str (cons char str)))
+    (setq str (mapconcat 'char-to-string (nreverse str) ""))
+    (string-match ";[0-9]*" str)
+    (setq y (substring str (1+ (match-beginning 0)) (match-end 0)))
+    (setq str (substring str (match-end 0)))
+    (string-match ";[0-9]*" str)
+    (setq x (substring str (1+ (match-beginning 0)) (match-end 0)))
+    (cons (string-to-int y) (string-to-int x))))
+
+(defun sm::font-size ()
+  "Returns font size in pixels: (cons Ysize Xsize)"
+  (let ((pix (sun-get-frame-data 14))	; returns size in pixels
+	(chr (sun-get-frame-data 18)))	; returns size in chars
+    (cons (/ (car pix) (car chr)) (/ (cdr pix) (cdr chr)))))
+
+(defvar sm::menu-kludge-x nil 
+  "Cached frame-to-window X-Offset for sm::menu-kludge")
+(defvar sm::menu-kludge-y nil 
+  "Cached frame-to-window Y-Offset for sm::menu-kludge")
+
+(defun sm::menu-kludge ()
+  "If sunfns.c uses <Menu_Base_Kludge> this function must be here!"
+  (or sm::menu-kludge-y
+      (let ((fs (sm::font-size)))
+	(setq sm::menu-kludge-y (+ 8 (car fs))	; a title line and borders
+	      sm::menu-kludge-x 4)))	; best values depend on .defaults/Menu
+  (let ((wl (sun-get-frame-data 13)))		; returns frame location
+    (cons (+ (car wl) sm::menu-kludge-y)
+	  (+ (cdr wl) sm::menu-kludge-x))))
+
+;;;
+;;;  Function interface to selection/region
+;;;  primative functions are defined in sunfns.c
+;;;
+(defun sun-yank-selection ()
+  "Set mark and yank the contents of the current sunwindows selection
+into the current buffer at point."
+  (interactive "*")
+  (set-mark-command nil)
+  (insert-string (sun-get-selection)))
+
+(defun sun-select-region (beg end)
+  "Set the sunwindows selection to the region in the current buffer."
+  (interactive "r")
+  (sun-set-selection (buffer-substring beg end)))
+
+;;;
+;;; Support for emacstool
+;;; This closes the window instead of stopping emacs.
+;;;
+(defun suspend-emacstool (&optional stuffstring)
+  "If running under as a detached process emacstool,
+you don't want to suspend  (there is no way to resume), 
+just close the window, and wait for reopening."
+  (interactive)
+  (run-hooks 'suspend-hook)
+  (if stuffstring (send-string-to-terminal stuffstring))
+  (send-string-to-terminal "\033[2t")	; To close EmacsTool window.
+  (run-hooks 'suspend-resume-hook))
+;;;
+;;; initialize mouse maps
+;;;
+
+(make-variable-buffer-local 'current-local-mousemap)
+(setq-default current-local-mousemap nil)
+(defvar current-global-mousemap (make-mousemap))
diff --git a/lisp/term/sup-mouse.el b/lisp/term/sup-mouse.el
new file mode 100644
index 00000000000..d03b009136d
--- /dev/null
+++ b/lisp/term/sup-mouse.el
@@ -0,0 +1,207 @@
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;									     ;;
+;;	File:     sup-mouse.el						     ;;
+;;	Author:   Wolfgang Rupprecht					     ;;
+;;	Created:  Fri Nov 21 19:22:22 1986				     ;;
+;;	Contents: supdup mouse support for lisp machines		     ;;
+;;									     ;;
+;;     (from code originally written by John Robinson@bbn for the bitgraph)  ;;
+;;									     ;;
+;;	$Log$								     ;;
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;; GNU Emacs code for lambda/supdup mouse
+;; Copyright (C) Free Software Foundation 1985, 1986
+
+;; 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 1, 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.
+
+;;;  User customization option:
+
+(defvar sup-mouse-fast-select-window nil
+  "*Non-nil for mouse hits to select new window, then execute; else just select.")
+
+(defconst mouse-left 0)
+(defconst mouse-center 1)
+(defconst mouse-right 2)
+
+(defconst mouse-2left 4)
+(defconst mouse-2center 5)
+(defconst mouse-2right 6)
+
+(defconst mouse-3left 8)
+(defconst mouse-3center 9)
+(defconst mouse-3right 10)
+
+;;;  Defuns:
+
+(defun sup-mouse-report ()
+  "This function is called directly by the mouse, it parses and
+executes the mouse commands.
+
+ L move point          *  |---- These apply for mouse click in a window.
+2L delete word            |
+3L copy word		  | If sup-mouse-fast-select-window is nil,
+ C move point and yank *  | just selects that window.
+2C yank pop		  |
+ R set mark            *  |
+2R delete region	  |
+3R copy region		  |
+
+on modeline		    on \"scroll bar\"	in minibuffer
+ L scroll-up		    line to top		execute-extended-command
+ C proportional goto-char   line to middle	mouse-help
+ R scroll-down		    line to bottom	eval-expression"
+  
+  (interactive)
+  (let*
+;; expect a string of <esc>:<buttons>;<x-pos>;<y-pos>c
+      ((buttons (sup-get-tty-num ?\;))
+       (x (sup-get-tty-num ?\;))
+       (y (sup-get-tty-num ?c))
+       (window (sup-pos-to-window x y))
+       (edges (window-edges window))
+       (old-window (selected-window))
+       (in-minibuf-p (eq y (1- (screen-height))))
+       (same-window-p (and (not in-minibuf-p) (eq window old-window)))
+       (in-modeline-p (eq y (1- (nth 3 edges))))
+       (in-scrollbar-p (>= x (1- (nth 2 edges)))))
+    (setq x (- x (nth 0 edges)))
+    (setq y (- y (nth 1 edges)))
+
+;    (error "mouse-hit %d %d %d" buttons x y) ;;;; debug
+
+    (cond (in-modeline-p
+	   (select-window window)
+	   (cond ((= buttons mouse-left)
+		  (scroll-up))
+		 ((= buttons mouse-right)
+		  (scroll-down))
+		 ((= buttons mouse-center)
+		  (goto-char (/ (* x
+				   (- (point-max) (point-min)))
+				(1- (window-width))))
+		  (beginning-of-line)
+		  (what-cursor-position)))
+	   (select-window old-window))
+	  (in-scrollbar-p
+	   (select-window window)
+	   (scroll-up
+	    (cond ((= buttons mouse-left)
+		   y)
+		  ((= buttons mouse-right)
+		   (+ y (- 2 (window-height))))
+		  ((= buttons mouse-center)
+		   (/ (+ 2 y y (- (window-height))) 2))
+		  (t
+		   0)))
+	   (select-window old-window))
+	  (same-window-p
+	   (cond ((= buttons mouse-left)
+		  (sup-move-point-to-x-y x y))
+		 ((= buttons mouse-2left)
+		  (sup-move-point-to-x-y x y)
+		  (kill-word 1))
+		 ((= buttons mouse-3left)
+		  (sup-move-point-to-x-y x y)
+		  (save-excursion
+		    (copy-region-as-kill
+		     (point) (progn (forward-word 1) (point))))
+		  (setq this-command 'yank)
+		  )
+		 ((= buttons mouse-right)
+		  (push-mark)
+		  (sup-move-point-to-x-y x y)
+		  (exchange-point-and-mark))
+		 ((= buttons mouse-2right)
+		  (push-mark)
+		  (sup-move-point-to-x-y x y)
+		  (kill-region (mark) (point)))
+		 ((= buttons mouse-3right)
+		  (push-mark)
+		  (sup-move-point-to-x-y x y)
+		  (copy-region-as-kill (mark) (point))
+		  (setq this-command 'yank))
+		 ((= buttons mouse-center)
+		  (sup-move-point-to-x-y x y)
+		  (setq this-command 'yank)
+		  (yank))
+		 ((= buttons mouse-2center)
+		  (yank-pop 1))
+		 )
+	   )
+	  (in-minibuf-p
+	   (cond ((= buttons mouse-right)
+		  (call-interactively 'eval-expression))
+		 ((= buttons mouse-left)
+		  (call-interactively 'execute-extended-command))
+		 ((= buttons mouse-center)
+		  (describe-function 'sup-mouse-report)); silly self help 
+		 ))
+	  (t				;in another window
+	   (select-window window)
+	   (cond ((not sup-mouse-fast-select-window))
+		 ((= buttons mouse-left)
+		  (sup-move-point-to-x-y x y))
+		 ((= buttons mouse-right)
+		  (push-mark)
+		  (sup-move-point-to-x-y x y)
+		  (exchange-point-and-mark))
+		 ((= buttons mouse-center)
+		  (sup-move-point-to-x-y x y)
+		  (setq this-command 'yank)
+		  (yank))
+		 ))
+	  )))
+
+
+(defun sup-get-tty-num (term-char)
+  "Read from terminal until TERM-CHAR is read, and return intervening number.
+Upon non-numeric not matching TERM-CHAR signal an error."
+  (let
+      ((num 0)
+       (char (read-char)))
+    (while (and (>= char ?0)
+		(<= char ?9))
+      (setq num (+ (* num 10) (- char ?0)))
+      (setq char (read-char)))
+    (or (eq term-char char)
+	(error "Invalid data format in mouse command"))
+    num))
+
+(defun sup-move-point-to-x-y (x y)
+  "Position cursor in window coordinates.
+X and Y are 0-based character positions in the window."
+  (move-to-window-line y)
+  (move-to-column x)
+  )
+
+(defun sup-pos-to-window (x y)
+  "Find window corresponding to screen coordinates.
+X and Y are 0-based character positions on the screen."
+  (let ((edges (window-edges))
+	(window nil))
+    (while (and (not (eq window (selected-window)))
+		(or (<  y (nth 1 edges))
+		    (>= y (nth 3 edges))
+		    (<  x (nth 0 edges))
+		    (>= x (nth 2 edges))))
+      (setq window (next-window window))
+      (setq edges (window-edges window))
+      )
+    (or window (selected-window))
+    )
+  )
diff --git a/lisp/vmsproc.el b/lisp/vmsproc.el
new file mode 100644
index 00000000000..b4451a40ad0
--- /dev/null
+++ b/lisp/vmsproc.el
@@ -0,0 +1,138 @@
+;; Run asynchronous VMS subprocesses under Emacs
+;; Copyright (C) 1986 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 1, 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.
+
+;; Written by Mukesh Prasad.
+
+(defvar display-subprocess-window nil
+  "If non-nil, the suprocess window is displayed whenever input is received.")
+
+(defvar command-prefix-string "$ "
+  "String to insert to distinguish commands entered by user.")
+
+(defvar subprocess-running nil)
+(defvar command-mode-map nil)
+
+(if command-mode-map
+    nil
+  (setq command-mode-map (make-sparse-keymap))
+  (define-key command-mode-map "\C-m" 'command-send-input)
+  (define-key command-mode-map "\C-u" 'command-kill-line))
+
+(defun subprocess-input (name str)
+  "Handles input from a subprocess.  Called by Emacs."
+  (if display-subprocess-window
+      (display-buffer subprocess-buf))
+  (let ((old-buffer (current-buffer)))
+    (set-buffer subprocess-buf)
+    (goto-char (point-max))
+    (insert str)
+    (insert ?\n)
+    (set-buffer old-buffer)))
+
+(defun subprocess-exit (name)
+  "Called by Emacs upon subprocess exit."
+  (setq subprocess-running nil))
+
+(defun start-subprocess ()
+  "Spawns an asynchronous subprocess with output redirected to
+the buffer *COMMAND*.  Within this buffer, use C-m to send
+the last line to the subprocess or to bring another line to
+the end."
+  (if subprocess-running
+      (return t))
+  (setq subprocess-buf (get-buffer-create "*COMMAND*"))
+  (save-excursion
+    (set-buffer subprocess-buf)
+    (use-local-map command-mode-map))
+  (setq subprocess-running (spawn-subprocess 1 'subprocess-input
+					     'subprocess-exit))
+  ;; Initialize subprocess so it doesn't panic and die upon
+  ;; encountering the first error.
+  (and subprocess-running
+       (send-command-to-subprocess 1 "ON SEVERE_ERROR THEN CONTINUE")))
+
+(defun subprocess-command-to-buffer (command buffer)
+  "Execute COMMAND and redirect output into BUFFER."
+  (let (cmd args)
+    (setq cmd (substring command 0 (string-match " " command)))
+    (setq args (substring command (string-match " " command)))
+    (call-process cmd nil buffer nil "*dcl*" args)))
+;BUGS: only the output up to the end of the first image activation is trapped.
+;  (if (not subprocess-running)
+;      (start-subprocess))
+;  (save-excursion
+;    (set-buffer buffer)
+;    (let ((output-filename (concat "SYS$SCRATCH:OUTPUT-FOR-"
+;				   (getenv "USER") ".LISTING")))
+;      (while (file-exists-p output-filename)
+;	(delete-file output-filename))
+;      (define-logical-name "SYS$OUTPUT" (concat output-filename "-NEW"))
+;      (send-command-to-subprocess 1 command)
+;      (send-command-to-subprocess 1 (concat
+;				     "RENAME " output-filename
+;				     "-NEW " output-filename))
+;      (while (not (file-exists-p output-filename))
+;	(sleep-for 1))
+;      (define-logical-name "SYS$OUTPUT" nil)
+;      (insert-file output-filename)
+;      (delete-file output-filename))))
+
+(defun subprocess-command ()
+  "Starts asynchronous subprocess if not running and switches to its window."
+  (interactive)
+  (if (not subprocess-running)
+      (start-subprocess))
+  (and subprocess-running
+       (progn (pop-to-buffer subprocess-buf) (goto-char (point-max)))))
+
+(defun command-send-input ()
+  "If at last line of buffer, sends the current line to
+the spawned subprocess.  Otherwise brings back current
+line to the last line for resubmission."
+  (interactive)
+  (beginning-of-line)
+  (let ((current-line (buffer-substring (point)
+                                        (progn (end-of-line) (point)))))
+    (if (eobp)
+	(progn
+	  (if (not subprocess-running)
+	      (start-subprocess))
+	  (if subprocess-running
+	      (progn
+		(beginning-of-line)
+		(send-command-to-subprocess 1 current-line)
+		(if command-prefix-string
+		    (progn (beginning-of-line) (insert command-prefix-string)))
+		(next-line 1))))
+      ;; else -- if not at last line in buffer
+      (end-of-buffer)
+      (backward-char)
+      (next-line 1)
+      (if (string-equal command-prefix-string
+			(substring current-line 0 (length command-prefix-string)))
+	  (insert (substring current-line (length command-prefix-string)))
+	(insert current-line)))))
+
+(defun command-kill-line()
+  "Kills the current line.  Used in command mode."
+  (interactive)
+  (beginning-of-line)
+  (kill-line))
+
+(define-key esc-map "$" 'subprocess-command)
diff --git a/lisp/x-menu.el b/lisp/x-menu.el
new file mode 100644
index 00000000000..878dde0dc5e
--- /dev/null
+++ b/lisp/x-menu.el
@@ -0,0 +1,145 @@
+;; Copyright (C) 1986 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 1, 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.
+
+
+(defmacro caar (conscell)
+  (list 'car (list 'car conscell)))
+
+(defmacro cdar (conscell)
+  (list 'cdr (list 'car conscell)))
+
+(defun x-menu-mode ()
+  "Major mode for creating permanent menus for use with X.
+These menus are implemented entirely in Lisp; popup menus, implemented
+with x-popup-menu, are implemented using XMenu primitives."
+  (make-local-variable 'x-menu-items-per-line)
+  (make-local-variable 'x-menu-item-width)
+  (make-local-variable 'x-menu-items-alist)
+  (make-local-variable 'x-process-mouse-hook)
+  (make-local-variable 'x-menu-assoc-buffer)
+  (setq buffer-read-only t)
+  (setq truncate-lines t)
+  (setq x-process-mouse-hook 'x-menu-pick-entry)
+  (setq mode-line-buffer-identification '("MENU: %32b")))
+
+(defvar x-menu-max-width 0)
+(defvar x-menu-items-per-line 0)
+(defvar x-menu-item-width 0)
+(defvar x-menu-items-alist nil)
+(defvar x-menu-assoc-buffer nil)
+
+(defvar x-menu-item-spacing 1
+  "*Minimum horizontal spacing between objects in a permanent X menu.")
+
+(defun x-menu-create-menu (name)
+  "Create a permanent X menu.  Returns an item which should be used as a
+menu object whenever referring to the menu."
+  (let ((old (current-buffer))
+	(buf (get-buffer-create name)))
+    (set-buffer buf)
+    (x-menu-mode)
+    (setq x-menu-assoc-buffer old)
+    (set-buffer old)
+    buf))
+
+(defun x-menu-change-associated-buffer (menu buffer)
+  "Change associated buffer of MENU to BUFFER.  BUFFER should be a buffer
+object."
+  (let ((old (current-buffer)))
+    (set-buffer menu)
+    (setq x-menu-assoc-buffer buffer)
+    (set-buffer old)))
+
+(defun x-menu-add-item (menu item binding)
+  "Adds to MENU an item with name ITEM, associated with BINDING.
+Following a sequence of calls to x-menu-add-item, a call to x-menu-compute
+should be performed before the menu will be made available to the user.
+
+BINDING should be a function of one argument, which is the numerical
+button/key code as defined in x-menu.el."
+  (let ((old (current-buffer))
+	elt)
+    (set-buffer menu)
+    (if (setq elt (assoc item x-menu-items-alist))
+	(rplacd elt binding)
+      (setq x-menu-items-alist (append x-menu-items-alist
+				       (list (cons item binding)))))
+    (set-buffer old)
+    item))
+
+(defun x-menu-delete-item (menu item)
+  "Deletes from MENU the item named ITEM.  x-menu-compute should be called
+before the menu is made available to the user."
+  (let ((old (current-buffer))
+	elt)
+    (set-buffer menu)
+    (if (setq elt (assoc item x-menu-items-alist))
+	(rplaca elt nil))
+    (set-buffer old)
+    item))
+
+(defun x-menu-activate (menu)
+  "Computes all necessary parameters for MENU.  This must be called whenever
+a menu is modified before it is made available to the user.
+
+This also creates the menu itself."
+  (let ((buf (current-buffer)))
+    (pop-to-buffer menu)
+    (let (buffer-read-only)
+      (setq x-menu-max-width (1- (screen-width)))
+      (setq x-menu-item-width 0)
+      (let (items-head
+	    (items-tail x-menu-items-alist))
+	(while items-tail
+	  (if (caar items-tail)
+	      (progn (setq items-head (cons (car items-tail) items-head))
+		     (setq x-menu-item-width
+			   (max x-menu-item-width
+				(length (caar items-tail))))))
+	  (setq items-tail (cdr items-tail)))
+	(setq x-menu-items-alist (reverse items-head)))
+      (setq x-menu-item-width (+ x-menu-item-spacing x-menu-item-width))
+      (setq x-menu-items-per-line
+	    (max 1 (/ x-menu-max-width x-menu-item-width)))
+      (erase-buffer)
+      (let ((items-head x-menu-items-alist))
+	(while items-head
+	  (let ((items 0))
+	    (while (and items-head
+			(<= (setq items (1+ items)) x-menu-items-per-line))
+	      (insert (format (concat "%"
+				      (int-to-string x-menu-item-width) "s")
+			      (caar items-head)))
+	      (setq items-head (cdr items-head))))
+	  (insert ?\n)))
+      (shrink-window (max 0
+			  (- (window-height)
+			     (1+ (count-lines (point-min) (point-max))))))
+      (goto-char (point-min)))
+    (pop-to-buffer buf)))
+
+(defun x-menu-pick-entry (position event)
+  "Internal function for dispatching on mouse/menu events"
+  (let*	((x (min (1- x-menu-items-per-line)
+		 (/ (current-column) x-menu-item-width)))
+	 (y (- (count-lines (point-min) (point))
+	       (if (zerop (current-column)) 0 1)))
+	 (item (+ x (* y x-menu-items-per-line)))
+	 (litem (cdr (nth item x-menu-items-alist))))
+    (and litem (funcall litem event)))
+  (pop-to-buffer x-menu-assoc-buffer))