changeset 17450:bbf1df3de440

Initial revision

--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lisp/mail/uce.el	Mon Apr 14 10:52:29 1997 +0000
@@ -0,0 +1,300 @@
+;;; uce.el --- facilitate reply to unsolicited commercial email
+
+;; Copyright (C) 1996 Free Software Foundation, Inc.
+
+;; Author: stanislav shalunov <[e-mail]>
+;; Created: 10 Dec 1996
+;; Version: 1.0
+;; Keywords: uce, unsolicited commercial email
+
+;; This file is part of GNU Emacs.
+
+;; This program is free software; you can redistribute it and/or
+;; modify it under the terms of the GNU General Public License as
+;; published by the Free Software Foundation; either version 2, or (at
+;; your option) any later version.
+
+;; This program is distributed in the hope that it will be useful, but
+;; without any warranty; without even the implied warranty of
+;; merchantability or fitness for a particular purpose.  See the GNU
+;; General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; Code in this file provides semi-automatic means of replying to
+;; UCE's you might get.  It works currently only with Rmail.  If you
+;; would like to make it work with other mail readers, Rmail-specific
+;; section is marked below.  If you want to play with code, would you
+;; please grab the newest version from
+;; http://math.wisc.edu/~shalunov/uce.el and let me know, if you would
+;; like, about your changes so I can incorporate them.  I'd appreciate
+;; it.
+
+;; Function uce-reply-to-uce, if called when current message in RMAIL
+;; buffer is a UCE, will setup *mail* buffer in the following way: it
+;; scans full headers of message for 1) normal return address of
+;; sender (From, Reply-To lines); and puts these addresses into To:
+;; header, it also puts [e-mail] address there 2) mailhub
+;; that first saw this message; and puts address of its postmaster
+;; into To: header 3) finally, it looks at Message-Id and adds
+;; posmaster of that host to the list of addresses.
+
+;; Then, we add "Errors-To: nobody@localhost" header, so that if some
+;; of these addresses are not actually correct, we will never see
+;; bounced mail.  Also, mail-self-blind and mail-archive-file-name
+;; take no effect: the ideology is that we don't want to save junk or
+;; replies to junk.
+
+;; Then we put template into buffer (customizable message that
+;; explains what has happened), customizable signature, and the
+;; original message with full headers and envelope for postmasters.
+;; Then buffer is left for editing.
+
+;; The reason that function uce-reply-to-uce is Rmail dependant is
+;; that we want full headers of the original message, nothing
+;; stripped.  If we use normal means of inserting of the original
+;; message into *mail* buffer headers like Received: (not really
+;; headers, but envelope lines) will be stripped while they bear
+;; valuable for us and postmasters information.  I do wish that there
+;; would be some way to write this function in some portable way, but
+;; I am not aware of any.
+
+;;; Change log:
+
+;; Dec 10, 1996 -- posted draft version to gnu.sources.emacs
+
+;; Dec 11, 1996 -- fixed some typos, and Francesco Potorti`
+;; <[e-mail]> pointed out that my use of defvar was
+;; weird, suggested fix, and added let form.
+
+;; Dec 17, 1996 -- made scanning for host names little bit more clever
+;; (obviously bogus stuff like localhost is now ignored).
+
+;;; Setup:
+
+;; put in your ~./emacs the following line:
+
+;; (autoload 'uce-reply-to-uce "uce" "Reply to UCEs" t nil)
+
+;; store this file (uce.el) somewhere in load-path and byte-compile it.
+
+;;; Variables:
+
+;; uce-message-text is template that will be inserted into buffer.  It
+;; has reasonable default.  If you want to write some scarier one,
+;; please do so and send it to me.  Please keep it polite.
+
+;; uce-signature behaves just like mail-signature.  If nil, nothing is
+;; inserted, if t, file ~/.signature is used, if a string, its
+;; contents are inserted into buffer.
+
+;; uce-uce-separator is line that separates your message from the UCE
+;; that you enclose.
+
+;; uce-subject-line will be used as subject of outgoing message.  If
+;; nil, left blank.
+
+;;; Code:
+
+(require 'sendmail)
+(require 'rmail)
+
+(defvar uce-setup-hook nil
+  "Hook to run after UCE rant message is composed.
+This hook is run after mail-setup-hook, which is run as well.")
+
+(defvar uce-message-text 
+  "Recently, I have received an Unsolicited Commercial E-mail from you.
+I do not like UCE's and I would like to inform you that sending
+unsolicited messages to someone while he or she may have to pay for
+reading your message may be illegal.  Anyway, it is highly annoying
+and not welcome by anyone.  It is rude, after all.
+
+If you think that this is a good way to advertise your products or
+services you are mistaken.  Spamming will only make people hate you, not
+buy from you.
+
+If you have any list of people you send unsolicited commercial emails to, 
+REMOVE me from such list immediately.  I suggest that you make this list 
+just empty.
+
+Note to the postmaster(s): I append the text of UCE in question to
+this message, I would like to hear from you about action(s) taken.
+This message has been sent to postmasters at the host that is
+mentioned as original sender's host and to the postmaster whose host
+was used as mail relay for this message.  If message was sent not by
+your user, could you please compare time when this message was sent
+(use time in Received: field of the envelope rather than Date: field)
+with your sendmail logs and see what host was using your sendmail at
+this moment of time.
+
+Thank you."
+
+  "This is the text that uce-reply-to-uce command will put in reply buffer.
+Some of spamming programs in use will be set up to read all incoming
+to spam address email, and will remove people who put the word `remove'
+on beginning of some line from the spamming list.  So, when you set it
+up, it might be a good idea to actually use this feature.
+
+Value nil means insert no text by default, lets you type it in.")
+
+(defvar uce-uce-separator
+  "----- original unsolicited commercial email follows -----"
+  "Line that will begin quoting of the UCE.
+Value nil means use no separator.")
+
+(defvar uce-signature mail-signature
+"Text to put as your signature after the note to UCE sender.  
+Value nil means none, t means insert ~/.signature file (if it happens
+to exist), if this variable is a string this string will be inserted
+as your signature.")
+
+(defvar uce-default-headers
+  "Errors-To: nobody@localhost\nPrecedence: bulk\n"
+  "Additional headers to use when responding to a UCE with \\[uce-reply-to-uce].
+These are mostly meant for headers that prevent delivery errors reporting.")
+
+(defvar uce-subject-line
+  "Spam alert: unsolicited commercial e-mail"
+  "Subject of the message that will be sent in response to a UCE.")
+
+(defun uce-reply-to-uce (&optional ignored)
+  "Send reply to UCE in Rmail.
+UCE stands for unsolicited commercial email.  Function will set up reply
+buffer with default To: to the sender, his postmaster, his abuse@
+address, and postmaster of the mail relay used."
+  (interactive "P")
+  (let ((to (mail-strip-quoted-names (mail-fetch-field "from" t)))
+	(reply-to (mail-fetch-field "reply-to"))
+	temp)
+    ;; Initial setting of the list of recipients of our message; that's
+    ;; what they are pretending to be (and in many cases, really are).
+    (if to
+	(setq to (format "%s" (mail-strip-quoted-names to)))
+      (setq to ""))
+    (if reply-to
+	(setq to (format "%s, %s" to (mail-strip-quoted-names reply-to))))
+    (let (first-at-sign end-of-hostname sender-host)
+      (setq first-at-sign (string-match "@" to)
+	    end-of-hostname (string-match "[ ,>]" to first-at-sign)
+	    sender-host (substring to first-at-sign end-of-hostname))
+      (if (string-match "\\." sender-host)
+          (setq to (format "%s, postmaster%s, abuse%s" 
+                           to sender-host sender-host))))
+    (setq mail-send-actions nil)
+    (setq mail-reply-buffer nil)
+    ;; Begin of Rmail dependant section.
+    (or (get-buffer "RMAIL")
+	(error "No buffer RMAIL, cannot find UCE"))
+    (switch-to-buffer "RMAIL")
+    (save-excursion
+      (save-restriction
+	(widen)
+	(rmail-maybe-set-message-counters)
+	(copy-region-as-kill (rmail-msgbeg rmail-current-message) 
+			     (rmail-msgend rmail-current-message))))
+    (switch-to-buffer "*mail*")
+    (erase-buffer)
+    (setq temp (point))
+    (yank)
+    (goto-char temp)
+    (forward-line 2)
+    (while (looking-at "Summary-Line:\\|Mail-From:")
+      (forward-line 1))
+    (delete-region temp (point))
+    ;; Now find the mail hub that first accepted this message.
+    (while (or (looking-at "Received:")
+               (looking-at " ")
+               (looking-at "\t"))
+      (forward-line 1))
+    (while (or (looking-at " ")
+               (looking-at "\t"))
+      (forward-line -1))
+    ;; Is this always good?  It's the only thing I saw when I checked
+    ;; a few messages.
+    (search-forward ": from ")
+    (setq temp (point))
+    (search-forward " ")
+    (forward-char -1)
+    ;; And add its postmaster to the list of addresses.
+    (if (string-match "\\." (buffer-substring temp (point)))
+        (setq to (format "%s, postmaster@%s" 
+                         to (buffer-substring temp (point)))))
+    ;; Also look at the message-id, it helps *very* often.
+    (search-forward "\nMessage-Id: ")
+    (search-forward "@")
+    (setq temp (point))
+    (search-forward ">")
+    (forward-char -1)
+    (if (string-match "\\." (buffer-substring temp (point)))
+        (setq to (format "%s, postmaster@%s" 
+                         to (buffer-substring temp (point)))))
+    (search-forward "\n*** EOOH ***\n")
+    (forward-line -1)
+    (setq temp (point))
+    (search-forward "\n\n" nil t)
+    (delete-region temp (point))
+    ;; End of Rmail dependent section.
+    (auto-save-mode auto-save-default)
+    (mail-mode)
+    (goto-char (point-min))
+    (insert "To: ")
+    (save-excursion
+      (if to
+	  (let ((fill-prefix "\t")
+		(address-start (point)))
+	    (insert to "\n")
+	    (fill-region-as-paragraph address-start (point)))
+	(newline))
+      (insert "Subject: " uce-subject-line "\n")
+      (if uce-default-headers
+	  (insert uce-default-headers))
+      (if mail-default-headers
+          (insert mail-default-headers))
+      (if mail-default-reply-to
+	  (insert "Reply-to: " mail-default-reply-to "\n"))
+      (insert mail-header-separator "\n")
+      ;; Insert all our text.  Then go back to the place where we started.
+      (if to (setq to (point)))
+      ;; Text of ranting.
+      (if uce-message-text
+	  (insert uce-message-text))
+      ;; Signature.
+      (cond ((eq uce-signature t)
+	     (if (file-exists-p "~/.signature")
+		 (progn
+		   (insert "\n\n-- \n")
+		   (insert-file "~/.signature")
+		   ;; Function insert-file leaves point where it was,
+		   ;; while we want to place signature in the ``middle''
+		   ;; of the message.
+		   (exchange-point-and-mark))))
+	    (uce-signature
+	     (insert "\n\n-- \n" uce-signature)))
+      ;; And text of the original message.
+      (if uce-uce-separator
+	  (insert "\n\n" uce-uce-separator "\n"))
+      ;; If message doesn't end with a newline, insert it.
+      (goto-char (point-max))
+      (or (bolp) (newline)))
+    ;; And go back to the beginning of text.
+    (if to (goto-char to))
+    (or to (set-buffer-modified-p nil))
+    ;; Run hooks before we leave buffer for editing.  Reasonable usage
+    ;; might be to set up special key bindings, replace standart
+    ;; functions in mail-mode, etc.
+    (run-hooks 'mail-setup-hook 'uce-setup-hook)))
+  
+(defun uce-insert-ranting (&optional ignored)
+  "Insert text of the usual reply to UCE into current buffer."
+  (interactive "P")
+  (insert uce-message-text))
+
+(provide 'uce)
+
+;;; uce.el ends here

--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lisp/vcursor.el	Mon Apr 14 10:52:29 1997 +0000
@@ -0,0 +1,823 @@
+;;; vcursor.el --- manipulate an alternative ("virtual") cursor.
+
+;; Copyright (C) 1994, 1996 Peter Stephenson <[e-mail]>
+
+;; Author:   Peter Stephenson <[e-mail]>
+;; Keywords: virtual cursor, display, copying
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; Virtual cursor commands.  I got this idea from the old BBC micro.
+;; You need Emacs 19 (I have not tried XEmacs) and a windowing
+;; system: I have tried X Windows and Oemacs but any system which
+;; supports multiple windows should have the ability to run vcursor.
+;; In fact, only overlays are required to work, though some of the
+;; key-bindings may need changing.
+;;
+;; This is much easier to use than the instructions are to read.
+;; I suggest you simply load it and play around with holding down Ctrl
+;; and Shift and pressing up, down, left, right, tab, return, and see
+;; what happens.  (Find a scratch buffer before using C-S-tab: that
+;; toggles copying.)
+;;
+;; Most of the functions described in this documentation are in
+;; parentheses so that if you have the package loaded you can type C-h
+;; f on top of them for help.
+;;
+;; Using the cursor keys with both control and shift held down moves
+;; around a virtual cursor, which is initially at point.  When active,
+;; it appears with an underline through it to distinguish it from the
+;; normal cursor.  You can then use one of the other commands to copy
+;; characters from the location of the virtual cursor to point.  This
+;; is very useful, for example, when copying some previous text while
+;; making changes to it at the same time, since you never have to move
+;; the "real" cursor away from where you are inserting.
+;;
+;; The remaining default key bindings are based around the PC-type
+;; cluster found above the cursor keys on a lot of keyboards, the
+;; function keys which my limited knowledge of X terminals expects to
+;; find at the top.  Some functions are duplicated in more obvious
+;; places for the X version.
+;;
+;; All the keybindings require you to hold down control and shift at
+;; once.  I assumed this combination wouldn't be heavily bound by most
+;; people and that it would be easy to type with the left hand.
+;; Inevitably it will clash with some other packages, but I can't help
+;; that: an intuitive binding is a prerequisite here.  See below for
+;; other alternatives (search for "Oemacs").
+;; 
+;; Holding down control and shift and pressing insert (vcursor-copy)
+;; copies one character from wherever the virtual cursor is to point;
+;; point and the virtual cursor advance in the separate and equal
+;; station to which... (etc.).  M-C-S-return (vcursor-copy-line)
+;; copies to the end of the line instead of just one character,
+;; C-S-delete or C-S-remove (vcursor-copy-word) copies a word.
+;; 
+;; A more general way of copying is to use C-S-tab, which is a toggle.
+;; In the "on" state, moving the virtual cursor will copy the
+;; moved-over text to the normal cursor position (including when going
+;; backwards, though each piece of text moved over is copied forwards:
+;; compare the behaviour of C-S-up and C-S-left).
+;;
+;; However, that's just a small part of the magic.  If the virtual
+;; cursor goes off the display, it will be redisplayed in some other
+;; window.  (See the function (vcursor-find-window) for details of how
+;; this window is chosen.)  This gives you fingertip control over two
+;; windows at once.
+;; 
+;; C-S-return (vcursor-disable) disables the virtual cursor, removing
+;; it so that it starts from point whenever you move it again --- note
+;; that simply moving the cursor and virtual cursor on top of one
+;; another does not have this effect.
+;; 
+;; If you gave C-S-return a positive prefix arg, it will also delete the
+;; window (unless it's the current one).  Whenever the virtual cursor
+;; goes off-screen in its own window, point in that window is moved as
+;; well to restore it to view.  (It's easier that way, that's why.
+;; However, point doesn't move unless the view in the window does, so
+;; it's not tied to the virtual cursor location.)
+;;
+;; You can also use C-S-return with a negative prefix argument which
+;; forces the vcursor to appear at point.  This is particularly useful if
+;; you actually want to edit in another window but would like to
+;; remember the current cursor location for examining or copying from
+;; that buffer.  (I just hit C-S-right C-S-left, but I'm a hopeless
+;; lowbrow.)
+;; 
+;; There is also C-S-f6 (vcursor-other-window) which behaves like
+;; C-x o on the virtual rather than the real cursor, except that it
+;; will create another window if necessary.
+;;
+;; The keys C-S-prior (vcursor-scroll-down) and C-S-next
+;; (vcursor-scroll-up) (i.e., PageUp and PageDown) will scroll the
+;; virtual cursor window, appropriately chosen.  They will always
+;; create a new window or take over an old one if necessary.
+;; Likewise, M-C-S-left and M-C-S-right move you to the
+;; beginning or end of a line, C-S-home and C-S-end the
+;; beginning or end of a buffer (these are also on M-C-S-up and
+;; M-C-S-down for those of us stuck with DEC keyboards).
+;;
+;; C-S-f7 (vcursor-goto) will take you to the vcursor position
+;; (swapping windows if it seems sensible) and (unless you give it a
+;; prefix argument) delete the virtual cursor, so this is useful for
+;; you to take over editing at the virtual cursor position.  It is not
+;; an error if the virtual cursor is not active; it simply leaves you
+;; at point, because that is where the virtual cursor would start
+;; from.
+;;
+;; In a similar vein, M-C-S-tab (hope your left hand's flexible;
+;; C-S-select on DEC keyboards) (vcursor-swap-point) will take you to
+;; the virtual cursor position but simultaneously put the virtual
+;; cursor at the old cursor position.  It is also supposed to ensure
+;; that both are visible.
+;;
+;; C-S-f8 (C-S-find on DEC keyboards) (vcursor-isearch-forward)
+;; allows you to do an isearch in another window.  It works a bit like
+;; vcursor-scroll-*; it moves into another window, calls isearch
+;; there, and sets the virtual cursor position to the point found.  In
+;; other words, it works just like isearch but with the virtual cursor
+;; instead of the real one (that's why it's called a "virtual
+;; cursor").  While you are isearching, you are editing in the virtual
+;; cursor window, but when you have finished you return to where you
+;; started.  Note that once you are in isearch all the keys are normal
+;; --- use C-s, not C-S-f8, to search for the next occurrence.
+;;
+;; If you set the variable vcursor-auto-disable, then any command
+;; which does not involve moving or copying from the virtual cursor
+;; causes the virtual cursor to be disabled.  If you don't intend to
+;; use this, you can comment out the `add-hook' line at the bottom of
+;; this file.  (This feature partially emulates the way the "copy" key
+;; on the BBC micro worked; actually, the copy cursor was homed when
+;; you hit return.  This was in keeping with the line-by-line way of
+;; entering BASIC, but is less appropriate here.)
+;;
+;; There is a way of moving the virtual cursor using ordinary
+;; commands: C-S-f9 (vcursor-execute-key) reads a key string,
+;; moves to the virtual cursor position, executes the command bound to
+;; the string, then returns to the original point.  Thus C-S-f9 M-m
+;; moves the virtual cursor back to the first non-whitespace character
+;; on its line.  As the command is called interactively all the usual
+;; ways of passing information to the command called, such as by a
+;; prefix argument, are available.  C-S-f10 (C-S-x)
+;; (vcursor-execute-command) behaves the same way but you enter the
+;; name of the command.  Of course, only some commands are useful
+;; here, mainly simple movement commands.  Killing at the virtual
+;; cursor position in this way works as well; you can even save
+;; another buffer with C-S-f9 C-x C-s.  To do anything more
+;; complicated, you are better off using M-C-S-tab
+;; (vcursor-swap-point), doing whatever it is, then calling M-C-S-tab
+;; again.
+;;
+;; If you want to add your own moving or copying functions you should
+;; be able to do this fairly easily with (vcursor-relative-move) and
+;; (vcursor-copy) together with (vcursor-get-char-count).  If you want to
+;; do something in a different window, use (vcursor-window-funcall).
+;;
+;; There is an alternative set of key bindings which will be used
+;; automatically for a PC if Oemacs is detected.  This set uses separate
+;; control, shift and meta keys with function keys 1 to 10.  In
+;; particular, movement keys are concentrated on f5 to f8 with (in
+;; increasing order of distance travelled) C-, M- and S- as prefixes.
+;; See the actual bindings below (search for C-f1).  This is because the
+;; C-S- prefix is represented by weird key sequences and the set is
+;; incomplete; if you don't mind that, some hints are given in comments
+;; below.
+;;
+;; You can specify the usual or the Oemacs bindings by setting the
+;; variable vcursor-key-bindings to `xterm' or `oemacs'.  You can also set
+;; it to nil, in which case vcursor will not make any key bindings
+;; and you can define your own.  The default is t, which makes vcursor
+;; guess (it will use xterm unless it thinks Oemacs is running).  The
+;; oemacs set will work on an X terminal with function keys, but the
+;; xterm set will not work under Oemacs.
+;;
+;; Un-features:
+;;  - The vcursor will not move to point-max, since otherwise it would
+;;    disappear.  However, no error is flagged as point-max is a valid
+;;    point in the buffer.  Thus cursor right or down at the second
+;;    last point in the file does not flag an error, which is inconsistent,
+;;    and if copying is on the last character (typically newline) will
+;;    be repeatedly copied.  (I've tried making it flag an error
+;;    instead and that's worse since often the vcursor is sent to
+;;    point in some other window, which may be point-max.)
+;;  - The vcursor widens when over a tab character or right at the
+;;    end of the line.  You're welcome to consider this a feature;
+;;    it's just a part of how overlays work.
+;;  - The vcursor obscures the real cursor.  Creative use of overlays
+;;    could cure this.
+;;  - The vcursor does not remember its own previous positions.  If
+;;    you cycle it back into a window it was in before, it will be at
+;;    point in that window.  Often, that is where a previous recenter
+;;    left point, not where the vcursor was before.
+;;    (Note, however, that the vcursor does remember where it *is*,
+;;    even if it's off-screen.  This can also lead to surprises, but I
+;;    don't think it's a bug.)
+;;  - vcursor-window-funcall could perhaps be smarter about restoring
+;;    the previous window state on failure.
+;;  - The logic in vcursor-find-window is rather complicated and
+;;    therefore bug-prone, though in practice it seems to work OK.
+;;
+;; Possible enhnacements:
+;; It would be easy to implement vcursor-push (save vcursor position
+;; as mark and deactivate) and vcursor-pop (deactivate vcursor and
+;; move to last pushed position) functions.
+
+;;; Code:
+
+(or (memq 'vcursor (face-list))
+    (progn
+      (copy-face 'modeline 'vcursor)
+      (if (or (fboundp 'oemacs-version) (x-display-color-p))
+	  (progn
+	    (set-face-foreground 'vcursor "blue")
+	    (set-face-background 'vcursor "cyan")))
+      (set-face-underline-p 'vcursor t)))
+
+(defvar vcursor-auto-disable nil
+  "*If non-nil, disable the virtual cursor after use.
+Any non-vcursor command will force `vcursor-disable' to be called.")
+
+(defvar vcursor-key-bindings t
+  "*How to bind keys when vcursor is loaded.
+If t (the default), guess; if xterm, use bindings suitable for an
+X terminal; if oemacs, use bindings which work on a PC with Oemacs.
+If nil, don't define any key bindings.")
+
+(defvar vcursor-overlay nil
+  "Overlay for the virtual cursor.
+It is nil if that is not enabled.")
+
+(defvar vcursor-window nil
+  "Last window to have displayed the virtual cursor.
+See the function `vcursor-find-window' for how this is used.")
+
+(defvar vcursor-last-command nil
+  "Non-nil if last command was a vcursor command.
+The commands `vcursor-copy', `vcursor-relative-move' and the ones for
+scrolling set this.  It is used by the `vcursor-auto-disable' code.")
+;; could do some memq-ing with last-command instead, but this will
+;; automatically handle any new commands using the primitives.
+
+(defvar vcursor-copy-flag nil 
+  "*Non-nil means moving vcursor should copy characters moved over to point.")
+
+(defvar vcursor-temp-goal-column nil
+  "Keeps track of temporary goal columns for the virtual cursor.")
+
+(cond
+ ((not vcursor-key-bindings))  ;; don't set any key bindings
+ ((or (eq vcursor-key-bindings 'oemacs)
+      (and (eq vcursor-key-bindings t) (fboundp 'oemacs-version)))
+  (global-set-key [C-f1] 'vcursor-toggle-copy)
+  (global-set-key [C-f2] 'vcursor-copy)
+  (global-set-key [C-f3] 'vcursor-copy-word)
+  (global-set-key [C-f4] 'vcursor-copy-line)
+
+  (global-set-key [S-f1] 'vcursor-disable)
+  (global-set-key [S-f2] 'vcursor-other-window)
+  (global-set-key [S-f3] 'vcursor-goto)
+  (global-set-key [S-f4] 'vcursor-swap-point)
+
+  (global-set-key [C-f5] 'vcursor-backward-char)
+  (global-set-key [C-f6] 'vcursor-previous-line)
+  (global-set-key [C-f7] 'vcursor-next-line)
+  (global-set-key [C-f8] 'vcursor-forward-char)
+
+  (global-set-key [M-f5] 'vcursor-beginning-of-line)
+  (global-set-key [M-f6] 'vcursor-backward-word)
+  (global-set-key [M-f6] 'vcursor-forward-word)
+  (global-set-key [M-f8] 'vcursor-end-of-line)
+
+  (global-set-key [S-f5] 'vcursor-beginning-of-buffer)
+  (global-set-key [S-f6] 'vcursor-scroll-down)
+  (global-set-key [S-f7] 'vcursor-scroll-up)
+  (global-set-key [S-f8] 'vcursor-end-of-buffer)
+
+  (global-set-key [C-f9] 'vcursor-isearch-forward)
+
+  (global-set-key [S-f9] 'vcursor-execute-key)
+  (global-set-key [S-f10] 'vcursor-execute-command)
+
+;;; Partial dictionary of Oemacs key sequences for you to roll your own,
+;;; e.g C-S-up: (global-set-key "\M-[\C-f\M-\C-m" 'vcursor-previous-line)
+;;;    Sequence:         Sends:
+;;; "\M-[\C-f\M-\C-m"   C-S-up
+;;; "\M-[\C-f\M-\C-q"   C-S-down
+;;; "\M-[\C-fs"         C-S-left
+;;; "\M-[\C-ft"         C-S-right
+;;;
+;;; "\M-[\C-fw"         C-S-home
+;;; "\M-[\C-b\C-o"      S-tab
+;;; "\M-[\C-f\M-\C-r"   C-S-insert
+;;; "\M-[\C-fu"         C-S-end
+;;; "\M-[\C-f\M-\C-s"   C-S-delete
+;;; "\M-[\C-f\M-\C-d"   C-S-prior
+;;; "\M-[\C-fv"         C-S-next
+;;;                      
+;;; "\M-[\C-f^"         C-S-f1
+;;; "\M-[\C-f_"         C-S-f2
+;;; "\M-[\C-f`"         C-S-f3
+;;; "\M-[\C-fa"         C-S-f4
+;;; "\M-[\C-fb"         C-S-f5
+;;; "\M-[\C-fc"         C-S-f6
+;;; "\M-[\C-fd"         C-S-f7
+;;; "\M-[\C-fe"         C-S-f8
+;;; "\M-[\C-ff"         C-S-f9
+;;; "\M-[\C-fg"         C-S-f10
+  )
+ (t
+  (global-set-key [C-S-up] 'vcursor-previous-line)
+  (global-set-key [C-S-down] 'vcursor-next-line)
+  (global-set-key [C-S-left] 'vcursor-backward-char)
+  (global-set-key [C-S-right] 'vcursor-forward-char)
+   
+  (global-set-key [C-S-return] 'vcursor-disable)
+  (global-set-key [C-S-insert]  'vcursor-copy)
+  (global-set-key [C-S-delete] 'vcursor-copy-word)
+  (global-set-key [C-S-remove] 'vcursor-copy-word)
+  (global-set-key [C-S-tab] 'vcursor-toggle-copy)
+  (global-set-key [C-S-home] 'vcursor-beginning-of-buffer)
+  (global-set-key [M-C-S-up] 'vcursor-beginning-of-buffer)
+  (global-set-key [C-S-end] 'vcursor-end-of-buffer)
+  (global-set-key [M-C-S-down] 'vcursor-end-of-buffer)
+  (global-set-key [C-S-prior] 'vcursor-scroll-down)
+  (global-set-key [C-S-next] 'vcursor-scroll-up)
+   
+  (global-set-key [C-S-f6] 'vcursor-other-window)
+  (global-set-key [C-S-f7] 'vcursor-goto)
+
+  (global-set-key [C-S-select] 'vcursor-swap-point) ; DEC keyboards
+  (global-set-key [M-C-S-tab] 'vcursor-swap-point)
+
+  (global-set-key [C-S-find] 'vcursor-isearch-forward) ; DEC keyboards
+  (global-set-key [C-S-f8] 'vcursor-isearch-forward)
+
+  (global-set-key [M-C-S-left] 'vcursor-beginning-of-line)
+  (global-set-key [M-C-S-right] 'vcursor-end-of-line)
+
+  (global-set-key [M-C-S-prior] 'vcursor-backward-word)
+  (global-set-key [M-C-S-next] 'vcursor-forward-word)
+
+  (global-set-key [M-C-S-return] 'vcursor-copy-line)
+
+  (global-set-key [C-S-f9] 'vcursor-execute-key)
+  (global-set-key [C-S-f10] 'vcursor-execute-command)
+  ))
+
+(defun vcursor-locate ()
+  "Go to the starting point of the virtual cursor.
+If that's disabled, don't go anywhere but don't complain."
+  ;; This is where we go off-mass-shell.  Assume there is a
+  ;; save-excursion to get us back to the pole, er, point.
+
+  (and (overlayp vcursor-overlay)
+       (overlay-buffer vcursor-overlay)
+       (set-buffer (overlay-buffer vcursor-overlay))
+       (goto-char (overlay-start vcursor-overlay)))
+  )
+
+(defun vcursor-find-window (&optional not-this new-win this-frame)
+  "Return a suitable window for displaying the virtual cursor.
+This is the first window in cyclic order where the vcursor is visible.
+
+With optional NOT-THIS non-nil never return the current window.
+
+With NEW-WIN non-nil, display the virtual cursor buffer in another
+window if the virtual cursor is not currently visible \(note, however,
+that this function never changes window-point\).
+
+With THIS-FRAME non-nil, don't search other frames for a new window
+\(though if the vcursor is already off-frame then its current window is
+always considered, and the value of `pop-up-frames' is always respected\).
+
+Returns nil if the virtual cursor is not visible anywhere suitable.
+Set `vcursor-window' to the returned value as a side effect."
+
+  ;; The order of priorities (respecting NOT-THIS) is (1)
+  ;; vcursor-window if the virtual cursor is visible there (2) any
+  ;; window displaying the virtual cursor (3) vcursor-window provided
+  ;; it is still displaying the buffer containing the virtual cursor and
+  ;; is not selected (4) any unselected window displaying the vcursor
+  ;; buffer (5) with NEW-WIN, a window selected by display-buffer (so
+  ;; the variables pop-up-windows and pop-up-frames are significant)
+  ;; (6) nil.
+
+  (let ((thiswin (selected-window)) winok winbuf)
+    (save-excursion
+      (vcursor-locate)
+      (or (and (window-live-p vcursor-window)
+	       (eq (current-buffer) (window-buffer vcursor-window))
+	       (not (and not-this (eq thiswin vcursor-window))))
+	  (setq vcursor-window nil))
+      (or (and vcursor-window		; choice 1
+	       (pos-visible-in-window-p (point) vcursor-window))
+	  (progn
+	    (walk-windows
+	     (function 
+	      (lambda (win)
+		(and (not winok)
+		     (eq (current-buffer) (window-buffer win))
+		     (not (and not-this (eq thiswin win)))
+		     (cond
+		      ((pos-visible-in-window-p (point) win) (setq winok win))
+		      ((eq thiswin win))
+		      ((not winbuf) (setq winbuf win))))))
+	     nil (not this-frame))
+	    (setq vcursor-window
+		  (cond
+		   (winok)		; choice 2
+		   ((and vcursor-window	; choice 3
+			 (not (eq thiswin vcursor-window))) vcursor-window)
+		   (winbuf)		; choice 4
+		   (new-win (display-buffer (current-buffer) t)) ; choice 5
+		   (t nil)))))))	; default (choice 6)
+  vcursor-window
+  )
+
+(defun vcursor-toggle-copy (&optional arg nomsg)
+  "Toggle copying to point when the vcursor is moved.
+With a prefix ARG, turn on if non-negative, off if negative.
+Display a message unless optional NOMSG is non-nil."
+  (interactive "P")
+  (setq vcursor-copy-flag
+	(cond ((not arg) (not vcursor-copy-flag))
+	      ((< (prefix-numeric-value arg) 0) nil)
+	      (t))
+	vcursor-last-command t)
+  (or nomsg (message "Copying from the vcursor is now %s."
+		     (if vcursor-copy-flag "on" "off")))
+  )
+
+(defun vcursor-move (pt)
+  "Move the virtual cursor to the character to the right of PT.
+PT is an absolute location in the current buffer.
+
+If the new virtual cursor location would not be visible, display it in
+another window."
+  ;; this works even if we're on-mass-shell, but usually we won't be.
+
+  (if (eq pt (point-max)) (setq pt (1- pt)))
+  (if (vcursor-check t)
+      (move-overlay vcursor-overlay pt (+ pt 1) (current-buffer))
+    (setq vcursor-overlay (make-overlay pt (+ pt 1)))
+    (overlay-put vcursor-overlay 'face 'vcursor))
+  (vcursor-find-window nil t)
+  ;; vcursor-window now contains the right buffer
+  (or (pos-visible-in-window-p pt vcursor-window)
+      (set-window-point vcursor-window pt))
+  )
+
+(defun vcursor-relative-move (fn &rest args)
+  "Use FUNCTION with arbitrary ARG1 ... to move the virtual cursor.
+
+This is called by most of the virtual-cursor motion commands."
+  (let (text opoint)
+    (save-excursion
+      (vcursor-locate)
+      (setq opoint (point))
+      (apply fn args)
+      (and (eq opoint (point-max)) (eq opoint (point))
+	   (signal 'end-of-buffer nil))
+      (vcursor-move (point))
+      (if vcursor-copy-flag (setq text (buffer-substring opoint (point)))))
+    (if text (insert text)))
+  (setq vcursor-last-command t)
+  )
+
+(defun vcursor-goto (&optional arg)
+  "Move the real cursor to the virtual cursor position.
+If the virtual cursor is (or was recently) visible in another window,
+switch to that first.  Without a prefix ARG, disable the virtual
+cursor as well."
+
+  (interactive "P")
+  (and (vcursor-find-window) (select-window vcursor-window))
+  (let ((buf (and vcursor-overlay (overlay-buffer vcursor-overlay))))
+    (and buf (not (eq (current-buffer) buf)) (switch-to-buffer buf)))
+  (vcursor-locate)
+  (or arg (vcursor-disable))
+  )
+
+(defun vcursor-swap-point ()
+  "Swap the location of point and that of the virtual cursor.
+
+The virtual cursor window becomes the selected window and the old
+window becomes the virtual cursor window.  If the virtual cursor would
+not be visible otherwise, display it in another window."
+
+  (interactive)
+  (let ((buf (current-buffer)) (here (point)) (win (selected-window)))
+    (vcursor-goto) ; will disable the vcursor
+    (save-excursion
+      (set-buffer buf)
+      (setq vcursor-window win)
+      (vcursor-move here)))
+)
+
+(defun vcursor-scroll-up (&optional n)
+  "Scroll up the vcursor window ARG lines or near full screen if none.
+The vcursor will always appear in an unselected window."
+
+  (interactive "P")
+  (vcursor-window-funcall 'scroll-up n)
+)
+
+(defun vcursor-scroll-down (&optional n)
+  "Scroll down the vcursor window ARG lines or near-full screen if none.
+The vcursor will always appear in an unselected window."
+
+  (interactive "P")
+  (vcursor-window-funcall 'scroll-down n)
+  )
+
+(defun vcursor-isearch-forward (&optional rep norecurs)
+  "Perform forward incremental search in the virtual cursor window.
+The virtual cursor is moved to the resulting point; the ordinary
+cursor stays where it was."
+
+  (interactive "P")
+  (vcursor-window-funcall 'isearch-forward rep norecurs)
+  )
+
+(defun vcursor-window-funcall (func &rest args)
+  "Call FUNC with ARGS ... in a virtual cursor window.
+A window other than the currently-selected one will always be used.
+The virtual cursor is moved to the value of point when the function
+returns."
+
+  (vcursor-find-window t t)
+  (let ((sw (selected-window)) text)
+    ;; We can't use save-window-excursion because that would restore
+    ;; the original display in the window we may want to alter.
+    (unwind-protect
+	(let ((here (point)))
+	  (select-window vcursor-window)
+	  (vcursor-locate)
+	  (apply func args)
+	  (if vcursor-copy-flag (setq text (buffer-substring here (point))))
+	  (vcursor-move (point)))
+      (select-window sw))
+    (if text (insert text)))
+  (setq vcursor-last-command t)
+  )
+
+(defun vcursor-get-char-count (fn &rest args)
+  "Apply FN to ARG1 ... and return the number of characters moved.
+Point is temporarily set to the virtual cursor position before FN is
+called.
+
+This is called by most of the virtual-cursor copying commands to find
+out how much to copy."
+
+  (vcursor-check)
+  (save-excursion
+    (set-buffer (overlay-buffer vcursor-overlay))
+    (let ((start (goto-char (overlay-start vcursor-overlay))))
+      (- (progn (apply fn args) (point)) start)))
+  )
+
+;; Make sure the virtual cursor is active.  Unless arg is non-nil,
+;; report an error if it is not.
+(defun vcursor-check (&optional arg)
+  (cond
+   ((and (overlayp vcursor-overlay) (overlay-start vcursor-overlay))
+    t)
+   (arg nil)
+   (t (error "The virtual cursor is not active now.")))
+  )
+
+(defun vcursor-disable (&optional arg)
+  "Disable the virtual cursor.
+Next time you use it, it will start from point.
+
+With a positive prefix ARG, the first window in cyclic order
+displaying the virtual cursor (or which was recently displaying the
+virutal cursor) will be deleted unless it's the selected
+window.
+
+With a negative prefix argument, enable the virtual cursor: make it
+active at the same point as the real cursor.
+
+Copying mode is always turned off:  the next use of the vcursor will
+not copy text until you turn it on again."
+
+  (interactive "P")
+  (if (overlayp vcursor-overlay)
+      (progn
+	(delete-overlay vcursor-overlay)
+	(setq vcursor-overlay nil)))
+  (cond
+   ((not (vcursor-find-window t)))
+   ((or (not arg) (< (prefix-numeric-value arg) 0)))
+   ((delete-window vcursor-window)))
+  (and arg (< (prefix-numeric-value arg) 0)
+       (progn
+         (vcursor-move (point))
+         (setq vcursor-window (selected-window))))
+  (setq vcursor-copy-flag nil)
+  )
+
+(defun vcursor-other-window (n &optional all-frames)
+  "Activate the virtual cursor in another window.
+This is the next window cylically after one currently showing the
+virtual cursor, or else after the current selected window.  If there
+is no other window, the current window is split.
+
+Arguments N and optional ALL-FRAMES are the same as with other-window.
+ALL-FRAMES is also used to decide whether to split the window."
+
+  (interactive "p")
+  (if (if (fboundp 'oemacs-version)
+	  (one-window-p nil)
+	(one-window-p nil all-frames))
+      (display-buffer (current-buffer) t))
+  (save-excursion
+    (save-window-excursion
+      ;; We don't use fancy vcursor-find-window trickery, since we're
+      ;; quite happy to have the vcursor cycle back into the current
+      ;; window.
+      (let ((sw (selected-window))
+	    (win (vcursor-find-window nil nil (not all-frames))))
+	(if win (select-window win))
+	;; else start from here
+	(other-window n all-frames)
+	(vcursor-disable -1))))
+  )
+
+(defun vcursor-compare-windows (&optional arg)
+  "Call `compare-windows' in the vcursor window.
+This has the effect of comparing the vcursor window with whichever
+window `next-window' returns there, which may not be the selected one.
+
+A prefix argument, if any, is passed to `compare-windows'."
+  (interactive "P")
+  (vcursor-window-funcall 'compare-windows arg))
+
+(defun vcursor-next-line (arg)
+  "Move the virtual cursor forward ARG lines."
+  ;; This is next-line rewritten for the vcursor.  Maybe it would
+  ;; be easier simply to rewrite line-move.
+  (interactive "p")
+  (let (temporary-goal-column opoint text)
+    (save-excursion
+      (vcursor-locate)
+      (setq temporary-goal-column
+	    (if (or (eq last-command 'vcursor-next-line)
+		    (eq last-command 'vcursor-previous-line))
+		(progn
+		  (setq last-command 'next-line) ; trick line-move
+		  vcursor-temp-goal-column)
+	      (if (and track-eol (eolp)
+		       (or (not (bolp)) (eq last-command 'end-of-line)))
+		  9999
+		(current-column)))
+	    opoint (point))
+      (line-move arg)
+      (and (eq opoint (point-max)) (eq opoint (point))
+	   (signal 'end-of-buffer nil))
+      (if vcursor-copy-flag (setq text (buffer-substring opoint (point))))
+      (vcursor-move (point))
+      (setq vcursor-temp-goal-column temporary-goal-column
+	    vcursor-last-command t))
+    (if text (insert text)))
+  )
+
+(defun vcursor-previous-line (arg)
+  "Move the virtual cursor back ARG lines."
+  (interactive "p")
+  (vcursor-next-line (- arg))
+  )
+
+(defun vcursor-forward-char (arg)
+  "Move the virtual cursor forward ARG characters."
+  (interactive "p")
+  (vcursor-relative-move 'forward-char arg)
+  )
+
+(defun vcursor-backward-char (arg)
+  "Move the virtual cursor backward ARG characters."
+  (interactive "p")
+  (vcursor-relative-move 'backward-char arg)
+  )
+
+(defun vcursor-forward-word (arg)
+  "Move the virtual cursor forward ARG words."
+  (interactive "p")
+  (vcursor-relative-move 'forward-word arg)
+  )
+
+(defun vcursor-backward-word (arg)
+  "Move the virtual cursor backward ARG words."
+  (interactive "p")
+  (vcursor-relative-move 'backward-word arg)
+  )
+
+(defun vcursor-beginning-of-line (arg)
+  "Move the virtual cursor to beginning of its current line.
+ARG is as for `beginning-of-line'."
+  (interactive "P")
+  (vcursor-relative-move 'beginning-of-line
+			 (if arg (prefix-numeric-value arg)))
+  )
+
+(defun vcursor-end-of-line (arg)
+  "Move the virtual cursor to end of its current line.
+ARG is as for `end-of-line'."
+  (interactive "P")
+  (vcursor-relative-move 'end-of-line
+			 (if arg (prefix-numeric-value arg)))
+  )
+
+(defun vcursor-beginning-of-buffer (&optional arg)
+  "Move the virtual cursor to the beginning of its buffer.
+ARG is as for beginning-of-buffer."
+  (interactive "P")
+  (vcursor-relative-move
+   (lambda (arg)
+     (goto-char (if arg (/ (* arg (- (point-max) (point-min))) 10)
+		  (point-min))))
+   (if arg (prefix-numeric-value arg)))
+  )
+
+(defun vcursor-end-of-buffer (&optional arg)
+  "Move the virtual cursor to the end of its buffer.
+ARG is as for end-of-buffer.
+
+Actually, the vcursor is moved to the second from last character or it
+would be invisible."
+  (interactive "P")
+  (vcursor-relative-move
+   (lambda (arg)
+     (goto-char (if arg (- (point-max)
+			   (/ (* arg (- (point-max) (point-min))) 10))
+		  (point-max))))
+   (if arg (prefix-numeric-value arg)))
+  )
+
+(defun vcursor-execute-command (cmd)
+  "Execute COMMAND for the virtual cursor.
+COMMAND is called interactively.  Not all commands (in fact, only a
+small subset) are useful."
+  (interactive "CCommand: ")
+  (let (text opoint)
+    (save-excursion
+      (vcursor-locate)
+      (setq opoint (point))
+      (call-interactively cmd)
+      (if vcursor-copy-flag (setq text (buffer-substring opoint (point))))
+      (vcursor-move (point)))
+    (if text (insert text)))
+  (setq vcursor-last-command t)
+  )
+
+(defun vcursor-execute-key (keys)
+  "Execute the command bound to KEYS for the virtual cursor.
+The command found is called interactively, so prefix argument etc.
+are usable."
+
+  (interactive "kKey sequence: ")
+  (let ((cmd (key-binding keys)))
+    (if cmd (vcursor-execute-command (key-binding keys))))
+  )
+
+(defun vcursor-copy (arg)
+  "Copy ARG characters from the virtual cursor position to point."
+  (interactive "p")
+  (vcursor-check)
+  (insert
+   (save-excursion
+     (set-buffer (overlay-buffer vcursor-overlay))
+     (let* ((ostart (overlay-start vcursor-overlay))
+	    (end (+ ostart arg)))
+       (prog1
+	   (buffer-substring ostart end)
+	 (vcursor-move end)))))
+  (setq vcursor-last-command t)
+)
+
+(defun vcursor-copy-word (arg)
+  "Copy ARG words from the virtual cursor position to point."
+  (interactive "p")
+  (vcursor-copy (vcursor-get-char-count 'forward-word arg))
+  )
+
+(defun vcursor-copy-line (arg)
+  "Copy up to ARGth line after virtual cursor position.
+With no argument, copy to the end of the current line.
+
+Behaviour with regard to newlines is similar (but not identical) to
+`kill-line'; the main difference is that whitespace at the end of the
+line is treated like ordinary characters."
+
+  (interactive "P")
+  (let* ((num (prefix-numeric-value arg))
+	 (count (vcursor-get-char-count 'end-of-line num)))
+    (vcursor-copy (if (or (= count 0) arg) (1+ count) count)))
+  )
+
+(defun vcursor-post-command ()
+  (and vcursor-auto-disable (not vcursor-last-command)
+       vcursor-overlay (vcursor-disable))
+  (setq vcursor-last-command nil)
+  )
+
+(add-hook 'post-command-hook 'vcursor-post-command)
+
+(provide 'vcursor)
+
+;; vcursor.el ends here