changeset 28210:b56f9152e329

Moved here from lisp.
author Gerd Moellmann <gerd@gnu.org>
date Mon, 20 Mar 2000 13:12:14 +0000
parents 62de58b6dfb7
children 1ebbd6d6b1d4
files lisp/net/ange-ftp.el lisp/net/browse-url.el lisp/net/goto-addr.el lisp/net/net-utils.el lisp/net/quickurl.el lisp/net/rcompile.el lisp/net/rlogin.el lisp/net/snmp-mode.el lisp/net/telnet.el lisp/net/webjump.el lisp/net/zone-mode.el
diffstat 11 files changed, 10421 insertions(+), 0 deletions(-) [+]
line wrap: on
line diff
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lisp/net/ange-ftp.el	Mon Mar 20 13:12:14 2000 +0000
@@ -0,0 +1,5695 @@
+;;; ange-ftp.el --- transparent FTP support for GNU Emacs
+
+;; Copyright (C) 1989,90,91,92,93,94,95,96,98  Free Software Foundation, Inc.
+
+;; Author: Andy Norman (ange@hplb.hpl.hp.com)
+;; Maintainer: FSF
+;; Keywords: comm
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; This package attempts to make accessing files and directories using FTP
+;; from within GNU Emacs as simple and transparent as possible.  A subset of
+;; the common file-handling routines are extended to interact with FTP.
+
+;; Usage:
+;;
+;; Some of the common GNU Emacs file-handling operations have been made
+;; FTP-smart.  If one of these routines is given a filename that matches
+;; '/user@host:name' then it will spawn an FTP process connecting to machine
+;; 'host' as account 'user' and perform its operation on the file 'name'.
+;;
+;; For example: if find-file is given a filename of:
+;;
+;;   /ange@anorman:/tmp/notes
+;;
+;; then ange-ftp spawns an FTP process, connect to the host 'anorman' as
+;; user 'ange', get the file '/tmp/notes' and pop up a buffer containing the
+;; contents of that file as if it were on the local filesystem.  If ange-ftp
+;; needs a password to connect then it reads one in the echo area.
+
+;; Extended filename syntax:
+;;
+;; The default extended filename syntax is '/user@host:name', where the
+;; 'user@' part may be omitted.  This syntax can be customised to a certain
+;; extent by changing ange-ftp-name-format.  There are limitations.
+;; The `host' part has an optional suffix `#port' which may be used to
+;; specify a non-default port number for the connexion.
+;;
+;; If the user part is omitted then ange-ftp generates a default user
+;; instead whose value depends on the variable ange-ftp-default-user.
+
+;; Passwords:
+;;
+;; A password is required for each host/user pair.  Ange-ftp reads passwords
+;; as needed.  You can also specify a password with ange-ftp-set-passwd, or
+;; in a *valid* ~/.netrc file.
+
+;; Passwords for user "anonymous":
+;;
+;; Passwords for the user "anonymous" (or "ftp") are handled
+;; specially.  The variable `ange-ftp-generate-anonymous-password'
+;; controls what happens: if the value of this variable is a string,
+;; then this is used as the password; if non-nil (the default), then
+;; the value of `user-mail-address' is used; if nil then the user
+;; is prompted for a password as normal.
+
+;; "Dumb" UNIX hosts:
+;;
+;; The FTP servers on some UNIX machines have problems if the 'ls' command is
+;; used.
+;;
+;; The routine ange-ftp-add-dumb-unix-host can be called to tell ange-ftp to
+;; limit itself to the DIR command and not 'ls' for a given UNIX host.  Note
+;; that this change will take effect for the current GNU Emacs session only.
+;; See below for a discussion of non-UNIX hosts.  If a large number of
+;; machines with similar hostnames have this problem then it is easier to set
+;; the value of ange-ftp-dumb-unix-host-regexp in your .emacs file. ange-ftp
+;; is unable to automatically recognize dumb unix hosts.
+
+;; File name completion:
+;;
+;; Full file-name completion is supported on UNIX, VMS, CMS, and MTS hosts.
+;; To do filename completion, ange-ftp needs a listing from the remote host.
+;; Therefore, for very slow connections, it might not save any time.
+
+;; FTP processes:
+;;
+;; When ange-ftp starts up an FTP process, it leaves it running for speed
+;; purposes.  Some FTP servers will close the connection after a period of
+;; time, but ange-ftp should be able to quietly reconnect the next time that
+;; the process is needed.
+;;
+;; Killing the "*ftp user@host*" buffer also kills the ftp process.
+;; This should not cause ange-ftp any grief.
+
+;; Binary file transfers:
+;;
+;; By default ange-ftp transfers files in ASCII mode.  If a file being
+;; transferred matches the value of ange-ftp-binary-file-name-regexp then
+;; binary mode is used for that transfer.
+
+;; Account passwords:
+;;
+;; Some FTP servers require an additional password which is sent by the
+;; ACCOUNT command.  ange-ftp partially supports this by allowing the user to
+;; specify an account password by either calling ange-ftp-set-account, or by
+;; specifying an account token in the .netrc file.  If the account password
+;; is set by either of these methods then ange-ftp will issue an ACCOUNT
+;; command upon starting the FTP process.
+
+;; Preloading:
+;;
+;; ange-ftp can be preloaded, but must be put in the site-init.el file and
+;; not the site-load.el file in order for the documentation strings for the
+;; functions being overloaded to be available.
+
+;; Status reports:
+;;
+;; Most ange-ftp commands that talk to the FTP process output a status
+;; message on what they are doing.  In addition, ange-ftp can take advantage
+;; of the FTP client's HASH command to display the status of transferring
+;; files and listing directories.  See the documentation for the variables
+;; ange-ftp-{ascii,binary}-hash-mark-size, ange-ftp-send-hash and
+;; ange-ftp-process-verbose for more details.
+
+;; Gateways:
+;;
+;; Sometimes it is necessary for the FTP process to be run on a different
+;; machine than the machine running GNU Emacs.  This can happen when the
+;; local machine has restrictions on what hosts it can access.
+;;
+;; ange-ftp has support for running the ftp process on a different (gateway)
+;; machine.  The way it works is as follows:
+;;
+;; 1) Set the variable 'ange-ftp-gateway-host' to the name of a machine
+;;    that doesn't have the access restrictions.
+;;
+;; 2) Set the variable 'ange-ftp-local-host-regexp' to a regular expression
+;;    that matches hosts that can be contacted from running a local ftp
+;;    process, but fails to match hosts that can't be accessed locally.  For
+;;    example:
+;;
+;;    "\\.hp\\.com$\\|^[^.]*$"
+;;
+;;    will match all hosts that are in the .hp.com domain, or don't have an
+;;    explicit domain in their name, but will fail to match hosts with
+;;    explicit domains or that are specified by their ip address.
+;;
+;; 3) Using NFS and symlinks, make sure that there is a shared directory with
+;;    the *same* name between the local machine and the gateway machine.
+;;    This directory is necessary for temporary files created by ange-ftp.
+;;
+;; 4) Set the variable 'ange-ftp-gateway-tmp-name-template' to the name of
+;;    this directory plus an identifying filename prefix.  For example:
+;;
+;;    "/nfs/hplose/ange/ange-ftp"
+;;
+;;    where /nfs/hplose/ange is a directory that is shared between the
+;;    gateway machine and the local machine.
+;;
+;; The simplest way of getting a ftp process running on the gateway machine
+;; is if you can spawn a remote shell using either 'rsh' or 'remsh'.  If you
+;; can't do this for some reason such as security then points 7 onwards will
+;; discuss an alternative approach.
+;;
+;; 5) Set the variable ange-ftp-gateway-program to the name of the remote
+;;    shell process such as 'remsh' or 'rsh' if the default isn't correct.
+;;
+;; 6) Set the variable ange-ftp-gateway-program-interactive to nil if it
+;;    isn't already.  This tells ange-ftp that you are using a remote shell
+;;    rather than logging in using telnet or rlogin.
+;;
+;; That should be all you need to allow ange-ftp to spawn a ftp process on
+;; the gateway machine.  If you have to use telnet or rlogin to get to the
+;; gateway machine then follow the instructions below.
+;;
+;; 7) Set the variable ange-ftp-gateway-program to the name of the program
+;;    that lets you log onto the gateway machine.  This may be something like
+;;    telnet or rlogin.
+;;
+;; 8) Set the variable ange-ftp-gateway-prompt-pattern to a regular
+;;    expression that matches the prompt you get when you login to the
+;;    gateway machine.  Be very specific here; this regexp must not match
+;;    *anything* in your login banner except this prompt.
+;;    shell-prompt-pattern is far too general as it appears to match some
+;;    login banners from Sun machines.  For example:
+;;
+;;    "^$*$ *"
+;;
+;; 9) Set the variable ange-ftp-gateway-program-interactive to 't' to let
+;;    ange-ftp know that it has to "hand-hold" the login to the gateway
+;;    machine.
+;;
+;; 10) Set the variable ange-ftp-gateway-setup-term-command to a UNIX command
+;;     that will put the pty connected to the gateway machine into a
+;;     no-echoing mode, and will strip off carriage-returns from output from
+;;     the gateway machine.  For example:
+;;
+;;     "stty -onlcr -echo"
+;;
+;;     will work on HP-UX machines, whereas:
+;;
+;;     "stty -echo nl"
+;;
+;;     appears to work for some Sun machines.
+;;
+;; That's all there is to it.
+
+;; Smart gateways:
+;;
+;; If you have a "smart" ftp program that allows you to issue commands like
+;; "USER foo@bar" which do nice proxy things, then look at the variables
+;; ange-ftp-smart-gateway and ange-ftp-smart-gateway-port.
+;;
+;; Otherwise, if there is an alternate ftp program that implements proxy in
+;; a transparent way (i.e. w/o specifying the proxy host), that will
+;; connect you directly to the desired destination host:
+;; Set ange-ftp-gateway-ftp-program-name to that program's name.
+;; Set ange-ftp-local-host-regexp to a value as stated earlier on.
+;; Leave ange-ftp-gateway-host set to nil.
+;; Set ange-ftp-smart-gateway to t.
+
+;; Tips for using ange-ftp:
+;;
+;; 1. For dired to work on a host which marks symlinks with a trailing @ in
+;;    an ls -alF listing, you need to (setq dired-ls-F-marks-symlinks t).
+;;    Most UNIX systems do not do this, but ULTRIX does. If you think that
+;;    there is a chance you might connect to an ULTRIX machine (such as
+;;    prep.ai.mit.edu), then set this variable accordingly.  This will have
+;;    the side effect that dired will have problems with symlinks whose names
+;;    end in an @.  If you get yourself into this situation then editing
+;;    dired's ls-switches to remove "F", will temporarily fix things.
+;;
+;; 2. If you know that you are connecting to a certain non-UNIX machine
+;;    frequently, and ange-ftp seems to be unable to guess its host-type,
+;;    then setting the appropriate host-type regexp
+;;    (ange-ftp-vms-host-regexp, ange-ftp-mts-host-regexp, or
+;;    ange-ftp-cms-host-regexp) accordingly should help. Also, please report
+;;    ange-ftp's inability to recognize the host-type as a bug.
+;;
+;; 3. For slow connections, you might get "listing unreadable" error
+;;    messages, or get an empty buffer for a file that you know has something
+;;    in it. The solution is to increase the value of ange-ftp-retry-time.
+;;    Its default value is 5 which is plenty for reasonable connections.
+;;    However, for some transatlantic connections I set this to 20.
+;;
+;; 4. Beware of compressing files on non-UNIX hosts. Ange-ftp will do it by
+;;    copying the file to the local machine, compressing it there, and then
+;;    sending it back. Binary file transfers between machines of different
+;;    architectures can be a risky business. Test things out first on some
+;;    test files. See "Bugs" below. Also, note that ange-ftp copies files by
+;;    moving them through the local machine. Again, be careful when doing
+;;    this with binary files on non-Unix machines.
+;;
+;; 5. Beware that dired over ftp will use your setting of dired-no-confirm
+;;    (list of dired commands for which confirmation is not asked).  You
+;;    might want to reconsider your setting of this variable, because you
+;;    might want confirmation for more commands on remote direds than on
+;;    local direds. For example, I strongly recommend that you not include
+;;    compress and uncompress in this list. If there is enough demand it
+;;    might be a good idea to have an alist ange-ftp-dired-no-confirm of
+;;    pairs ( TYPE . LIST ), where TYPE is an operating system type and LIST
+;;    is a list of commands for which confirmation would be suppressed.  Then
+;;    remote dired listings would take their (buffer-local) value of
+;;    dired-no-confirm from this alist. Who votes for this?
+
+;; ---------------------------------------------------------------------
+;; Non-UNIX support:
+;; ---------------------------------------------------------------------
+
+;; VMS support:
+;;
+;; Ange-ftp has full support for VMS hosts.  It
+;; should be able to automatically recognize any VMS machine. However, if it
+;; fails to do this, you can use the command ange-ftp-add-vms-host.  As well,
+;; you can set the variable ange-ftp-vms-host-regexp in your .emacs file. We
+;; would be grateful if you would report any failures to automatically
+;; recognize a VMS host as a bug.
+;;
+;; Filename Syntax:
+;;
+;; For ease of *implementation*, the user enters the VMS filename syntax in a
+;; UNIX-y way.  For example:
+;;  PUB$:[ANONYMOUS.SDSCPUB.NEXT]README.TXT;1
+;; would be entered as:
+;;  /PUB$$:/ANONYMOUS/SDSCPUB/NEXT/README.TXT;1
+;; i.e. to log in as anonymous on ymir.claremont.edu and grab the file:
+;;  [.CSV.POLICY]RULES.MEM
+;; you would type:
+;;  C-x C-f /anonymous@ymir.claremont.edu:CSV/POLICY/RULES.MEM
+;;
+;; A legal VMS filename is of the form: FILE.TYPE;##
+;; where FILE can be up to 39 characters
+;;       TYPE can be up to 39 characters
+;;       ## is a version number (an integer between 1 and 32,767)
+;; Valid characters in FILE and TYPE are A-Z 0-9 _ - $
+;; $ cannot begin a filename, and - cannot be used as the first or last
+;; character.
+;;
+;; Tips:
+;; 1. Although VMS is not case sensitive, EMACS running under UNIX is.
+;;    Therefore, to access a VMS file, you must enter the filename with upper
+;;    case letters.
+;; 2. To access the latest version of file under VMS, you use the filename
+;;    without the ";" and version number. You should always edit the latest
+;;    version of a file. If you want to edit an earlier version, copy it to a
+;;    new file first. This has nothing to do with ange-ftp, but is simply
+;;    good VMS operating practice. Therefore, to edit FILE.TXT;3 (say 3 is
+;;    latest version), do C-x C-f /ymir.claremont.edu:FILE.TXT. If you
+;;    inadvertently do C-x C-f /ymir.claremont.edu:FILE.TXT;3, you will find
+;;    that VMS will not allow you to save the file because it will refuse to
+;;    overwrite FILE.TXT;3, but instead will want to create FILE.TXT;4, and
+;;    attach the buffer to this file. To get out of this situation, M-x
+;;    write-file /ymir.claremont.edu:FILE.TXT will attach the buffer to
+;;    latest version of the file. For this reason, in dired "f"
+;;    (dired-find-file), always loads the file sans version, whereas "v",
+;;    (dired-view-file), always loads the explicit version number. The
+;;    reasoning being that it reasonable to view old versions of a file, but
+;;    not to edit them.
+;; 3. EMACS has a feature in which it does environment variable substitution
+;;    in filenames. Therefore, to enter a $ in a filename, you must quote it
+;;    by typing $$.
+
+;; MTS support:
+;;
+;; Ange-ftp has full support for hosts running
+;; the Michigan terminal system.  It should be able to automatically
+;; recognize any MTS machine. However, if it fails to do this, you can use
+;; the command ange-ftp-add-mts-host.  As well, you can set the variable
+;; ange-ftp-mts-host-regexp in your .emacs file. We would be grateful if you
+;; would report any failures to automatically recognize a MTS host as a bug.
+;;
+;; Filename syntax:
+;; 
+;; MTS filenames are entered in a UNIX-y way. For example, if your account
+;; was YYYY, the file FILE in the account XXXX: on mtsg.ubc.ca would be
+;; entered as
+;;   /YYYY@mtsg.ubc.ca:/XXXX:/FILE
+;; In other words, MTS accounts are treated as UNIX directories. Of course,
+;; to access a file in another account, you must have access permission for
+;; it.  If FILE were in your own account, then you could enter it in a
+;; relative name fashion as
+;;   /YYYY@mtsg.ubc.ca:FILE
+;; MTS filenames can be up to 12 characters. Like UNIX, the structure of the
+;; filename does not contain a TYPE (i.e. it can have as many "."'s as you
+;; like.) MTS filenames are always in upper case, and hence be sure to enter
+;; them as such! MTS is not case sensitive, but an EMACS running under UNIX
+;; is.
+
+;; CMS support:
+;; 
+;; Ange-ftp has full support for hosts running
+;; CMS.  It should be able to automatically recognize any CMS machine.
+;; However, if it fails to do this, you can use the command
+;; ange-ftp-add-cms-host.  As well, you can set the variable
+;; ange-ftp-cms-host-regexp in your .emacs file. We would be grateful if you
+;; would report any failures to automatically recognize a CMS host as a bug.
+;; 
+;; Filename syntax:
+;;
+;; CMS filenames are entered in a UNIX-y way. In otherwords, minidisks are
+;; treated as UNIX directories. For example to access the file READ.ME in
+;; minidisk *.311 on cuvmb.cc.columbia.edu, you would enter
+;;   /anonymous@cuvmb.cc.columbia.edu:/*.311/READ.ME
+;; If *.301 is the default minidisk for this account, you could access
+;; FOO.BAR on this minidisk as
+;;   /anonymous@cuvmb.cc.columbia.edu:FOO.BAR
+;; CMS filenames are of the form FILE.TYPE, where both FILE and TYPE can be
+;; up to 8 characters. Again, beware that CMS filenames are always upper
+;; case, and hence must be entered as such.
+;;
+;; Tips:
+;; 1. CMS machines, with the exception of anonymous accounts, nearly always
+;;    need an account password. To have ange-ftp send an account password,
+;;    you can either include it in your .netrc file, or use
+;;    ange-ftp-set-account.
+;; 2. Ange-ftp cannot send "write passwords" for a minidisk. Hopefully, we
+;;    can fix this.
+;;
+;; ------------------------------------------------------------------
+;; Bugs:
+;; ------------------------------------------------------------------
+;; 
+;; 1. Umask problems:
+;;    Be warned that files created by using ange-ftp will take account of the
+;;    umask of the ftp daemon process rather than the umask of the creating
+;;    user.  This is particularly important when logging in as the root user.
+;;    The way that I tighten up the ftp daemon's umask under HP-UX is to make
+;;    sure that the umask is changed to 027 before I spawn /etc/inetd.  I
+;;    suspect that there is something similar on other systems.
+;;
+;; 2. Some combinations of FTP clients and servers break and get out of sync
+;;    when asked to list a non-existent directory.  Some of the ai.mit.edu
+;;    machines cause this problem for some FTP clients. Using
+;;    ange-ftp-kill-ftp-process can restart the ftp process, which
+;;    should get things back in sync.
+;;
+;; 3. Ange-ftp does not check to make sure that when creating a new file,
+;;    you provide a valid filename for the remote operating system.
+;;    If you do not, then the remote FTP server will most likely
+;;    translate your filename in some way. This may cause ange-ftp to
+;;    get confused about what exactly is the name of the file. The
+;;    most common causes of this are using lower case filenames on systems
+;;    which support only upper case, and using filenames which are too
+;;    long.
+;;
+;; 4. Null (blank) passwords confuse both ange-ftp and some FTP daemons.
+;;
+;; 5. Ange-ftp likes to use pty's to talk to its FTP processes.  If GNU Emacs
+;;    for some reason creates a FTP process that only talks via pipes then
+;;    ange-ftp won't be getting the information it requires at the time that
+;;    it wants it since pipes flush at different times to pty's.  One
+;;    disgusting way around this problem is to talk to the FTP process via
+;;    rlogin which does the 'right' things with pty's.
+;;
+;; 6. For CMS support, we send too many cd's. Since cd's are cheap, I haven't
+;;    worried about this too much. Eventually, we should have some caching
+;;    of the current minidisk.
+;;    
+;; 7. Some CMS machines do not assign a default minidisk when you ftp them as
+;;    anonymous. It is then necessary to guess a valid minidisk name, and cd
+;;    to it. This is (understandably) beyond ange-ftp.
+;;
+;; 8. Remote to remote copying of files on non-Unix machines can be risky.
+;;    Depending on the variable ange-ftp-binary-file-name-regexp, ange-ftp
+;;    will use binary mode for the copy. Between systems of different
+;;    architecture, this still may not be enough to guarantee the integrity
+;;    of binary files. Binary file transfers from VMS machines are
+;;    particularly problematical. Should ange-ftp-binary-file-name-regexp be
+;;    an alist of OS type, regexp pairs?
+;;
+;; 9. The code to do compression of files over ftp is not as careful as it
+;;    should be. It deletes the old remote version of the file, before
+;;    actually checking if the local to remote transfer of the compressed
+;;    file succeeds. Of course to delete the original version of the file
+;;    after transferring the compressed version back is also dangerous,
+;;    because some OS's have severe restrictions on the length of filenames,
+;;    and when the compressed version is copied back the "-Z" or ".Z" may be
+;;    truncated. Then, ange-ftp would delete the only remaining version of
+;;    the file.  Maybe ange-ftp should make backups when it compresses files
+;;    (of course, the backup "~" could also be truncated off, sigh...).
+;;    Suggestions?
+;;
+;; 10. If a dir listing is attempted for an empty directory on (at least
+;;     some) VMS hosts, an ftp error is given. This is really an ftp bug, and
+;;     I don't know how to get ange-ftp work to around it.
+;;
+;; 11. Bombs on filenames that start with a space. Deals well with filenames
+;;     containing spaces, but beware that the remote ftpd may not like them
+;;     much.
+;;
+;; 12. The dired support for non-Unix-like systems does not currently work.
+;;     It needs to be reimplemented by modifying the parse-...-listing
+;;	functions to convert the directory listing to ls -l format.
+;; 
+;; 13. The famous @ bug. As mentioned above in TIPS, ULTRIX marks symlinks
+;;     with a trailing @ in a ls -alF listing. In order to account for this
+;;     ange-ftp looks to chop trailing @'s off of symlink names when it is
+;;     parsing a listing with the F switch. This will cause ange-ftp to
+;;     incorrectly get the name of a symlink on a non-ULTRIX host if its name
+;;     ends in an @. ange-ftp will correct itself if you take F out of the
+;;     dired ls switches (C-u s will allow you to edit the switches). The
+;;     dired buffer will be automatically reverted, which will allow ange-ftp
+;;     to fix its files hashtable.  A cookie to anyone who can think of a
+;;     fast, sure-fire way to recognize ULTRIX over ftp.
+
+;; If you find any bugs or problems with this package, PLEASE either e-mail
+;; the above author, or send a message to the ange-ftp-lovers mailing list
+;; below.  Ideas and constructive comments are especially welcome.
+
+;; ange-ftp-lovers:
+;;
+;; ange-ftp has its own mailing list modestly called ange-ftp-lovers.  All
+;; users of ange-ftp are welcome to subscribe (see below) and to discuss
+;; aspects of ange-ftp.  New versions of ange-ftp are posted periodically to
+;; the mailing list.
+
+;; [The following information about lists may be obsolete.]
+
+;; To [un]subscribe to ange-ftp-lovers, or to report mailer problems with the
+;; list, please mail one of the following addresses:
+;;
+;;     ange-ftp-lovers-request@anorman.hpl.hp.com
+;; or
+;;     ange-ftp-lovers-request%anorman.hpl.hp.com@hplb.hpl.hp.com
+;;
+;; Please don't forget the -request part.
+;;
+;; For mail to be posted directly to ange-ftp-lovers, send to one of the
+;; following addresses:
+;; 
+;;     ange-ftp-lovers@anorman.hpl.hp.com
+;; or
+;;     ange-ftp-lovers%anorman.hpl.hp.com@hplb.hpl.hp.com
+;;
+;; Alternatively, there is a mailing list that only gets announcements of new
+;; ange-ftp releases.  This is called ange-ftp-lovers-announce, and can be
+;; subscribed to by e-mailing to the -request address as above.  Please make
+;; it clear in the request which mailing list you wish to join.
+
+;; The archives for ange-ftp-lovers can be found via anonymous ftp under:
+;;
+;;     ftp.reed.edu:pub/mailing-lists/ange-ftp/
+
+;; -----------------------------------------------------------
+;; Technical information on this package:
+;; -----------------------------------------------------------
+
+;; ange-ftp works by putting a handler on file-name-handler-alist
+;; which is called by many primitives, and a few non-primitives,
+;; whenever they see a file name of the appropriate sort.
+
+;; Checklist for adding non-UNIX support for TYPE
+;; 
+;; The following functions may need TYPE versions:
+;; (not all functions will be needed for every OS)
+;;
+;; ange-ftp-fix-name-for-TYPE
+;; ange-ftp-fix-dir-name-for-TYPE
+;; ange-ftp-TYPE-host
+;; ange-ftp-TYPE-add-host
+;; ange-ftp-parse-TYPE-listing
+;; ange-ftp-TYPE-delete-file-entry
+;; ange-ftp-TYPE-add-file-entry
+;; ange-ftp-TYPE-file-name-as-directory
+;; ange-ftp-TYPE-make-compressed-filename
+;; ange-ftp-TYPE-file-name-sans-versions
+;;
+;; Variables:
+;;
+;; ange-ftp-TYPE-host-regexp
+;; May need to add TYPE to ange-ftp-dumb-host-types
+;;
+;; Check the following functions for OS dependent coding:
+;;
+;; ange-ftp-host-type
+;; ange-ftp-guess-host-type
+;; ange-ftp-allow-child-lookup
+
+;; Host type conventions:
+;;
+;; The function ange-ftp-host-type and the variable ange-ftp-dired-host-type
+;; (mostly) follow the following conventions for remote host types.  At
+;; least, I think that future code should try to follow these conventions,
+;; and the current code should eventually be made compliant.
+;;
+;; nil = local host type, whatever that is (probably unix).
+;;       Think nil as in "not a remote host". This value is used by
+;;       ange-ftp-dired-host-type for local buffers.
+;;
+;; t = a remote host of unknown type. Think t as in true, it's remote.
+;;     Currently, `unix' is used as the default remote host type.
+;;     Maybe we should use t.
+;;
+;; TYPE = a remote host of TYPE type.
+;;
+;; TYPE:LIST = a remote host of TYPE type, using a specialized ftp listing
+;;             program called list. This is currently only used for Unix
+;;             dl (descriptive listings), when ange-ftp-dired-host-type
+;;             is set to `unix:dl'.
+
+;; Bug report codes:
+;;
+;; Because of their naive faith in this code, there are certain situations
+;; which the writers of this program believe could never happen. However,
+;; being realists they have put calls to `error' in the program at these
+;; points. These errors provide a code, which is an integer, greater than 1.
+;; To aid debugging.  the error codes, and the functions in which they reside
+;; are listed below.
+;; 
+;; 1: See ange-ftp-ls
+;;
+
+;; -----------------------------------------------------------
+;; Hall of fame:
+;; -----------------------------------------------------------
+;; 
+;; Thanks to Roland McGrath for improving the filename syntax handling,
+;; for suggesting many enhancements and for numerous cleanups to the code.
+;;
+;; Thanks to Jamie Zawinski for bugfixes and for ideas such as gateways.
+;;
+;; Thanks to Ken Laprade for improved .netrc parsing, password reading, and
+;; dired / shell auto-loading.
+;;
+;; Thanks to Sebastian Kremer for dired support and for many ideas and
+;; bugfixes.
+;;
+;; Thanks to Joe Wells for bugfixes, the original non-UNIX system support,
+;; VOS support, and hostname completion.
+;;
+;; Thanks to Nakagawa Takayuki for many good ideas, filename-completion, help
+;; with file-name expansion, efficiency worries, stylistic concerns and many
+;; bugfixes.
+;;
+;; Thanks to Sandy Rutherford who re-wrote most of ange-ftp to support VMS,
+;; MTS, CMS and UNIX-dls.  Sandy also added dired-support for non-UNIX OS and
+;; auto-recognition of the host type.
+;;
+;; Thanks to Dave Smith who wrote the info file for ange-ftp.
+;;
+;; Finally, thanks to Keith Waclena, Mark D. Baushke, Terence Kelleher, Ping
+;; Zhou, Edward Vielmetti, Jack Repenning, Mike Balenger, Todd Kaufmann,
+;; Kjetil Svarstad, Tom Wurgler, Linus Tolke, Niko Makila, Carl Edman, Bill
+;; Trost, Dave Brennan, Dan Jacobson, Andy Scott, Steve Anderson, Sanjay
+;; Mathur, the folks on the ange-ftp-lovers mailing list and many others
+;; whose names I've forgotten who have helped to debug and fix problems with
+;; ange-ftp.el.
+
+;;; Code:
+
+(require 'comint)
+;; Silence compiler:
+(eval-when-compile
+  (require 'dired)
+  (defvar comint-last-output-start nil)
+  (defvar comint-last-input-start nil)
+  (defvar comint-last-input-end nil))
+
+;;;; ------------------------------------------------------------
+;;;; User customization variables.
+;;;; ------------------------------------------------------------
+
+(defgroup ange-ftp nil
+  "Accessing remote files and directories using FTP 
+   made as simple and transparent as possible."
+  :group 'files
+  :prefix "ange-ftp-")
+
+(defcustom ange-ftp-name-format
+  '("^/\\(\\([^@/:]*\\)@\\)?\\([^@/:]*[^@/:.]\\):\\(.*\\)" . (3 2 4))
+  "*Format of a fully expanded remote file name.
+
+This is a list of the form \(REGEXP HOST USER NAME\),
+where REGEXP is a regular expression matching
+the full remote name, and HOST, USER, and NAME are the numbers of
+parenthesized expressions in REGEXP for the components (in that order)."
+  :group 'ange-ftp
+  :type '(list regexp 
+	       (integer :tag "Host group")
+	       (integer :tag "User group")
+	       (integer :tag "Name group")))
+
+;; ange-ftp-multi-skip-msgs should only match ###-, where ### is one of
+;; the number codes corresponding to ange-ftp-good-msgs or ange-ftp-fatal-msgs.
+;; Otherwise, ange-ftp will go into multi-skip mode, and never come out.
+
+(defvar ange-ftp-multi-msgs
+  "^220-\\|^230-\\|^226\\|^25.-\\|^221-\\|^200-\\|^331-\\|^4[25]1-\\|^530-"
+  "*Regular expression matching the start of a multiline ftp reply.")
+
+(defvar ange-ftp-good-msgs
+  "^220 \\|^230 \\|^226 \\|^25. \\|^221 \\|^200 \\|^[Hh]ash mark"
+  "*Regular expression matching ftp \"success\" messages.")
+
+;; CMS and the odd VMS machine say 200 Port rather than 200 PORT.
+;; Also CMS machines use a multiline 550- reply to say that you
+;; don't have write permission. ange-ftp gets into multi-line skip
+;; mode and hangs. Have it ignore 550- instead. It will then barf
+;; when it gets the 550 line, as it should.
+
+(defcustom ange-ftp-skip-msgs
+  (concat "^200 \\(PORT\\|Port\\) \\|^331 \\|^150 \\|^350 \\|^[0-9]+ bytes \\|"
+	  "^Connected \\|^$\\|^Remote system\\|^Using\\|^ \\|Password:\\|"
+	  "^Data connection \\|"
+	  "^local:\\|^Trying\\|^125 \\|^550-\\|^221 .*oodbye\\|"
+	  "^227 .*[Pp]assive\\|^200 EPRT\\|^500 .*EPRT")
+  "*Regular expression matching ftp messages that can be ignored."
+  :group 'ange-ftp
+  :type 'regexp)
+
+(defcustom ange-ftp-fatal-msgs
+  (concat "^ftp: \\|^Not connected\\|^530 \\|^4[25]1 \\|rcmd: \\|"
+	  "^No control connection\\|unknown host\\|^lost connection")
+  "*Regular expression matching ftp messages that indicate serious errors.
+
+These mean that the FTP process should (or already has) been killed."
+  :group 'ange-ftp
+  :type 'regexp)
+
+(defcustom ange-ftp-gateway-fatal-msgs
+  "No route to host\\|Connection closed\\|No such host\\|Login incorrect"
+  "*Regular expression matching login failure messages from rlogin/telnet."
+  :group 'ange-ftp
+  :type 'regexp)
+
+(defcustom ange-ftp-xfer-size-msgs
+  "^150 .* connection for .* (\\([0-9]+\\) bytes)"
+  "*Regular expression used to determine the number of bytes in a FTP transfer."
+  :group 'ange-ftp
+  :type 'regexp)
+
+(defcustom ange-ftp-tmp-name-template 
+  (expand-file-name "ange-ftp" temporary-file-directory)
+  "*Template used to create temporary files."
+  :group 'ange-ftp
+  :type 'directory)
+
+(defcustom ange-ftp-gateway-tmp-name-template "/tmp/ange-ftp"
+  "*Template used to create temporary files when ftp-ing through a gateway.
+
+Files starting with this prefix need to be accessible from BOTH the local
+machine and the gateway machine, and need to have the SAME name on both
+machines, that is, /tmp is probably NOT what you want, since that is rarely
+cross-mounted."
+  :group 'ange-ftp
+  :type 'directory)
+
+(defcustom ange-ftp-netrc-filename "~/.netrc"
+  "*File in .netrc format to search for passwords."
+  :group 'ange-ftp
+  :type 'file)
+
+(defcustom ange-ftp-disable-netrc-security-check (eq system-type 'windows-nt)
+  "*If non-nil avoid checking permissions on the .netrc file."
+  :group 'ange-ftp
+  :type 'boolean)
+
+(defcustom ange-ftp-default-user nil
+  "*User name to use when none is specified in a file name.
+
+If non-nil but not a string, you are prompted for the name.
+If nil, the value of `ange-ftp-netrc-default-user' is used.
+If that is nil too, then your login name is used.
+
+Once a connection to a given host has been initiated, the user name
+and password information for that host are cached and re-used by
+ange-ftp.  Use \\[ange-ftp-set-user] to change the cached values,
+since setting `ange-ftp-default-user' directly does not affect
+the cached information."
+  :group 'ange-ftp
+  :type '(choice (const :tag "Default" nil)
+		 string
+		 (other :tag "Prompt" t)))
+
+(defcustom ange-ftp-netrc-default-user nil
+  "Alternate default user name to use when none is specified.
+
+This variable is set from the `default' command in your `.netrc' file,
+if there is one."
+  :group 'ange-ftp
+  :type '(choice (const :tag "Default" nil)
+		 string))
+
+(defcustom ange-ftp-default-password nil
+  "*Password to use when the user name equals `ange-ftp-default-user'."
+  :group 'ange-ftp
+  :type '(choice (const :tag "Default" nil)
+		 string))
+
+(defcustom ange-ftp-default-account nil
+  "*Account to use when the user name equals `ange-ftp-default-user'."
+  :group 'ange-ftp
+  :type '(choice (const :tag "Default" nil)
+		 string))
+
+(defcustom ange-ftp-netrc-default-password nil
+  "*Password to use when the user name equals `ange-ftp-netrc-default-user'."
+  :group 'ange-ftp
+  :type '(choice (const :tag "Default" nil)
+		 string))
+
+(defcustom ange-ftp-netrc-default-account nil
+  "*Account to use when the user name equals `ange-ftp-netrc-default-user'."
+  :group 'ange-ftp
+  :type '(choice (const :tag "Default" nil)
+		 string))
+
+(defcustom ange-ftp-generate-anonymous-password t
+  "*If t, use value of `user-mail-address' as password for anonymous ftp.
+
+If a string, then use that string as the password.
+If nil, prompt the user for a password."
+  :group 'ange-ftp
+  :type '(choice (const :tag "Prompt" nil)
+		 string
+		 (other :tag "User address" t)))
+
+(defcustom ange-ftp-dumb-unix-host-regexp nil
+  "*If non-nil, regexp matching hosts on which `dir' command lists directory."
+  :group 'ange-ftp
+  :type '(choice (const :tag "Default" nil)
+		 string))
+
+(defcustom ange-ftp-binary-file-name-regexp
+  (concat "\\.[zZ]$\\|\\.lzh$\\|\\.arc$\\|\\.zip$\\|\\.zoo$\\|\\.tar$\\|"
+	  "\\.dvi$\\|\\.ps$\\|\\.elc$\\|TAGS$\\|\\.gif$\\|"
+	  "\\.EXE\\(;[0-9]+\\)?$\\|\\.[zZ]-part-..$\\|\\.gz$\\|"
+	  "\\.taz$\\|\\.tgz$")
+  "*If a file matches this regexp then it is transferred in binary mode."
+  :group 'ange-ftp
+  :type 'regexp)
+
+(defcustom ange-ftp-gateway-host nil
+  "*Name of host to use as gateway machine when local FTP isn't possible."
+  :group 'ange-ftp
+  :type '(choice (const :tag "Default" nil)
+		 string))
+
+(defcustom ange-ftp-local-host-regexp ".*"
+  "*Regexp selecting hosts which can be reached directly with ftp.
+
+For other hosts the FTP process is started on \`ange-ftp-gateway-host\'
+instead, and/or reached via \`ange-ftp-gateway-ftp-program-name\'."
+  :group 'ange-ftp
+  :type 'regexp)
+
+(defcustom ange-ftp-gateway-program-interactive nil
+  "*If non-nil then the gateway program should  give a shell prompt.
+
+Both telnet and rlogin do something like this."
+  :group 'ange-ftp
+  :type 'boolean)
+
+(defcustom ange-ftp-gateway-program remote-shell-program
+  "*Name of program to spawn a shell on the gateway machine.
+
+Valid candidates are rsh (remsh on some systems), telnet and rlogin.  See
+also the gateway variable above."
+  :group 'ange-ftp
+  :type '(choice (const "rsh")
+		 (const "telnet")
+		 (const "rlogin")
+		 string))
+
+(defcustom ange-ftp-gateway-prompt-pattern "^[^#$%>;\n]*[#$%>;] *"
+  "*Regexp matching prompt after complete login sequence on gateway machine.
+
+A match for this means the shell is now awaiting input.  Make this regexp as
+strict as possible; it shouldn't match *anything* at all except the user's
+initial prompt.  The above string will fail under most SUN-3's since it
+matches the login banner."
+  :group 'ange-ftp
+  :type 'regexp)
+
+(defvar ange-ftp-gateway-setup-term-command
+  (if (eq system-type 'hpux)
+      "stty -onlcr -echo\n"
+    "stty -echo nl\n")
+  "*Set up terminal after logging in to the gateway machine.
+This command should stop the terminal from echoing each command, and
+arrange to strip out trailing ^M characters.")
+
+(defcustom ange-ftp-smart-gateway nil
+  "*Non-nil means the ftp gateway and/or the gateway ftp program is smart.
+
+Don't bother telnetting, etc., already connected to desired host transparently,
+or just issue a user@host command in case \`ange-ftp-gateway-host\' is non-nil."
+  :group 'ange-ftp
+  :type 'boolean)
+
+(defcustom ange-ftp-smart-gateway-port "21"
+  "*Port on gateway machine to use when smart gateway is in operation."
+  :group 'ange-ftp
+  :type 'string)
+
+(defcustom ange-ftp-send-hash t
+  "*If non-nil, send the HASH command to the FTP client."
+  :group 'ange-ftp
+  :type 'boolean)
+
+(defcustom ange-ftp-binary-hash-mark-size nil
+  "*Default size, in bytes, between hash-marks when transferring a binary file.
+If nil, this variable will be locally overridden if the FTP client outputs a
+suitable response to the HASH command.  If non-nil, this value takes
+precedence over the local value."
+  :group 'ange-ftp
+  :type '(choice (const :tag "Overridden" nil)
+		 integer))
+
+(defcustom ange-ftp-ascii-hash-mark-size 1024
+  "*Default size, in bytes, between hash-marks when transferring an ASCII file.
+This variable is buffer-local and will be locally overridden if the FTP client
+outputs a suitable response to the HASH command."
+  :group 'ange-ftp
+  :type 'integer)
+
+(defcustom ange-ftp-process-verbose t
+  "*If non-nil then be chatty about interaction with the FTP process."
+  :group 'ange-ftp
+  :type 'boolean)
+
+(defcustom ange-ftp-ftp-program-name "ftp"
+  "*Name of FTP program to run."
+  :group 'ange-ftp
+  :type 'string)
+
+(defcustom ange-ftp-gateway-ftp-program-name "ftp"
+  "*Name of FTP program to run when accessing non-local hosts.
+
+Some AT&T folks claim to use something called `pftp' here."
+  :group 'ange-ftp
+  :type 'string)
+
+(defcustom ange-ftp-ftp-program-args '("-i" "-n" "-g" "-v")
+  "*A list of arguments passed to the FTP program when started."
+  :group 'ange-ftp
+  :type '(repeat string))
+
+(defcustom ange-ftp-nslookup-program nil
+  "*If non-nil, this is a string naming the nslookup program." 
+  :group 'ange-ftp
+  :type '(choice (const :tag "None" nil)
+		 string))
+
+(defcustom ange-ftp-make-backup-files ()
+  "*Non-nil means make backup files for \"magic\" remote files."
+  :group 'ange-ftp
+  :type 'boolean)
+
+(defcustom ange-ftp-retry-time 5
+  "*Number of seconds to wait before retry if file or listing doesn't arrive.
+This might need to be increased for very slow connections."
+  :group 'ange-ftp
+  :type 'integer)
+
+(defcustom ange-ftp-auto-save 0
+  "If 1, allow ange-ftp files to be auto-saved.
+If 0, inhibit auto-saving of ange-ftp files.
+Don't use any other value."
+  :group 'ange-ftp
+  :type '(choice (const :tag "Suppress" 0)
+		 (const :tag "Allow" 1)))
+
+(defcustom ange-ftp-try-passive-mode nil
+  "It t, try to use passive mode in ftp, if the client program
+supports the `passive' command."
+  :group 'ange-ftp
+  :type 'boolean
+  :version 21.1)
+
+
+;;;; ------------------------------------------------------------
+;;;; Hash table support.
+;;;; ------------------------------------------------------------
+
+(require 'backquote)
+
+(defun ange-ftp-make-hashtable (&optional size)
+  "Make an obarray suitable for use as a hashtable.
+SIZE, if supplied, should be a prime number."
+  (make-vector (or size 31) 0))
+
+(defun ange-ftp-map-hashtable (fun tbl)
+  "Call FUNCTION on each key and value in HASHTABLE."
+  (mapatoms
+   (function 
+    (lambda (sym)
+      (funcall fun (get sym 'key) (get sym 'val))))
+   tbl))
+
+(defmacro ange-ftp-make-hash-key (key)
+  "Convert KEY into a suitable key for a hashtable."
+  (` (if (stringp (, key))
+	 (, key)
+       (prin1-to-string (, key)))))
+
+(defun ange-ftp-get-hash-entry (key tbl)
+  "Return the value associated with KEY in HASHTABLE."
+  (let ((sym (intern-soft (ange-ftp-make-hash-key key) tbl)))
+    (and sym (get sym 'val))))
+
+(defun ange-ftp-put-hash-entry (key val tbl)
+  "Record an association between KEY and VALUE in HASHTABLE."
+  (let ((sym (intern (ange-ftp-make-hash-key key) tbl)))
+    (put sym 'val val)
+    (put sym 'key key)))
+
+(defun ange-ftp-del-hash-entry (key tbl)
+  "Copy all symbols except KEY in HASHTABLE and return modified hashtable."
+  (let* ((len (length tbl))
+	 (new-tbl (ange-ftp-make-hashtable len))
+	 (i (1- len)))
+    (ange-ftp-map-hashtable
+     (function
+      (lambda (k v)
+	(or (equal k key)
+	    (ange-ftp-put-hash-entry k v new-tbl))))
+     tbl)
+    (while (>= i 0)
+      (aset tbl i (aref new-tbl i))
+      (setq i (1- i)))
+    tbl))
+
+(defun ange-ftp-hash-entry-exists-p (key tbl)
+  "Return whether there is an association for KEY in TABLE."
+  (intern-soft (ange-ftp-make-hash-key key) tbl))
+
+(defun ange-ftp-hash-table-keys (tbl)
+  "Return a sorted list of all the active keys in TABLE, as strings."
+  (sort (all-completions "" tbl)
+	(function string-lessp)))
+
+;;;; ------------------------------------------------------------
+;;;; Internal variables.
+;;;; ------------------------------------------------------------
+
+(defvar ange-ftp-data-buffer-name " *ftp data*"
+  "Buffer name to hold directory listing data received from ftp process.")
+
+(defvar ange-ftp-netrc-modtime nil
+  "Last modified time of the netrc file from file-attributes.")
+
+(defvar ange-ftp-user-hashtable (ange-ftp-make-hashtable)
+  "Hash table holding associations between HOST, USER pairs.")
+
+(defvar ange-ftp-passwd-hashtable (ange-ftp-make-hashtable)
+  "Mapping between a HOST, USER pair and a PASSWORD for them.
+All HOST values should be in lower case.")
+
+(defvar ange-ftp-account-hashtable (ange-ftp-make-hashtable)
+  "Mapping between a HOST, USER pair and a ACCOUNT password for them.")
+
+(defvar ange-ftp-files-hashtable (ange-ftp-make-hashtable 97)
+  "Hash table for storing directories and their respective files.")
+
+(defvar ange-ftp-inodes-hashtable (ange-ftp-make-hashtable 97)
+  "Hash table for storing file names and their \"inode numbers\".")
+
+(defvar ange-ftp-next-inode-number 1
+  "Next \"inode number\" value.  We give each file name a unique number.")
+
+(defvar ange-ftp-ls-cache-lsargs nil
+  "Last set of args used by ange-ftp-ls.")
+
+(defvar ange-ftp-ls-cache-file nil
+  "Last file passed to ange-ftp-ls.")
+
+(defvar ange-ftp-ls-cache-res nil
+  "Last result returned from ange-ftp-ls.")
+
+(defconst ange-ftp-expand-dir-hashtable (ange-ftp-make-hashtable))
+
+(defconst ange-ftp-expand-dir-regexp "^5.0 \\([^: ]+\\):")
+
+;; These are local variables in each FTP process buffer.
+(defvar ange-ftp-hash-mark-unit nil)
+(defvar ange-ftp-hash-mark-count nil)
+(defvar ange-ftp-xfer-size nil)
+(defvar ange-ftp-process-string nil)
+(defvar ange-ftp-process-result-line nil)
+(defvar ange-ftp-process-busy nil)
+(defvar ange-ftp-process-result nil)
+(defvar ange-ftp-process-multi-skip nil)
+(defvar ange-ftp-process-msg nil)
+(defvar ange-ftp-process-continue nil)
+(defvar ange-ftp-last-percent nil)
+
+;; These variables are bound by one function and examined by another.
+;; Leave them void globally for error checking.
+(defvar ange-ftp-this-file)
+(defvar ange-ftp-this-dir)
+(defvar ange-ftp-this-user)
+(defvar ange-ftp-this-host)
+(defvar ange-ftp-this-msg)
+(defvar ange-ftp-completion-ignored-pattern)
+(defvar ange-ftp-trample-marker)
+
+;; New error symbols.
+(put 'ftp-error 'error-conditions '(ftp-error file-error error))
+;; (put 'ftp-error 'error-message "FTP error")
+
+;;; ------------------------------------------------------------
+;;; Enhanced message support.
+;;; ------------------------------------------------------------
+
+(defun ange-ftp-message (fmt &rest args)
+  "Display message in echo area, but indicate if truncated.
+Args are as in `message': a format string, plus arguments to be formatted."
+  (let ((msg (apply (function format) fmt args))
+	(max (window-width (minibuffer-window))))
+    (if noninteractive
+	msg
+      (if (>= (length msg) max)
+	  ;; Take just the last MAX - 3 chars of the string.
+	  (setq msg (concat "> " (substring msg (- 3 max)))))
+      (message "%s" msg))))
+
+(defun ange-ftp-abbreviate-filename (file &optional new)
+  "Abbreviate the file name FILE relative to the default-directory.
+If the optional parameter NEW is given and the non-directory parts match,
+only return the directory part of FILE."
+  (save-match-data
+    (if (and default-directory
+	     (string-match (concat "^"
+				   (regexp-quote default-directory)
+				   ".") file))
+	(setq file (substring file (1- (match-end 0)))))
+    (if (and new
+	     (string-equal (file-name-nondirectory file)
+			   (file-name-nondirectory new)))
+	(setq file (file-name-directory file)))
+    (or file "./")))
+
+;;;; ------------------------------------------------------------
+;;;; User / Host mapping support.
+;;;; ------------------------------------------------------------
+
+(defun ange-ftp-set-user (host user)
+  "For a given HOST, set or change the default USER."
+  (interactive "sHost: \nsUser: ")
+  (ange-ftp-put-hash-entry host user ange-ftp-user-hashtable))
+
+(defun ange-ftp-get-user (host)
+  "Given a HOST, return the default USER."
+  (ange-ftp-parse-netrc)
+  (let ((user (ange-ftp-get-hash-entry host ange-ftp-user-hashtable)))
+    (or user
+	(prog1
+	    (setq user
+		  (cond ((stringp ange-ftp-default-user)
+			 ;; We have a default name.  Use it.
+			 ange-ftp-default-user)
+			(ange-ftp-default-user
+			 ;; Ask the user.
+			 (let ((enable-recursive-minibuffers t))
+			   (read-string (format "User for %s: " host)
+					(user-login-name))))
+			(ange-ftp-netrc-default-user)
+			;; Default to the user's login name.
+			(t
+			 (user-login-name))))
+	  (ange-ftp-set-user host user)))))
+
+;;;; ------------------------------------------------------------
+;;;; Password support.
+;;;; ------------------------------------------------------------
+
+(defmacro ange-ftp-generate-passwd-key (host user)
+  (` (concat (downcase (, host)) "/" (, user))))
+
+(defmacro ange-ftp-lookup-passwd (host user)
+  (` (ange-ftp-get-hash-entry (ange-ftp-generate-passwd-key (, host) (, user))
+			      ange-ftp-passwd-hashtable)))
+
+(defun ange-ftp-set-passwd (host user passwd)
+  "For a given HOST and USER, set or change the associated PASSWORD."
+  (interactive (list (read-string "Host: ")
+		     (read-string "User: ")
+		     (read-passwd "Password: ")))
+  (ange-ftp-put-hash-entry (ange-ftp-generate-passwd-key host user)
+			   passwd
+			   ange-ftp-passwd-hashtable))
+
+(defun ange-ftp-get-host-with-passwd (user)
+  "Given a USER, return a host we know the password for."
+  (ange-ftp-parse-netrc)
+  (catch 'found-one
+    (ange-ftp-map-hashtable
+     (function (lambda (host val)
+		 (if (ange-ftp-lookup-passwd host user)
+		     (throw 'found-one host))))
+     ange-ftp-user-hashtable)
+    (save-match-data
+      (ange-ftp-map-hashtable
+       (function
+	(lambda (key value)
+	  (if (string-match "^[^/]*\\(/\\).*$" key)
+	      (let ((host (substring key 0 (match-beginning 1))))
+		(if (and (string-equal user (substring key (match-end 1)))
+			 value)
+		    (throw 'found-one host))))))
+       ange-ftp-passwd-hashtable))
+    nil))
+
+(defun ange-ftp-get-passwd (host user)
+  "Return the password for specified HOST and USER, asking user if necessary."
+  (ange-ftp-parse-netrc)
+
+  ;; look up password in the hash table first; user might have overridden the
+  ;; defaults.
+  (cond ((ange-ftp-lookup-passwd host user))
+	
+	;; See if default user and password set.
+	((and (stringp ange-ftp-default-user)
+	      ange-ftp-default-password
+	      (string-equal user ange-ftp-default-user))
+	 ange-ftp-default-password)
+	
+	;; See if default user and password set from .netrc file.
+	((and (stringp ange-ftp-netrc-default-user)
+	      ange-ftp-netrc-default-password
+	      (string-equal user ange-ftp-netrc-default-user))
+	 ange-ftp-netrc-default-password)
+	
+	;; anonymous ftp password is handled specially since there is an
+	;; unwritten rule about how that is used on the Internet.
+	((and (or (string-equal user "anonymous")
+		  (string-equal user "ftp"))
+	      ange-ftp-generate-anonymous-password)
+	 (if (stringp ange-ftp-generate-anonymous-password)
+	     ange-ftp-generate-anonymous-password
+	   user-mail-address))
+	
+	;; see if same user has logged in to other hosts; if so then prompt
+	;; with the password that was used there.
+	(t
+	 (let* ((other (ange-ftp-get-host-with-passwd user))
+		(passwd (if other
+			    
+			    ;; found another machine with the same user.
+			    ;; Try that account.
+			    (read-passwd
+			     (format "passwd for %s@%s (default same as %s@%s): "
+				     user host user other)
+			     nil
+			     (ange-ftp-lookup-passwd other user))
+			  
+			  ;; I give up.  Ask the user for the password.
+			  (read-passwd
+			   (format "Password for %s@%s: " user host)))))
+	   (ange-ftp-set-passwd host user passwd)
+	   passwd))))
+
+;;;; ------------------------------------------------------------
+;;;; Account support
+;;;; ------------------------------------------------------------
+
+;; Account passwords must be either specified in the .netrc file, or set
+;; manually by calling ange-ftp-set-account.  For the moment, ange-ftp doesn't
+;; check to see whether the FTP process is actually prompting for an account
+;; password.
+ 
+(defun ange-ftp-set-account (host user account)
+  "For a given HOST and USER, set or change the associated ACCOUNT password."
+  (interactive (list (read-string "Host: ")
+		     (read-string "User: ")
+		     (read-passwd "Account password: ")))
+  (ange-ftp-put-hash-entry (ange-ftp-generate-passwd-key host user)
+			   account
+			   ange-ftp-account-hashtable))
+
+(defun ange-ftp-get-account (host user)
+  "Given a HOST and USER, return the FTP account."
+  (ange-ftp-parse-netrc)
+  (or (ange-ftp-get-hash-entry (ange-ftp-generate-passwd-key host user)
+			       ange-ftp-account-hashtable)
+      (and (stringp ange-ftp-default-user)
+	   (string-equal user ange-ftp-default-user)
+	   ange-ftp-default-account)
+      (and (stringp ange-ftp-netrc-default-user)
+	   (string-equal user ange-ftp-netrc-default-user)
+	   ange-ftp-netrc-default-account)))
+
+;;;; ------------------------------------------------------------
+;;;; ~/.netrc support
+;;;; ------------------------------------------------------------
+
+(defun ange-ftp-chase-symlinks (file)
+  "Return the filename that FILE references, following all symbolic links."
+  (let (temp)
+    (while (setq temp (ange-ftp-real-file-symlink-p file))
+      (setq file
+	    (if (file-name-absolute-p temp)
+		temp
+	      (concat (file-name-directory file) temp)))))
+  file)
+
+;; Move along current line looking for the value of the TOKEN.
+;; Valid separators between TOKEN and its value are commas and
+;; whitespace.  Second arg LIMIT is a limit for the search.
+
+(defun ange-ftp-parse-netrc-token (token limit)
+  (if (search-forward token limit t)
+      (let (beg)
+	(skip-chars-forward ", \t\r\n" limit)
+	(if (eq (following-char) ?\")	;quoted token value
+	    (progn (forward-char 1)
+		   (setq beg (point))
+		   (skip-chars-forward "^\"" limit)
+		   (forward-char 1)
+		   (buffer-substring beg (1- (point))))
+	  (setq beg (point))
+	  (skip-chars-forward "^, \t\r\n" limit)
+	  (buffer-substring beg (point))))))
+
+;; Extract the values for the tokens `machine', `login',
+;; `password' and `account' in the current buffer.  If successful,
+;; record the information found.
+
+(defun ange-ftp-parse-netrc-group ()
+  (let ((start (point))
+	(end (save-excursion
+	       (if (looking-at "machine\\>")
+		   ;; Skip `machine' and the machine name that follows.
+		   (progn
+		     (skip-chars-forward "^ \t\r\n")
+		     (skip-chars-forward " \t\r\n")
+		     (skip-chars-forward "^ \t\r\n"))
+		 ;; Skip `default'.
+		 (skip-chars-forward "^ \t\r\n"))
+	       ;; Find start of the next `machine' or `default'
+	       ;; or the end of the buffer.
+	       (if (re-search-forward "machine\\>\\|default\\>" nil t)
+		   (match-beginning 0)
+		 (point-max))))
+	machine login password account)
+    (setq machine  (ange-ftp-parse-netrc-token "machine"  end)
+	  login    (ange-ftp-parse-netrc-token "login"    end)
+	  password (ange-ftp-parse-netrc-token "password" end)
+	  account  (ange-ftp-parse-netrc-token "account"  end))
+    (if (and machine login)
+	;; found a `machine` token.
+	(progn
+	  (ange-ftp-set-user machine login)
+	  (ange-ftp-set-passwd machine login password)
+	  (and account
+	       (ange-ftp-set-account machine login account)))
+      (goto-char start)
+      (if (search-forward "default" end t)
+	  ;; found a `default' token
+	  (progn
+	    (setq login    (ange-ftp-parse-netrc-token "login"    end)
+		  password (ange-ftp-parse-netrc-token "password" end)
+		  account  (ange-ftp-parse-netrc-token "account"  end))
+	    (and login
+		 (setq ange-ftp-netrc-default-user login))
+	    (and password
+		 (setq ange-ftp-netrc-default-password password))
+	    (and account
+		 (setq ange-ftp-netrc-default-account account)))))
+    (goto-char end)))
+
+;; Read in ~/.netrc, if one exists.  If ~/.netrc file exists and has
+;; the correct permissions then extract the \`machine\', \`login\',
+;; \`password\' and \`account\' information from within.
+
+(defun ange-ftp-parse-netrc ()
+  ;; We set this before actually doing it to avoid the possibility
+  ;; of an infinite loop if ange-ftp-netrc-filename is an FTP file.
+  (interactive)
+  (let (file attr)
+    (let ((default-directory "/"))
+      (setq file (ange-ftp-chase-symlinks
+		  (ange-ftp-real-expand-file-name ange-ftp-netrc-filename)))
+      (setq attr (ange-ftp-real-file-attributes file)))
+    (if (and attr			; file exists.
+	     (not (equal (nth 5 attr) ange-ftp-netrc-modtime)))	; file changed
+	(save-match-data
+	  (if (or ange-ftp-disable-netrc-security-check
+		  (and (eq (nth 2 attr) (user-uid)) ; Same uids.
+		       (string-match ".r..------" (nth 8 attr))))
+	      (save-excursion
+		;; we are cheating a bit here.  I'm trying to do the equivalent
+		;; of find-file on the .netrc file, but then nuke it afterwards.
+		;; with the bit of logic below we should be able to have
+		;; encrypted .netrc files.
+		(set-buffer (generate-new-buffer "*ftp-.netrc*"))
+		(ange-ftp-real-insert-file-contents file)
+		(setq buffer-file-name file)
+		(setq default-directory (file-name-directory file))
+		(normal-mode t)
+		(mapcar 'funcall find-file-hooks)
+		(setq buffer-file-name nil)
+		(goto-char (point-min))
+		(skip-chars-forward " \t\r\n")
+		(while (not (eobp))
+		  (ange-ftp-parse-netrc-group))
+		(kill-buffer (current-buffer)))
+	    (ange-ftp-message "%s either not owned by you or badly protected."
+			      ange-ftp-netrc-filename)
+	    (sit-for 1))
+	  (setq ange-ftp-netrc-modtime (nth 5 attr))))))
+
+;; Return a list of prefixes of the form 'user@host:' to be used when
+;; completion is done in the root directory.
+
+(defun ange-ftp-generate-root-prefixes ()
+  (ange-ftp-parse-netrc)
+  (save-match-data
+    (let (res)
+      (ange-ftp-map-hashtable
+       (function
+	(lambda (key value)
+	  (if (string-match "^[^/]*\\(/\\).*$" key)
+	      (let ((host (substring key 0 (match-beginning 1)))
+		    (user (substring key (match-end 1))))
+		(setq res (cons (list (concat user "@" host ":"))
+				res))))))
+       ange-ftp-passwd-hashtable)
+      (ange-ftp-map-hashtable
+       (function (lambda (host user)
+		   (setq res (cons (list (concat host ":"))
+				   res))))
+       ange-ftp-user-hashtable)
+      (or res (list nil)))))
+
+;;;; ------------------------------------------------------------
+;;;; Remote file name syntax support.
+;;;; ------------------------------------------------------------
+
+(defmacro ange-ftp-ftp-name-component (n ns name)
+  "Extract the Nth ftp file name component from NS."
+  (` (let ((elt (nth (, n) (, ns))))
+       (if (match-beginning elt)
+	   (substring (, name) (match-beginning elt) (match-end elt))))))
+
+(defvar ange-ftp-ftp-name-arg "")
+(defvar ange-ftp-ftp-name-res nil)
+
+;; Parse NAME according to `ange-ftp-name-format' (which see).
+;; Returns a list (HOST USER NAME), or nil if NAME does not match the format.
+(defun ange-ftp-ftp-name (name)
+  (if (string-equal name ange-ftp-ftp-name-arg)
+      ange-ftp-ftp-name-res
+    (setq ange-ftp-ftp-name-arg name
+	  ange-ftp-ftp-name-res
+	  (save-match-data
+	    (if (posix-string-match (car ange-ftp-name-format) name)
+		(let* ((ns (cdr ange-ftp-name-format))
+		       (host (ange-ftp-ftp-name-component 0 ns name))
+		       (user (ange-ftp-ftp-name-component 1 ns name))
+		       (name (ange-ftp-ftp-name-component 2 ns name)))
+		  (if (zerop (length user))
+		      (setq user (ange-ftp-get-user host)))
+		  (list host user name))
+	      nil)))))
+
+;; Take a FULLNAME that matches according to ange-ftp-name-format and
+;; replace the name component with NAME.
+(defun ange-ftp-replace-name-component (fullname name)
+  (save-match-data
+    (if (posix-string-match (car ange-ftp-name-format) fullname)
+	(let* ((ns (cdr ange-ftp-name-format))
+	       (elt (nth 2 ns)))
+	  (concat (substring fullname 0 (match-beginning elt))
+		  name
+		  (substring fullname (match-end elt)))))))
+
+;;;; ------------------------------------------------------------
+;;;; Miscellaneous utils.
+;;;; ------------------------------------------------------------
+
+;; (setq ange-ftp-tmp-keymap (make-sparse-keymap))
+;; (define-key ange-ftp-tmp-keymap "\C-m" 'exit-minibuffer)
+
+(defun ange-ftp-repaint-minibuffer ()
+  "Clear any existing minibuffer message; let the minibuffer contents show."
+  (message nil))
+
+;; Return the name of the buffer that collects output from the ftp process
+;; connected to the given HOST and USER pair.
+(defun ange-ftp-ftp-process-buffer (host user)
+  (concat "*ftp " user "@" host "*"))
+
+;; Display the last chunk of output from the ftp process for the given HOST
+;; USER pair, and signal an error including MSG in the text.
+(defun ange-ftp-error (host user msg)
+  (let ((cur (selected-window))
+	(pop-up-windows t))
+    (pop-to-buffer
+     (get-buffer-create
+      (ange-ftp-ftp-process-buffer host user)))
+    (goto-char (point-max))
+    (select-window cur))
+  (signal 'ftp-error (list (format "FTP Error: %s" msg))))
+
+(defun ange-ftp-set-buffer-mode ()
+  "Set correct modes for the current buffer if visiting a remote file."
+  (if (and (stringp buffer-file-name)
+	   (ange-ftp-ftp-name buffer-file-name))
+      (auto-save-mode ange-ftp-auto-save)))
+
+(defun ange-ftp-kill-ftp-process (&optional buffer)
+  "Kill the FTP process associated with BUFFER (the current buffer, if nil).
+If the BUFFER's visited filename or default-directory is an ftp filename
+then kill the related ftp process."
+  (interactive "bKill FTP process associated with buffer: ")
+  (if (null buffer)
+      (setq buffer (current-buffer))
+    (setq buffer (get-buffer buffer)))
+  (let ((file (or (buffer-file-name buffer)
+		  (save-excursion (set-buffer buffer) default-directory))))
+    (if file
+	(let ((parsed (ange-ftp-ftp-name (expand-file-name file))))
+	  (if parsed
+	      (let ((host (nth 0 parsed))
+		    (user (nth 1 parsed)))
+		(kill-buffer (get-buffer (ange-ftp-ftp-process-buffer host user)))))))))
+
+(defun ange-ftp-quote-string (string)
+  "Quote any characters in STRING that may confuse the ftp process."
+  (apply (function concat)
+	 (mapcar (function
+		  ;; This is said to be wrong; ftp is said to
+		  ;; need quoting only for ", and that by doubling it.
+		  ;; But experiment says this kind of quoting is correct
+		  ;; when talking to ftp on GNU/Linux systems.
+		   (lambda (char)
+		     (if (or (<= char ? )
+			     (> char ?\~)
+		             (= char ?\")
+			     (= char ?\\))
+			 (vector ?\\ char)
+		       (vector char))))
+		 string)))
+
+(defun ange-ftp-barf-if-not-directory (directory)
+  (or (file-directory-p directory)
+      (signal 'file-error
+	      (list "Opening directory"
+		    (if (file-exists-p directory)
+			"not a directory"
+		      "no such file or directory")
+		    directory))))
+
+;;;; ------------------------------------------------------------
+;;;; FTP process filter support.
+;;;; ------------------------------------------------------------
+
+(defun ange-ftp-process-handle-line (line proc)
+  "Look at the given LINE from the ftp process PROC.
+Try to categorize it into one of four categories:
+good, skip, fatal, or unknown."
+  (cond ((string-match ange-ftp-xfer-size-msgs line)
+	 (setq ange-ftp-xfer-size
+	       (ash (string-to-int (substring line
+					      (match-beginning 1)
+					      (match-end 1)))
+		    -10)))
+	((string-match ange-ftp-skip-msgs line)
+	 t)
+	((string-match ange-ftp-good-msgs line)
+	 (setq ange-ftp-process-busy nil
+	       ange-ftp-process-result t
+	       ange-ftp-process-result-line line))
+	;; Check this before checking for errors.
+	;; Otherwise the last line of these three seems to be an error:
+	;; 230-see a significant impact from the move.  For those of you who can't
+	;; 230-use DNS to resolve hostnames and get an error message like
+	;; 230-"ftp.stsci.edu: unknown host", the new IP address will be...
+	((string-match ange-ftp-multi-msgs line)
+	 (setq ange-ftp-process-multi-skip t))
+	((string-match ange-ftp-fatal-msgs line)
+	 (delete-process proc)
+	 (setq ange-ftp-process-busy nil
+	       ange-ftp-process-result-line line))
+	(ange-ftp-process-multi-skip
+	 t)
+	(t
+	 (setq ange-ftp-process-busy nil
+	       ange-ftp-process-result-line line))))
+
+(defun ange-ftp-set-xfer-size (host user bytes)
+  "Set the size of the next FTP transfer in bytes."
+  (let ((proc (ange-ftp-get-process host user)))
+    (if proc
+	(let ((buf (process-buffer proc)))
+	  (if buf
+	      (save-excursion
+		(set-buffer buf)
+		(setq ange-ftp-xfer-size (ash bytes -10))))))))
+
+(defun ange-ftp-process-handle-hash (str)
+  "Remove hash marks from STRING and display count so far."
+  (setq str (concat (substring str 0 (match-beginning 0))
+		    (substring str (match-end 0)))
+	ange-ftp-hash-mark-count (+ (- (match-end 0)
+				       (match-beginning 0))
+				    ange-ftp-hash-mark-count))
+  (and ange-ftp-hash-mark-unit
+       ange-ftp-process-msg
+       ange-ftp-process-verbose
+       (not (eq (selected-window) (minibuffer-window)))
+       (not (boundp 'search-message))	;screws up isearch otherwise
+       (not cursor-in-echo-area)	;screws up y-or-n-p otherwise
+       (let ((kbytes (ash (* ange-ftp-hash-mark-unit
+			     ange-ftp-hash-mark-count)
+			  -6)))
+       (if (zerop ange-ftp-xfer-size)
+	   (ange-ftp-message "%s...%dk" ange-ftp-process-msg kbytes)
+	 (let ((percent (/ (* 100 kbytes) ange-ftp-xfer-size)))
+	   ;; cut out the redisplay of identical %-age messages.
+	   (if (not (eq percent ange-ftp-last-percent))
+	       (progn
+		 (setq ange-ftp-last-percent percent)
+		 (ange-ftp-message "%s...%d%%" ange-ftp-process-msg percent)))))))
+  str)
+
+;; Call the function specified by CONT.  CONT can be either a function
+;; or a list of a function and some args.  The first two parameters
+;; passed to the function will be RESULT and LINE.  The remaining args
+;; will be taken from CONT if a list was passed.
+
+(defun ange-ftp-call-cont (cont result line)
+  (if cont
+      (if (and (listp cont)
+	       (not (eq (car cont) 'lambda)))
+	  (apply (car cont) result line (cdr cont))
+	(funcall cont result line))))
+
+;; Build up a complete line of output from the ftp PROCESS and pass it
+;; on to ange-ftp-process-handle-line to deal with.
+
+(defun ange-ftp-process-filter (proc str)
+  (let ((buffer (process-buffer proc))
+	(old-buffer (current-buffer)))
+
+    ;; Eliminate nulls.
+    (while (string-match "\000+" str)
+      (setq str (replace-match "" nil nil str))) 
+
+    ;; see if the buffer is still around... it could have been deleted.
+    (if (buffer-name buffer)
+	(unwind-protect
+	    (progn
+	      (set-buffer (process-buffer proc))
+	      
+	      ;; handle hash mark printing
+	      (and ange-ftp-process-busy
+		   (string-match "^#+$" str)
+		   (setq str (ange-ftp-process-handle-hash str)))
+	      (comint-output-filter proc str)
+	      ;; Replace STR by the result of the comint processing.
+	      (setq str (buffer-substring comint-last-output-start
+					  (process-mark proc)))
+	      (if ange-ftp-process-busy
+		  (progn
+		    (setq ange-ftp-process-string (concat ange-ftp-process-string
+							  str))
+		    
+		    ;; if we gave an empty password to the USER command earlier
+		    ;; then we should send a null password now.
+		    (if (string-match "Password: *$" ange-ftp-process-string)
+			(send-string proc "\n"))))
+	      (while (and ange-ftp-process-busy
+			  (string-match "\n" ange-ftp-process-string))
+		(let ((line (substring ange-ftp-process-string
+				       0
+				       (match-beginning 0))))
+		  (setq ange-ftp-process-string (substring ange-ftp-process-string
+							   (match-end 0)))
+		  (while (string-match "^ftp> *" line)
+		    (setq line (substring line (match-end 0))))
+		  (ange-ftp-process-handle-line line proc)))
+
+	      ;; has the ftp client finished?  if so then do some clean-up
+	      ;; actions.
+	      (if (not ange-ftp-process-busy)
+		  (progn
+		    ;; reset the xfer size
+		    (setq ange-ftp-xfer-size 0)
+
+		    ;; issue the "done" message since we've finished.
+		    (if (and ange-ftp-process-msg
+			     ange-ftp-process-verbose
+			     ange-ftp-process-result)
+			(progn
+			  (ange-ftp-message "%s...done" ange-ftp-process-msg)
+			  (ange-ftp-repaint-minibuffer)
+			  (setq ange-ftp-process-msg nil)))
+		    
+		    ;; is there a continuation we should be calling?  if so,
+		    ;; we'd better call it, making sure we only call it once.
+		    (if ange-ftp-process-continue
+			(let ((cont ange-ftp-process-continue))
+			  (setq ange-ftp-process-continue nil)
+			  (ange-ftp-call-cont cont
+					      ange-ftp-process-result
+					      ange-ftp-process-result-line))))))
+	  (set-buffer old-buffer)))))
+
+(defun ange-ftp-process-sentinel (proc str)
+  "When ftp process changes state, nuke all file-entries in cache."
+  (let ((name (process-name proc)))
+    (if (string-match "\\*ftp \\([^@]+\\)@\\([^*]+\\)\\*" name)
+	(let ((user (substring name (match-beginning 1) (match-end 1)))
+	      (host (substring name (match-beginning 2) (match-end 2))))
+	  (ange-ftp-wipe-file-entries host user))))
+  (setq ange-ftp-ls-cache-file nil))
+
+;;;; ------------------------------------------------------------
+;;;; Gateway support.
+;;;; ------------------------------------------------------------
+
+(defun ange-ftp-use-gateway-p (host)
+  "Returns whether to access this host via a normal (non-smart) gateway."
+  ;; yes, I know that I could simplify the following expression, but it is
+  ;; clearer (to me at least) this way.
+  (and (not ange-ftp-smart-gateway)
+       (save-match-data
+	 (not (string-match ange-ftp-local-host-regexp host)))))
+
+(defun ange-ftp-use-smart-gateway-p (host)
+  "Returns whether to access this host via a smart gateway."
+  (and ange-ftp-smart-gateway
+       (save-match-data
+	 (not (string-match ange-ftp-local-host-regexp host)))))
+
+
+;;; ------------------------------------------------------------
+;;; Temporary file location and deletion...
+;;; ------------------------------------------------------------
+
+(defun ange-ftp-make-tmp-name (host)
+  "This routine will return the name of a new file."
+  (make-temp-file (if (ange-ftp-use-gateway-p host)
+		       ange-ftp-gateway-tmp-name-template
+		     ange-ftp-tmp-name-template)))
+
+(defalias 'ange-ftp-del-tmp-name 'delete-file)
+
+;;;; ------------------------------------------------------------
+;;;; Interactive gateway program support.
+;;;; ------------------------------------------------------------
+
+(defvar ange-ftp-gwp-running t)
+(defvar ange-ftp-gwp-status nil)
+
+(defun ange-ftp-gwp-sentinel (proc str)
+  (setq ange-ftp-gwp-running nil))
+
+(defun ange-ftp-gwp-filter (proc str)
+  (comint-output-filter proc str)
+  (save-excursion
+    (set-buffer (process-buffer proc))
+    ;; Replace STR by the result of the comint processing.
+    (setq str (buffer-substring comint-last-output-start (process-mark proc))))
+  (cond ((string-match "login: *$" str)
+	 (send-string proc
+		      (concat
+		       (let ((ange-ftp-default-user t))
+			 (ange-ftp-get-user ange-ftp-gateway-host))
+		       "\n")))
+	((string-match "Password: *$" str)
+	 (send-string proc
+		      (concat
+		       (ange-ftp-get-passwd ange-ftp-gateway-host
+					    (ange-ftp-get-user
+					     ange-ftp-gateway-host))
+		       "\n")))
+	((string-match ange-ftp-gateway-fatal-msgs str)
+	 (delete-process proc)
+	 (setq ange-ftp-gwp-running nil))
+	((string-match ange-ftp-gateway-prompt-pattern str)
+	 (setq ange-ftp-gwp-running nil
+	       ange-ftp-gwp-status t))))
+
+(defun ange-ftp-gwp-start (host user name args)
+  "Login to the gateway machine and fire up an ftp process."
+  (let* ((gw-user (ange-ftp-get-user ange-ftp-gateway-host))
+	 ;; It would be nice to make process-connection-type nil,
+	 ;; but that doesn't work: ftp never responds.
+	 ;; Can anyone find a fix for that?
+	 (proc (let ((process-connection-type t))
+		 (start-process name name
+				ange-ftp-gateway-program
+				ange-ftp-gateway-host)))
+	 (ftp (mapconcat (function identity) args " ")))
+    (process-kill-without-query proc)
+    (set-process-sentinel proc (function ange-ftp-gwp-sentinel))
+    (set-process-filter proc (function ange-ftp-gwp-filter))
+    (save-excursion
+      (set-buffer (process-buffer proc))
+      (goto-char (point-max))
+      (set-marker (process-mark proc) (point)))
+    (setq ange-ftp-gwp-running t
+	  ange-ftp-gwp-status nil)
+    (ange-ftp-message "Connecting to gateway %s..." ange-ftp-gateway-host)
+    (while ange-ftp-gwp-running		;perform login sequence
+      (accept-process-output proc))
+    (if (not ange-ftp-gwp-status)
+	(ange-ftp-error host user "unable to login to gateway"))
+    (ange-ftp-message "Connecting to gateway %s...done" ange-ftp-gateway-host)
+    (setq ange-ftp-gwp-running t
+	  ange-ftp-gwp-status nil)
+    (process-send-string proc ange-ftp-gateway-setup-term-command)
+    (while ange-ftp-gwp-running		;zap ^M's and double echoing.
+      (accept-process-output proc))
+    (if (not ange-ftp-gwp-status)
+	(ange-ftp-error host user "unable to set terminal modes on gateway"))
+    (setq ange-ftp-gwp-running t
+	  ange-ftp-gwp-status nil)
+    (process-send-string proc (concat "exec " ftp "\n")) ;spawn ftp process
+    proc))
+
+;;;; ------------------------------------------------------------
+;;;; Support for sending commands to the ftp process.
+;;;; ------------------------------------------------------------
+
+(defun ange-ftp-raw-send-cmd (proc cmd &optional msg cont nowait)
+  "Low-level routine to send the given ftp CMD to the ftp PROCESS.
+MSG is an optional message to output before and after the command.
+If CONT is non-nil then it is either a function or a list of function and
+some arguments.  The function will be called when the ftp command has completed.
+If CONT is nil then this routine will return \( RESULT . LINE \) where RESULT
+is whether the command was successful, and LINE is the line from the FTP
+process that caused the command to complete.
+If NOWAIT is given then the routine will return immediately the command has
+been queued with no result.  CONT will still be called, however."
+  (if (memq (process-status proc) '(run open))
+      (save-excursion
+	(set-buffer (process-buffer proc))
+	(ange-ftp-wait-not-busy proc)
+	(setq ange-ftp-process-string ""
+	      ange-ftp-process-result-line ""
+	      ange-ftp-process-busy t
+	      ange-ftp-process-result nil
+	      ange-ftp-process-multi-skip nil
+	      ange-ftp-process-msg msg
+	      ange-ftp-process-continue cont
+	      ange-ftp-hash-mark-count 0
+	      ange-ftp-last-percent -1
+	      cmd (concat cmd "\n"))
+	(and msg ange-ftp-process-verbose (ange-ftp-message "%s..." msg))
+	(goto-char (point-max))
+	(move-marker comint-last-input-start (point))
+	;; don't insert the password into the buffer on the USER command.
+	(save-match-data
+	  (if (string-match "^user \"[^\"]*\"" cmd)
+	      (insert (substring cmd 0 (match-end 0)) " Turtle Power!\n")
+	    (insert cmd)))
+	(move-marker comint-last-input-end (point))
+	(send-string proc cmd)
+	(set-marker (process-mark proc) (point))
+	(if nowait
+	    nil
+	  (ange-ftp-wait-not-busy proc)
+	  (if cont
+	      nil			;cont has already been called
+	    (cons ange-ftp-process-result ange-ftp-process-result-line))))))
+
+;; Wait for the ange-ftp process PROC not to be busy.
+(defun ange-ftp-wait-not-busy (proc)
+  (save-excursion
+    (set-buffer (process-buffer proc))
+    (condition-case nil
+	;; This is a kludge to let user quit in case ftp gets hung.
+	;; It matters because this function can be called from the filter.
+	;; It is bad to allow quitting in a filter, but getting hung
+	;; is worse.  By binding quit-flag to nil, we might avoid
+	;; most of the probability of getting screwed because the user
+	;; wants to quit some command.
+	(let ((quit-flag nil)
+	      (inhibit-quit nil))
+	  (while ange-ftp-process-busy
+	    (accept-process-output proc)))
+      (quit
+       ;; If the user does quit out of this,
+       ;; kill the process.  That stops any transfer in progress.
+       ;; The next operation will open a new ftp connection.
+       (delete-process proc)
+       (signal 'quit nil)))))
+
+(defun ange-ftp-nslookup-host (host)
+  "Attempt to resolve the given HOSTNAME using nslookup if possible."
+  (interactive "sHost:  ")
+  (if ange-ftp-nslookup-program
+      (let ((default-directory
+	      (if (file-accessible-directory-p default-directory)
+		  default-directory
+		exec-directory))
+	    ;; It would be nice to make process-connection-type nil,
+	    ;; but that doesn't work: ftp never responds.
+	    ;; Can anyone find a fix for that?
+	    (proc (let ((process-connection-type t))
+		    (start-process " *nslookup*" " *nslookup*"
+				   ange-ftp-nslookup-program host)))
+	    (res host))
+	(process-kill-without-query proc)
+	(save-excursion
+	  (set-buffer (process-buffer proc))
+	  (while (memq (process-status proc) '(run open))
+	    (accept-process-output proc))
+	  (goto-char (point-min))
+	  (if (re-search-forward "Name:.*\nAddress: *\\(.*\\)$" nil t)
+	      (setq res (buffer-substring (match-beginning 1)
+					  (match-end 1))))
+	  (kill-buffer (current-buffer)))
+	res)
+    host))
+
+(defun ange-ftp-start-process (host user name)
+  "Spawn a new ftp process ready to connect to machine HOST and give it NAME.
+If HOST is only ftp-able through a gateway machine then spawn a shell
+on the gateway machine to do the ftp instead."
+  (let* ((use-gateway (ange-ftp-use-gateway-p host))
+	 (use-smart-ftp (and (not ange-ftp-gateway-host)
+			     (ange-ftp-use-smart-gateway-p host)))
+	 (ftp-prog (if (or use-gateway
+			   use-smart-ftp) 
+		       ange-ftp-gateway-ftp-program-name
+		     ange-ftp-ftp-program-name))
+	 (args (append (list ftp-prog) ange-ftp-ftp-program-args))
+	 ;; Without the following binding, ange-ftp-start-process
+	 ;; recurses on file-accessible-directory-p, since it needs to
+	 ;; restart its process in order to determine anything about
+	 ;; default-directory.
+	 (file-name-handler-alist)
+	 (default-directory
+	   (if (file-accessible-directory-p default-directory)
+	       default-directory
+	     exec-directory))
+	 proc)
+    ;; It would be nice to make process-connection-type nil,
+    ;; but that doesn't work: ftp never responds.
+    ;; Can anyone find a fix for that?
+    (let ((process-connection-type t)
+	  (process-environment process-environment)
+	  (buffer (get-buffer-create name)))
+      (save-excursion
+	(set-buffer buffer)
+	(internal-ange-ftp-mode))
+      ;; This tells GNU ftp not to output any fancy escape sequences.
+      (setenv "TERM" "dumb")
+      (if use-gateway
+	  (if ange-ftp-gateway-program-interactive
+	      (setq proc (ange-ftp-gwp-start host user name args))
+	    (setq proc (apply 'start-process name name
+			      (append (list ange-ftp-gateway-program
+					    ange-ftp-gateway-host)
+				      args))))
+	(setq proc (apply 'start-process name name args))))
+    (save-excursion
+      (set-buffer (process-buffer proc))
+      (goto-char (point-max))
+      (set-marker (process-mark proc) (point)))
+    (process-kill-without-query proc)
+    (set-process-sentinel proc (function ange-ftp-process-sentinel))
+    (set-process-filter proc (function ange-ftp-process-filter))
+    ;; On Windows, the standard ftp client buffers its output (because
+    ;; stdout is a pipe handle) so the startup message may never appear:
+    ;; `accept-process-output' at this point would hang indefinitely.
+    ;; However, sending an innocuous command ("help foo") forces some
+    ;; output that will be ignored, which is just as good.  Once we
+    ;; start sending normal commands, the output no longer appears to be
+    ;; buffered, and everything works correctly.  My guess is that the
+    ;; output of interest is being sent to stderr which is not buffered.
+    (when (eq system-type 'windows-nt)
+      ;; force ftp output to be treated as DOS text, otherwise the
+      ;; output of "help foo" confuses the EOL detection logic.
+      (set-process-coding-system proc 'raw-text-dos)
+      (process-send-string proc "help foo\n"))
+    (accept-process-output proc)	;wait for ftp startup message
+    proc))
+
+(put 'internal-ange-ftp-mode 'mode-class 'special)
+
+(defun internal-ange-ftp-mode ()
+  "Major mode for interacting with the FTP process.
+
+\\{comint-mode-map}"
+  (interactive)
+  (comint-mode)
+  (setq major-mode 'internal-ange-ftp-mode)
+  (setq mode-name "Internal Ange-ftp")
+  (let ((proc (get-buffer-process (current-buffer))))
+    (make-local-variable 'ange-ftp-process-string)
+    (setq ange-ftp-process-string "")
+    (make-local-variable 'ange-ftp-process-busy)
+    (make-local-variable 'ange-ftp-process-result)
+    (make-local-variable 'ange-ftp-process-msg)
+    (make-local-variable 'ange-ftp-process-multi-skip)
+    (make-local-variable 'ange-ftp-process-result-line)
+    (make-local-variable 'ange-ftp-process-continue)
+    (make-local-variable 'ange-ftp-hash-mark-count)
+    (make-local-variable 'ange-ftp-binary-hash-mark-size)
+    (make-local-variable 'ange-ftp-ascii-hash-mark-size)
+    (make-local-variable 'ange-ftp-hash-mark-unit)
+    (make-local-variable 'ange-ftp-xfer-size)
+    (make-local-variable 'ange-ftp-last-percent)
+    (setq ange-ftp-hash-mark-count 0)
+    (setq ange-ftp-xfer-size 0)
+    (setq ange-ftp-process-result-line "")
+
+    (setq comint-prompt-regexp "^ftp> ")
+    (make-local-variable 'comint-password-prompt-regexp)
+    ;; This is a regexp that can't match anything.
+    ;; ange-ftp has its own ways of handling passwords.
+    (setq comint-password-prompt-regexp "^a\\'z")
+    (make-local-variable 'paragraph-start)
+    (setq paragraph-start comint-prompt-regexp)))
+
+(defun ange-ftp-smart-login (host user pass account proc)
+  "Connect to the FTP-server on HOST as USER using PASSWORD and ACCOUNT.
+PROC is the FTP-client's process.  This routine uses the smart-gateway
+host specified in ``ange-ftp-gateway-host''."
+  (let ((result (ange-ftp-raw-send-cmd
+		 proc
+		 (format "open %s %s"
+			 (ange-ftp-nslookup-host ange-ftp-gateway-host)
+			 ange-ftp-smart-gateway-port)
+		 (format "Opening FTP connection to %s via %s"
+			 host
+			 ange-ftp-gateway-host))))
+    (or (car result)
+	(ange-ftp-error host user 
+			(concat "OPEN request failed: "
+				(cdr result))))
+    (setq result (ange-ftp-raw-send-cmd
+		  proc (format "user \"%s\"@%s %s %s"
+			       user
+			       (ange-ftp-nslookup-host host)
+			       pass
+			       account)
+		  (format "Logging in as user %s@%s"
+			  user host)))
+    (or (car result)
+	(progn
+	  (ange-ftp-set-passwd host user nil) ; reset password
+	  (ange-ftp-set-account host user nil) ; reset account
+	  (ange-ftp-error host user
+			  (concat "USER request failed: "
+				  (cdr result)))))))
+
+(defun ange-ftp-normal-login (host user pass account proc)
+  "Connect to the FTP-server on HOST as USER using PASSWORD and ACCOUNT.
+PROC is the process to the FTP-client.  HOST may have an optional
+suffix of the form #PORT to specify a non-default port"
+  (save-match-data
+    (string-match "^\\([^#]+\\)\\(#\\([0-9]+\\)\\)?\\'" host)
+    (let* ((nshost (ange-ftp-nslookup-host (match-string 1 host)))
+	   (port (match-string 3 host))
+	   (result (ange-ftp-raw-send-cmd
+		    proc
+		    (if port
+			(format "open %s %s" nshost port)
+		      (format "open %s" nshost))
+		    (format "Opening FTP connection to %s" host))))
+      (or (car result)
+	  (ange-ftp-error host user
+			  (concat "OPEN request failed: "
+				  (cdr result))))
+      (setq result (ange-ftp-raw-send-cmd
+		    proc
+		    (if (and (ange-ftp-use-smart-gateway-p host)
+			     ange-ftp-gateway-host)
+			(format "user \"%s\"@%s %s %s" user nshost pass account)
+		      (format "user \"%s\" %s %s" user pass account))
+		    (format "Logging in as user %s@%s" user host)))
+      (or (car result)
+	  (progn
+	    (ange-ftp-set-passwd host user nil) ;reset password.
+	    (ange-ftp-set-account host user nil) ;reset account.
+	    (ange-ftp-error host user
+			    (concat "USER request failed: "
+				    (cdr result))))))))
+
+;; ange@hplb.hpl.hp.com says this should not be changed.
+(defvar ange-ftp-hash-mark-msgs
+  "[hH]ash mark [^0-9]*\\([0-9]+\\)"
+  "*Regexp matching the FTP client's output upon doing a HASH command.")
+
+(defun ange-ftp-guess-hash-mark-size (proc)
+  (if ange-ftp-send-hash
+      (save-excursion
+	(set-buffer (process-buffer proc))
+	(let* ((status (ange-ftp-raw-send-cmd proc "hash"))
+	       (result (car status))
+	       (line (cdr status)))
+	  (save-match-data
+	    (if (string-match ange-ftp-hash-mark-msgs line)
+		(let ((size (string-to-int
+			    (substring line
+				       (match-beginning 1)
+				       (match-end 1)))))
+		  (setq ange-ftp-ascii-hash-mark-size size
+			ange-ftp-hash-mark-unit (ash size -4))
+
+		  ;; if a default value for this is set, use that value.
+		  (or ange-ftp-binary-hash-mark-size
+		      (setq ange-ftp-binary-hash-mark-size size)))))))))
+
+(defun ange-ftp-get-process (host user)
+  "Return an FTP subprocess connected to HOST and logged in as USER.
+Create a new process if needed."
+  (let* ((name (ange-ftp-ftp-process-buffer host user))
+	 (proc (get-process name)))
+    (if (and proc (memq (process-status proc) '(run open)))
+	proc
+      ;; Must delete dead process so that new process can reuse the name.
+      (if proc (delete-process proc))
+      (let ((pass (ange-ftp-quote-string
+		   (ange-ftp-get-passwd host user)))
+	    (account (ange-ftp-quote-string
+		      (ange-ftp-get-account host user))))
+	;; grab a suitable process.
+	(setq proc (ange-ftp-start-process host user name))
+	
+	;; login to FTP server.
+	(if (and (ange-ftp-use-smart-gateway-p host)
+		 ange-ftp-gateway-host)
+	    (ange-ftp-smart-login host user pass account proc)
+	  (ange-ftp-normal-login host user pass account proc))
+      
+	;; Tell client to send back hash-marks as progress.  It isn't usually
+	;; fatal if this command fails.
+	(ange-ftp-guess-hash-mark-size proc)
+
+	;; Guess at the host type.
+	(ange-ftp-guess-host-type host user)
+
+	;; Try to use passive mode if asked to.
+	(when ange-ftp-try-passive-mode
+	  (let ((answer (cdr (ange-ftp-raw-send-cmd
+			      proc "passive" "Trying passive mode..." nil))))
+	    (if (string-match "\\?\\|refused" answer)
+		(message "Trying passive mode...ok")
+	      (message "Trying passive mode...failed"))))
+
+	;; Run any user-specified hooks.  Note that proc, host and user are
+	;; dynamically bound at this point.
+	(run-hooks 'ange-ftp-process-startup-hook))
+      proc)))
+
+;; Variables for caching host and host-type
+(defvar ange-ftp-host-cache nil)
+(defvar ange-ftp-host-type-cache nil)
+
+;; If ange-ftp-host-type is called with the optional user
+;; argument, it will attempt to guess the host type by connecting
+;; as user, if necessary. For efficiency, I have tried to give this
+;; optional second argument only when necessary. Have I missed any calls
+;; to ange-ftp-host-type where it should have been supplied?
+
+(defun ange-ftp-host-type (host &optional user)
+  "Return a symbol which represents the type of the HOST given.
+If the optional argument USER is given, attempts to guess the
+host-type by logging in as USER."
+  (cond ((null host) 'unix)
+	;; Return `unix' if HOST is nil, since that's the most vanilla
+	;; possible return value.
+	((eq host ange-ftp-host-cache)
+	 ange-ftp-host-type-cache)
+	;; Trigger an ftp connection, in case we need to guess at the host type.
+	((and user (ange-ftp-get-process host user) (eq host ange-ftp-host-cache))
+	 ange-ftp-host-type-cache)
+	(t
+         (setq ange-ftp-host-cache host
+	       ange-ftp-host-type-cache
+	       (cond ((ange-ftp-dumb-unix-host host)
+		      'dumb-unix)
+		     ;;		  ((and (fboundp 'ange-ftp-vos-host)
+		     ;;			(ange-ftp-vos-host host))
+		     ;;		   'vos)
+		     ((and (fboundp 'ange-ftp-vms-host)
+			   (ange-ftp-vms-host host))
+		      'vms)
+		     ((and (fboundp 'ange-ftp-mts-host)
+			   (ange-ftp-mts-host host))
+		      'mts)
+		     ((and (fboundp 'ange-ftp-cms-host)
+			   (ange-ftp-cms-host host))
+		      'cms)
+		     (t
+		      'unix))))))
+
+;; It would be nice to abstract the functions ange-ftp-TYPE-host and
+;; ange-ftp-add-TYPE-host. The trick is to abstract these functions
+;; without sacrificing speed. Also, having separate variables
+;; ange-ftp-TYPE-regexp is more user friendly then requiring the user to
+;; set an alist to indicate that a host is of a given type. Even with
+;; automatic host type recognition, setting a regexp is still a good idea
+;; (for efficiency) if you log into a particular non-UNIX host frequently.
+
+(defvar ange-ftp-fix-name-func-alist nil
+  "Alist saying how to convert file name to the host's syntax.
+Association list of \( TYPE \. FUNC \) pairs, where FUNC is a routine
+which can change a UNIX file name into a name more suitable for a host of type
+TYPE.")
+
+(defvar ange-ftp-fix-dir-name-func-alist nil
+  "Alist saying how to convert directory name to the host's syntax.
+Association list of \( TYPE \. FUNC \) pairs, where FUNC is a routine
+which can change UNIX directory name into a directory name more suitable
+for a host of type TYPE.")
+
+;; *** Perhaps the sense of this variable should be inverted, since there
+;; *** is only 1 host type that can take ls-style listing options.
+(defvar ange-ftp-dumb-host-types '(dumb-unix)
+  "List of host types that can't take UNIX ls-style listing options.")
+
+(defun ange-ftp-send-cmd (host user cmd &optional msg cont nowait)
+  "Find an ftp process connected to HOST logged in as USER and send it CMD.
+MSG is an optional status message to be output before and after issuing the
+command.
+See the documentation for ange-ftp-raw-send-cmd for a description of CONT
+and NOWAIT."
+  ;; Handle conversion to remote file name syntax and remote ls option
+  ;; capability.
+  (let ((cmd0 (car cmd))
+	(cmd1 (nth 1 cmd))
+	(ange-ftp-this-user user)
+	(ange-ftp-this-host host)
+	(ange-ftp-this-msg msg)
+	cmd2 cmd3 host-type fix-name-func)
+
+    (cond
+     
+     ;; pwd case (We don't care what host-type.)
+     ((null cmd1))
+     
+     ;; cmd == 'dir "remote-name" "local-name" "ls-switches"
+     ((progn
+       (setq cmd2 (nth 2 cmd)
+	     host-type (ange-ftp-host-type host user))
+       ;; This will trigger an FTP login, if one doesn't exist
+       (eq cmd0 'dir))
+      (setq cmd1 (funcall
+		  (or (cdr (assq host-type ange-ftp-fix-dir-name-func-alist))
+		      'identity)
+		  cmd1)
+	    cmd3 (nth 3 cmd))
+      ;; Need to deal with the HP-UX ftp bug. This should also allow
+      ;; us to resolve symlinks to directories on SysV machines. (Sebastian will
+      ;; be happy.)
+      (and (eq host-type 'unix)
+	   (string-match "/$" cmd1)
+	   (not (string-match "R" cmd3))
+	   (setq cmd1 (concat cmd1 ".")))
+
+      ;; If the dir name contains a space, some ftp servers will
+      ;; refuse to list it.  We instead change directory to the
+      ;; directory in question and ls ".".
+      (when (string-match " " cmd1)
+	(ange-ftp-cd host user (nth 1 cmd))
+	(setq cmd1 "."))
+
+      ;; If the remote ls can take switches, put them in
+      (or (memq host-type ange-ftp-dumb-host-types)
+	  (setq cmd0 'ls
+		cmd1 (format "\"%s %s\"" cmd3 cmd1))))
+     
+     ;; First argument is the remote name
+     ((progn
+	(setq fix-name-func (or (cdr (assq host-type
+					   ange-ftp-fix-name-func-alist))
+				'identity))
+	(memq cmd0 '(get delete mkdir rmdir cd)))
+      (setq cmd1 (funcall fix-name-func cmd1)))
+
+     ;; Second argument is the remote name
+     ((memq cmd0 '(append put chmod))
+      (setq cmd2 (funcall fix-name-func cmd2)))
+
+     ;; Both arguments are remote names
+     ((eq cmd0 'rename)
+      (setq cmd1 (funcall fix-name-func cmd1)
+	    cmd2 (funcall fix-name-func cmd2))))
+	  
+    ;; Turn the command into one long string 
+    (setq cmd0 (symbol-name cmd0))
+    (setq cmd (concat cmd0
+		      (and cmd1 (concat " " cmd1))
+		      (and cmd2 (concat " " cmd2))))
+
+    ;; Actually send the resulting command.
+    (let (afsc-result
+	  afsc-line)
+      (ange-ftp-raw-send-cmd
+       (ange-ftp-get-process host user)
+       cmd
+       msg
+       (list
+	(function (lambda (result line host user
+				  cmd msg cont nowait)
+		    (or cont
+			(setq afsc-result result
+			      afsc-line line))
+		    (if result
+			(ange-ftp-call-cont cont result line)
+		      (ange-ftp-raw-send-cmd
+		       (ange-ftp-get-process host user)
+		       cmd
+		       msg
+		       (list
+			(function (lambda (result line cont)
+				    (or cont
+					(setq afsc-result result
+					      afsc-line line))
+				    (ange-ftp-call-cont cont result line)))
+			cont)
+		       nowait))))
+	host user cmd msg cont nowait)
+       nowait)
+
+      (if nowait
+	  nil
+	(if cont
+	    nil
+	  (cons afsc-result afsc-line))))))
+
+;; It might be nice to message users about the host type identified,
+;; but there is so much other messaging going on, it would not be
+;; seen. No point in slowing things down just so users can read
+;; a host type message.
+
+(defconst ange-ftp-cms-name-template
+  (concat
+   "^[-A-Z0-9$*][-A-Z0-9$*]?[-A-Z0-9$*]?[-A-Z0-9$*]?[-A-Z0-9$*]?"
+   "[-A-Z0-9$*]?[-A-Z0-9$*]?[-A-Z0-9$*]?\\.[0-9][0-9][0-9A-Z]$"))
+(defconst ange-ftp-vms-name-template
+  "^[-A-Z0-9_$]+:\\[[-A-Z0-9_$]+\\(\\.[-A-Z0-9_$]+\\)*\\]$")
+(defconst ange-ftp-mts-name-template
+  "^[A-Z0-9._][A-Z0-9._][A-Z0-9._][A-Z0-9._]:$")
+
+(defun ange-ftp-guess-host-type (host user)
+  "Guess at the the host type of HOST.
+Works by doing a pwd and examining the directory syntax."
+  (let ((host-type (ange-ftp-host-type host))
+	(key (concat host "/" user "/~")))
+    (if (eq host-type 'unix)
+	;; Note that ange-ftp-host-type returns unix as the default value.
+	(save-match-data
+	  (let* ((result (ange-ftp-get-pwd host user))
+		 (dir (car result))
+		 fix-name-func)
+	    (cond ((null dir)
+		   (message "Warning! Unable to get home directory")
+		   (sit-for 1)
+		   (if (string-match
+			"^450 No current working directory defined$"
+			(cdr result))
+		       
+		       ;; We'll assume that if pwd bombs with this
+		       ;; error message, then it's CMS.
+		       (progn
+			 (ange-ftp-add-cms-host host)
+			 (setq ange-ftp-host-cache host
+			       ange-ftp-host-type-cache 'cms))))
+
+		  ;; try for VMS
+		  ((string-match ange-ftp-vms-name-template dir)
+		   (ange-ftp-add-vms-host host)
+		   ;; The add-host functions clear the host type cache.
+		   ;; Therefore, need to set the cache afterwards.
+		   (setq ange-ftp-host-cache host
+			 ange-ftp-host-type-cache 'vms))
+
+		  ;; try for MTS
+		  ((string-match ange-ftp-mts-name-template dir)
+		   (ange-ftp-add-mts-host host)
+		   (setq ange-ftp-host-cache host
+			 ange-ftp-host-type-cache 'mts))
+		  
+		  ;; try for CMS
+		  ((string-match ange-ftp-cms-name-template dir)
+		   (ange-ftp-add-cms-host host)
+		   (setq ange-ftp-host-cache host
+			 ange-ftp-host-type-cache 'cms))
+
+		  ;; assume UN*X
+		  (t
+		   (setq ange-ftp-host-cache host
+			 ange-ftp-host-type-cache 'unix)))
+
+	    ;; Now that we have done a pwd, might as well put it in
+	    ;; the expand-dir hashtable.
+	    (let ((ange-ftp-this-user user)
+		  (ange-ftp-this-host host))
+	      (setq fix-name-func (cdr (assq ange-ftp-host-type-cache
+					     ange-ftp-fix-name-func-alist)))
+	      (if fix-name-func
+		  (setq dir (funcall fix-name-func dir 'reverse))))
+	    (ange-ftp-put-hash-entry key dir
+				     ange-ftp-expand-dir-hashtable))))
+
+    ;; In the special case of CMS make sure that know the
+    ;; expansion of the home minidisk now, because we will
+    ;; be doing a lot of cd's.
+    (if (and (eq host-type 'cms)
+	     (not (ange-ftp-hash-entry-exists-p
+		   key ange-ftp-expand-dir-hashtable)))
+	(let ((dir (car (ange-ftp-get-pwd host user))))
+	  (if dir
+	      (ange-ftp-put-hash-entry key (concat "/" dir)
+				       ange-ftp-expand-dir-hashtable)
+	    (message "Warning! Unable to get home directory")
+	    (sit-for 1))))))
+
+
+;;;; ------------------------------------------------------------
+;;;; Remote file and directory listing support.
+;;;; ------------------------------------------------------------
+
+;; Returns whether HOST's FTP server doesn't like \'ls\' or \'dir\' commands
+;; to take switch arguments.
+(defun ange-ftp-dumb-unix-host (host)
+  (and host ange-ftp-dumb-unix-host-regexp
+       (save-match-data
+	 (string-match ange-ftp-dumb-unix-host-regexp host))))
+
+(defun ange-ftp-add-dumb-unix-host (host)
+  "Interactively adds a given HOST to ange-ftp-dumb-unix-host-regexp."
+  (interactive
+   (list (read-string "Host: "
+		      (let ((name (or (buffer-file-name) default-directory)))
+			(and name (car (ange-ftp-ftp-name name)))))))
+  (if (not (ange-ftp-dumb-unix-host host))
+      (setq ange-ftp-dumb-unix-host-regexp
+	    (concat "^" (regexp-quote host) "$"
+		    (and ange-ftp-dumb-unix-host-regexp "\\|")
+		    ange-ftp-dumb-unix-host-regexp)
+	    ange-ftp-host-cache nil)))
+
+(defvar ange-ftp-parse-list-func-alist nil
+  "Alist saying how to parse directory listings for certain OS types.
+Association list of \( TYPE \. FUNC \) pairs.  The FUNC is a routine
+which can parse the output from a DIR listing for a host of type TYPE.")
+
+;; With no-error nil, this function returns:
+;; an error if file is not an ange-ftp-name
+;;                      (This should never happen.) 
+;; an error if either the listing is unreadable or there is an ftp error.
+;; the listing (a string), if everything works.
+;; 
+;; With no-error t, it returns:
+;; an error if not an ange-ftp-name
+;; error if listing is unreadable (most likely caused by a slow connection)
+;; nil if ftp error (this is because although asking to list a nonexistent
+;;                   directory on a remote unix machine usually (except
+;;                   maybe for dumb hosts) returns an ls error, but no
+;;                   ftp error, if the same is done on a VMS machine,
+;;                   an ftp error is returned. Need to trap the error
+;;                   so we can go on and try to list the parent.)
+;; the listing, if everything works.
+
+;; If WILDCARD is non-nil, then this implements the guts of insert-directory
+;; in the wildcard case.  Then we make a relative directory listing
+;; of FILE within the directory specified by `default-directory'.
+
+(defvar ange-ftp-before-parse-ls-hook nil
+  "Normal hook run before parsing the text of an ftp directory listing.")
+
+(defun ange-ftp-ls (file lsargs parse &optional no-error wildcard)
+  "Return the output of an `DIR' or `ls' command done over ftp.
+FILE is the full name of the remote file, LSARGS is any args to pass to the
+`ls' command, and PARSE specifies that the output should be parsed and stored
+away in the internal cache."
+  ;; If parse is t, we assume that file is a directory. i.e. we only parse
+  ;; full directory listings.
+  (let* ((ange-ftp-this-file (ange-ftp-expand-file-name file))
+	 (parsed (ange-ftp-ftp-name ange-ftp-this-file)))
+    (if parsed
+	(let* ((host (nth 0 parsed))
+	       (user (nth 1 parsed))
+	       (name (ange-ftp-quote-string (nth 2 parsed)))
+	       (key (directory-file-name ange-ftp-this-file))
+	       (host-type (ange-ftp-host-type host user))
+	       (dumb (memq host-type ange-ftp-dumb-host-types))
+	       result
+	       temp
+	       lscmd parse-func)
+	  (if (string-equal name "")
+	      (setq name
+		    (ange-ftp-real-file-name-as-directory
+		          (ange-ftp-expand-dir host user "~"))))
+	  (if (and ange-ftp-ls-cache-file
+		   (string-equal key ange-ftp-ls-cache-file)
+		   ;; Don't care about lsargs for dumb hosts.
+		   (or dumb (string-equal lsargs ange-ftp-ls-cache-lsargs)))
+	      ange-ftp-ls-cache-res
+	    (setq temp (ange-ftp-make-tmp-name host))
+	    (if wildcard
+		(progn
+		  (ange-ftp-cd host user (file-name-directory name))
+		  (setq lscmd (list 'dir file temp lsargs)))
+	      (setq lscmd (list 'dir name temp lsargs)))
+	    (unwind-protect
+		(if (car (setq result (ange-ftp-send-cmd
+				       host
+				       user
+				       lscmd
+				       (format "Listing %s"
+					       (ange-ftp-abbreviate-filename
+						ange-ftp-this-file)))))
+		    (save-excursion
+		      (set-buffer (get-buffer-create
+				   ange-ftp-data-buffer-name))
+		      (erase-buffer)
+		      (if (ange-ftp-real-file-readable-p temp)
+			  (ange-ftp-real-insert-file-contents temp)
+			(sleep-for ange-ftp-retry-time)
+					;wait for file to possibly appear
+			(if (ange-ftp-real-file-readable-p temp)
+			    ;; Try again.
+			    (ange-ftp-real-insert-file-contents temp)
+			  (ange-ftp-error host user
+					  (format
+					   "list data file %s not readable"
+					   temp))))
+		      (run-hooks 'ange-ftp-before-parse-ls-hook)
+		      (if parse
+			  (ange-ftp-set-files
+			   ange-ftp-this-file
+			   (if (setq
+				parse-func
+				(cdr (assq host-type
+					   ange-ftp-parse-list-func-alist)))
+			       (funcall parse-func)
+			     (ange-ftp-parse-dired-listing lsargs))))
+		      (setq ange-ftp-ls-cache-file key
+			    ange-ftp-ls-cache-lsargs lsargs
+					; For dumb hosts-types this is
+					; meaningless but harmless.
+			    ange-ftp-ls-cache-res (buffer-string))
+		      ;; (kill-buffer (current-buffer))
+		      ange-ftp-ls-cache-res)
+		  (if no-error
+		      nil
+		    (ange-ftp-error host user
+				    (concat "DIR failed: " (cdr result)))))
+	      (ange-ftp-del-tmp-name temp))))
+      (error "Should never happen. Please report. Bug ref. no.: 1"))))
+
+;;;; ------------------------------------------------------------
+;;;; Directory information caching support.
+;;;; ------------------------------------------------------------
+
+(defconst ange-ftp-date-regexp
+  (let* ((l "\\([A-Za-z]\\|[^\0-\177]\\)")
+	 ;; In some locales, month abbreviations are as short as 2 letters,
+	 ;; and they can be padded on the right with spaces.
+	 ;; weiand: changed: month ends with . or , or .,
+;;old	 (month (concat l l "+ *"))
+	 (month (concat l l "+[.]?,? *"))
+	 ;; Recognize any non-ASCII character.  
+	 ;; The purpose is to match a Kanji character.
+	 (k "[^\0-\177]")
+	 (s " ")
+	 (mm "[ 0-1][0-9]")
+	 ;; weiand: changed: day ends with .
+;;old	 (dd "[ 0-3][0-9]")
+	 (dd "[ 0-3][0-9][.]?")
+	 (western (concat "\\(" month s dd "\\|" dd s month "\\)"))
+	 (japanese (concat mm k s dd k)))
+	 ;; Require the previous column to end in a digit.
+	 ;; This avoids recognizing `1 may 1997' as a date in the line:
+	 ;; -r--r--r--   1 may      1997        1168 Oct 19 16:49 README
+    (concat "[0-9]" s "\\(" western "\\|" japanese "\\)" s))
+  "Regular expression to match up to the column before the file name in a
+directory listing.  This regular expression is designed to recognize dates
+regardless of the language.")
+
+(defvar ange-ftp-add-file-entry-alist nil
+  "Alist saying how to add file entries on certain OS types.
+Association list of pairs \( TYPE \. FUNC \), where FUNC
+is a function to be used to add a file entry for the OS TYPE. The
+main reason for this alist is to deal with file versions in VMS.")
+
+(defvar ange-ftp-delete-file-entry-alist nil
+  "Alist saying how to delete files on certain OS types.
+Association list of pairs \( TYPE \. FUNC \), where FUNC
+is a function to be used to delete a file entry for the OS TYPE.
+The main reason for this alist is to deal with file versions in VMS.")
+
+(defun ange-ftp-add-file-entry (name &optional dir-p)
+  "Add a file entry for file NAME, if its directory info exists."
+  (funcall (or (cdr (assq (ange-ftp-host-type
+			   (car (ange-ftp-ftp-name name)))
+			  ange-ftp-add-file-entry-alist))
+	       'ange-ftp-internal-add-file-entry)
+	   name dir-p)
+  (setq ange-ftp-ls-cache-file nil))
+
+(defun ange-ftp-delete-file-entry (name &optional dir-p)
+  "Delete the file entry for file NAME, if its directory info exists."
+  (funcall (or (cdr (assq (ange-ftp-host-type
+			   (car (ange-ftp-ftp-name name)))
+			  ange-ftp-delete-file-entry-alist))
+	       'ange-ftp-internal-delete-file-entry)
+	   name dir-p)
+  (setq ange-ftp-ls-cache-file nil))
+
+(defmacro ange-ftp-parse-filename ()
+  ;;Extract the filename from the current line of a dired-like listing.
+  (` (let ((eol (progn (end-of-line) (point))))
+       (beginning-of-line)
+       (if (re-search-forward ange-ftp-date-regexp eol t)
+	   (progn
+	     (skip-chars-forward " ")
+	     (skip-chars-forward "^ " eol)
+	     (skip-chars-forward " " eol)
+	     ;; We bomb on filenames starting with a space.
+	     (buffer-substring (point) eol))))))
+  
+;; This deals with the F switch. Should also do something about
+;; unquoting names obtained with the SysV b switch and the GNU Q
+;; switch. See Sebastian's dired-get-filename.
+
+(defmacro ange-ftp-ls-parser ()
+  ;; Note that switches is dynamically bound.
+  ;; Meant to be called by ange-ftp-parse-dired-listing
+  (` (let ((tbl (ange-ftp-make-hashtable))
+	   (used-F (and (stringp switches)
+			(string-match "F" switches)))
+	   file-type symlink directory file)
+       (while (setq file (ange-ftp-parse-filename))
+	 (beginning-of-line)
+	 (skip-chars-forward "\t 0-9")
+	 (setq file-type (following-char)
+	       directory (eq file-type ?d))
+	 (if (eq file-type ?l)
+	     (if (string-match " -> " file)
+		 (setq symlink (substring file (match-end 0))
+		       file (substring file 0 (match-beginning 0)))
+	       ;; Shouldn't happen
+	       (setq symlink ""))
+	   (setq symlink nil))
+	 ;; Only do a costly regexp search if the F switch was used.
+	 (if (and used-F
+		  (not (string-equal file ""))
+		  (looking-at
+		   ".[-r][-w]\\([^ ]\\)[-r][-w]\\([^ ]\\)[-r][-w]\\([^ ]\\)"))
+	     (let ((socket (eq file-type ?s))
+		   (executable
+		    (and (not symlink) ; x bits don't mean a thing for symlinks
+			 (string-match "[xst]"
+				       (concat
+					(buffer-substring
+					 (match-beginning 1)
+					 (match-end 1))
+					(buffer-substring
+					 (match-beginning 2)
+					 (match-end 2))
+					(buffer-substring
+					 (match-beginning 3)
+					 (match-end 3)))))))
+	       ;; Some ls's with the F switch mark symlinks with an @ (ULTRIX)
+	       ;; and others don't. (sigh...) Beware, that some Unix's don't
+	       ;; seem to believe in the F-switch
+	       (if (or (and symlink (string-match "@$" file))
+		       (and directory (string-match "/$" file))
+		       (and executable (string-match "*$" file))
+		       (and socket (string-match "=$" file)))
+		   (setq file (substring file 0 -1)))))
+	 (ange-ftp-put-hash-entry file (or symlink directory) tbl)
+	 (forward-line 1))
+       (ange-ftp-put-hash-entry "." t tbl)
+       (ange-ftp-put-hash-entry ".." t tbl)
+       tbl)))
+
+;;; The dl stuff for descriptive listings
+
+(defvar ange-ftp-dl-dir-regexp nil
+  "Regexp matching directories which are listed in dl format.
+This regexp should not be anchored with a trailing `$', because it should
+match subdirectories as well.")
+
+(defun ange-ftp-add-dl-dir (dir)
+  "Interactively adds a DIR to ange-ftp-dl-dir-regexp."
+  (interactive
+   (list (read-string "Directory: "
+		      (let ((name (or (buffer-file-name) default-directory)))
+			(and name (ange-ftp-ftp-name name)
+			     (file-name-directory name))))))
+  (if (not (and ange-ftp-dl-dir-regexp
+		(string-match ange-ftp-dl-dir-regexp dir)))
+      (setq ange-ftp-dl-dir-regexp
+	    (concat "^" (regexp-quote dir)
+		    (and ange-ftp-dl-dir-regexp "\\|")
+		    ange-ftp-dl-dir-regexp))))
+
+(defmacro ange-ftp-dl-parser ()
+  ;; Parse the current buffer, which is assumed to be a descriptive
+  ;; listing, and return a hashtable.
+  (` (let ((tbl (ange-ftp-make-hashtable)))
+       (while (not (eobp))
+	 (ange-ftp-put-hash-entry
+	  (buffer-substring (point)
+			    (progn
+			      (skip-chars-forward "^ /\n")
+			      (point)))
+	  (eq (following-char) ?/)
+	  tbl)
+	 (forward-line 1))
+       (ange-ftp-put-hash-entry "." t tbl)
+       (ange-ftp-put-hash-entry ".." t tbl)
+       tbl)))
+
+;; Parse the current buffer which is assumed to be in a dired-like listing
+;; format, and return a hashtable as the result. If the listing is not really
+;; a listing, then return nil.
+
+(defun ange-ftp-parse-dired-listing (&optional switches)
+  (save-match-data
+    (cond
+     ((looking-at "^total [0-9]+$")
+      (forward-line 1)
+      ;; Some systems put in a blank line here.
+      (if (eolp) (forward-line 1))
+      (ange-ftp-ls-parser))
+     ((looking-at "[^\n]+\\( not found\\|: Not a directory\\)\n\\'")
+      ;; It's an ls error message.
+      nil)
+     ((eobp) ; i.e. (zerop (buffer-size))
+      ;; This could be one of:
+      ;; (1) An Ultrix ls error message
+      ;; (2) A listing with the A switch of an empty directory
+      ;;     on a machine which doesn't give a total line.
+      ;; (3) The twilight zone.
+      ;; We'll assume (1) for now.
+      nil)
+     ((re-search-forward ange-ftp-date-regexp nil t)
+      (beginning-of-line)
+      (ange-ftp-ls-parser))
+     ((re-search-forward "^[^ \n\t]+ +\\([0-9]+\\|-\\|=\\) " nil t)
+      ;; It's a dl listing (I hope).
+      ;; file is bound by the call to ange-ftp-ls
+      (ange-ftp-add-dl-dir ange-ftp-this-file)
+      (beginning-of-line)
+      (ange-ftp-dl-parser))
+     (t nil))))
+
+(defun ange-ftp-set-files (directory files)
+  "For a given DIRECTORY, set or change the associated FILES hashtable."
+  (and files (ange-ftp-put-hash-entry (file-name-as-directory directory)
+				      files ange-ftp-files-hashtable)))
+
+(defun ange-ftp-get-files (directory &optional no-error)
+  "Given a given DIRECTORY, return a hashtable of file entries.
+This will give an error or return nil, depending on the value of
+NO-ERROR, if a listing for DIRECTORY cannot be obtained."
+  (setq directory (file-name-as-directory directory)) ;normalize
+  (or (ange-ftp-get-hash-entry directory ange-ftp-files-hashtable)
+      (save-match-data
+	(and (ange-ftp-ls directory
+			  ;; This is an efficiency hack. We try to
+			  ;; anticipate what sort of listing dired
+			  ;; might want, and cache just such a listing.
+			  (if (and (boundp 'dired-actual-switches)
+				   (stringp dired-actual-switches)
+				   ;; We allow the A switch, which lists
+				   ;; all files except "." and "..".
+				   ;; This is OK because we manually
+				   ;; insert these entries
+				   ;; in the hash table.
+				   (string-match
+				    "[aA]" dired-actual-switches)
+				   (string-match
+				    "l" dired-actual-switches)
+				   (not (string-match
+					 "R" dired-actual-switches)))
+			      dired-actual-switches
+			    (if (and (boundp 'dired-listing-switches)
+				     (stringp dired-listing-switches)
+				     (string-match
+				      "[aA]" dired-listing-switches)
+				     (string-match
+				      "l" dired-listing-switches)
+				     (not (string-match
+					   "R" dired-listing-switches)))
+				dired-listing-switches
+			      "-al"))
+			  t no-error)
+	     (ange-ftp-get-hash-entry
+	      directory ange-ftp-files-hashtable)))))
+
+;; Given NAME, return the file part that can be used for looking up the
+;; file's entry in a hashtable.
+(defmacro ange-ftp-get-file-part (name)
+  (` (let ((file (file-name-nondirectory (, name))))
+       (if (string-equal file "")
+	   "."
+	 file))))
+
+;; Return whether ange-ftp-file-entry-p and ange-ftp-get-file-entry are
+;; allowed to determine if NAME is a sub-directory by listing it directly,
+;; rather than listing its parent directory. This is used for efficiency so
+;; that a wasted listing is not done:
+;; 1. When looking for a .dired file in dired-x.el.
+;; 2. The syntax of FILE and DIR make it impossible that FILE could be a valid
+;;     subdirectory. This is of course an OS dependent judgement.
+
+(defmacro ange-ftp-allow-child-lookup (dir file)
+  (` (not
+      (let* ((efile (, file)) ; expand once.
+	     (edir (, dir))
+	     (parsed (ange-ftp-ftp-name edir))
+	     (host-type (ange-ftp-host-type
+			 (car parsed))))
+	(or
+	 ;; Deal with dired
+	 (and (boundp 'dired-local-variables-file) ; in the dired-x package
+	      (stringp dired-local-variables-file)
+	      (string-equal dired-local-variables-file efile))
+	 ;; No dots in dir names in vms.
+	 (and (eq host-type 'vms)
+	      (string-match "\\." efile))
+	 ;; No subdirs in mts of cms.
+	 (and (memq host-type '(mts cms))
+	      (not (string-equal "/" (nth 2 parsed)))))))))
+
+(defun ange-ftp-file-entry-p (name)
+  "Given NAME, return whether there is a file entry for it."
+  (let* ((name (directory-file-name name))
+	 (dir (file-name-directory name))
+	 (ent (ange-ftp-get-hash-entry dir ange-ftp-files-hashtable))
+	 (file (ange-ftp-get-file-part name)))
+    (if ent
+	(ange-ftp-hash-entry-exists-p file ent)
+      (or (and (ange-ftp-allow-child-lookup dir file)
+	       (setq ent (ange-ftp-get-files name t))
+	       ;; Try a child lookup. i.e. try to list file as a
+	       ;; subdirectory of dir. This is a good idea because
+	       ;; we may not have read permission for file's parent. Also,
+	       ;; people tend to work down directory trees anyway. We use
+	       ;; no-error ;; because if file does not exist as a subdir.,
+	       ;; then dumb hosts will give an ftp error. Smart unix hosts
+	       ;; will simply send back the ls
+	       ;; error message.
+	       (ange-ftp-get-hash-entry "." ent))
+	  ;; Child lookup failed, so try the parent.
+	  (let ((table (ange-ftp-get-files dir)))
+	    ;; If the dir doesn't exist, don't use it as a hash table.
+	    (and table
+		 (ange-ftp-hash-entry-exists-p file
+					       table)))))))
+
+(defun ange-ftp-get-file-entry (name)
+  "Given NAME, return the given file entry.
+The entry will be either t for a directory, nil for a normal file,
+or a string for a symlink. If the file isn't in the hashtable,
+this also returns nil."
+  (let* ((name (directory-file-name name))
+	 (dir (file-name-directory name))
+	 (ent (ange-ftp-get-hash-entry dir ange-ftp-files-hashtable))
+	 (file (ange-ftp-get-file-part name)))
+    (if ent
+	(ange-ftp-get-hash-entry file ent)
+      (or (and (ange-ftp-allow-child-lookup dir file)
+	       (setq ent (ange-ftp-get-files name t))
+	       (ange-ftp-get-hash-entry "." ent))
+	       ;; i.e. it's a directory by child lookup
+	  (ange-ftp-get-hash-entry file
+				   (ange-ftp-get-files dir))))))
+
+(defun ange-ftp-internal-delete-file-entry (name &optional dir-p)
+  (if dir-p
+      (progn 
+	(setq name (file-name-as-directory name))
+	(ange-ftp-del-hash-entry name ange-ftp-files-hashtable)
+	(setq name (directory-file-name name))))
+  ;; Note that file-name-as-directory followed by directory-file-name
+  ;; serves to canonicalize directory file names to their unix form.
+  ;; i.e. in VMS, FOO.DIR -> FOO/ -> FOO
+  (let ((files (ange-ftp-get-hash-entry (file-name-directory name)
+					ange-ftp-files-hashtable)))
+    (if files
+	(ange-ftp-del-hash-entry (ange-ftp-get-file-part name)
+				 files))))
+
+(defun ange-ftp-internal-add-file-entry (name &optional dir-p)
+  (and dir-p
+       (setq name (directory-file-name name)))
+  (let ((files (ange-ftp-get-hash-entry (file-name-directory name)
+					ange-ftp-files-hashtable)))
+    (if files
+	(ange-ftp-put-hash-entry (ange-ftp-get-file-part name)
+				 dir-p
+				 files))))
+
+(defun ange-ftp-wipe-file-entries (host user)
+  "Get rid of entry for HOST, USER pair from file entry information hashtable."
+  (let ((new-tbl (ange-ftp-make-hashtable (length ange-ftp-files-hashtable))))
+    (ange-ftp-map-hashtable
+     (function
+      (lambda (key val)
+	(let ((parsed (ange-ftp-ftp-name key)))
+	  (if parsed
+	      (let ((h (nth 0 parsed))
+		    (u (nth 1 parsed)))
+		(or (and (equal host h) (equal user u))
+		    (ange-ftp-put-hash-entry key val new-tbl)))))))
+     ange-ftp-files-hashtable)
+    (setq ange-ftp-files-hashtable new-tbl)))
+
+;;;; ------------------------------------------------------------
+;;;; File transfer mode support.
+;;;; ------------------------------------------------------------
+
+(defun ange-ftp-set-binary-mode (host user)
+  "Tell the ftp process for the given HOST & USER to switch to binary mode."
+  (let ((result (ange-ftp-send-cmd host user '(type "binary"))))
+    (if (not (car result))
+	(ange-ftp-error host user (concat "BINARY failed: " (cdr result)))
+      (save-excursion
+	(set-buffer (process-buffer (ange-ftp-get-process host user)))
+	(and ange-ftp-binary-hash-mark-size
+	     (setq ange-ftp-hash-mark-unit
+		   (ash ange-ftp-binary-hash-mark-size -4)))))))
+
+(defun ange-ftp-set-ascii-mode (host user)
+  "Tell the ftp process for the given HOST & USER to switch to ascii mode."
+  (let ((result (ange-ftp-send-cmd host user '(type "ascii"))))
+    (if (not (car result))
+	(ange-ftp-error host user (concat "ASCII failed: " (cdr result)))
+      (save-excursion
+	(set-buffer (process-buffer (ange-ftp-get-process host user)))
+	(and ange-ftp-ascii-hash-mark-size
+	     (setq ange-ftp-hash-mark-unit
+		   (ash ange-ftp-ascii-hash-mark-size -4)))))))
+
+(defun ange-ftp-cd (host user dir)
+  (let ((result (ange-ftp-send-cmd host user (list 'cd dir) "Doing CD")))
+    (or (car result)
+	(ange-ftp-error host user (concat "CD failed: " (cdr result))))))
+
+(defun ange-ftp-get-pwd (host user)
+  "Attempts to get the current working directory for the given HOST/USER pair.
+Returns \( DIR . LINE \) where DIR is either the directory or nil if not found,
+and LINE is the relevant success or fail line from the FTP-client."
+  (let* ((result (ange-ftp-send-cmd host user '(pwd) "Getting PWD"))
+	 (line (cdr result))
+	 dir)
+    (if (car result)
+	(save-match-data
+	  (and (or (string-match "\"\\([^\"]*\\)\"" line)
+		   (string-match " \\([^ ]+\\) " line)) ; stone-age VMS servers!
+	       (setq dir (substring line
+				    (match-beginning 1)
+				    (match-end 1))))))
+    (cons dir line)))
+
+;;; ------------------------------------------------------------
+;;; expand-file-name and friends...which currently don't work
+;;; ------------------------------------------------------------
+
+(defun ange-ftp-expand-dir (host user dir)
+  "Return the result of doing a PWD in the current FTP session.
+Use the connection to machine HOST
+logged in as user USER and cd'd to directory DIR."
+  (let* ((host-type (ange-ftp-host-type host user))
+	 ;; It is more efficient to call ange-ftp-host-type
+	 ;; before binding res, because ange-ftp-host-type sometimes
+	 ;; adds to the info in the expand-dir-hashtable.
+	 (fix-name-func
+	  (cdr (assq host-type ange-ftp-fix-name-func-alist)))
+	 (key (concat host "/" user "/" dir))
+	 (res (ange-ftp-get-hash-entry key ange-ftp-expand-dir-hashtable)))
+    (or res
+	(progn
+	  (or
+	   (string-equal user "anonymous")
+	   (string-equal user "ftp")
+	   (not (eq host-type 'unix))
+	   (let* ((ange-ftp-good-msgs (concat ange-ftp-expand-dir-regexp
+					      "\\|"
+					      ange-ftp-good-msgs))
+		  (result (ange-ftp-send-cmd host user
+					     (list 'get dir null-device)
+					     (format "expanding %s" dir)))
+		  (line (cdr result)))
+	     (setq res
+		   (if (string-match ange-ftp-expand-dir-regexp line)
+		       (substring line 
+				  (match-beginning 1)
+				  (match-end 1))))))
+	  (or res
+	      (if (string-equal dir "~")
+		  (setq res (car (ange-ftp-get-pwd host user)))
+		(let ((home (ange-ftp-expand-dir host user "~")))
+		  (unwind-protect
+		      (and (ange-ftp-cd host user dir)
+			   (setq res (car (ange-ftp-get-pwd host user))))
+		    (ange-ftp-cd host user home)))))
+	  (if res
+	      (let ((ange-ftp-this-user user)
+		    (ange-ftp-this-host host))
+		(if fix-name-func
+		    (setq res (funcall fix-name-func res 'reverse)))
+		(ange-ftp-put-hash-entry
+		 key res ange-ftp-expand-dir-hashtable)))
+	  res))))
+
+(defun ange-ftp-canonize-filename (n)
+  "Take a string and short-circuit //, /. and /.."
+  (if (string-match "[^:]+//" n)		;don't upset Apollo users
+      (setq n (substring n (1- (match-end 0)))))
+  (let ((parsed (ange-ftp-ftp-name n)))
+    (if parsed
+	(let ((host (car parsed))
+	      (user (nth 1 parsed))
+	      (name (nth 2 parsed)))
+	  
+	  ;; See if remote name is absolute.  If so then just expand it and
+	  ;; replace the name component of the overall name.
+	  (cond ((string-match "^/" name)
+		 name)
+		
+		;; Name starts with ~ or ~user.  Resolve that part of the name
+		;; making it absolute then re-expand it.
+		((string-match "^~[^/]*" name)
+		 (let* ((tilda (substring name
+					  (match-beginning 0) 
+					  (match-end 0)))
+			(rest (substring name (match-end 0)))
+			(dir (ange-ftp-expand-dir host user tilda)))
+		   (if dir
+		       (setq name (concat dir rest))
+		     (error "User \"%s\" is not known" 
+			    (substring tilda 1)))))
+		
+		;; relative name.  Tack on homedir and re-expand.
+		(t
+		 (let ((dir (ange-ftp-expand-dir host user "~")))
+		   (if dir
+		       (setq name (concat
+				   (ange-ftp-real-file-name-as-directory dir)
+				   name))
+		     (error "Unable to obtain CWD")))))
+	  
+	  ;; If name starts with //, preserve that, for apollo system.
+	  (if (not (string-match "^//" name))
+	      (progn
+		(if (not (eq system-type 'windows-nt))
+		    (setq name (ange-ftp-real-expand-file-name name))
+		  ;; Windows UNC default dirs do not make sense for ftp.
+		  (if (string-match "^//" default-directory)
+		      (setq name (ange-ftp-real-expand-file-name name "c:/"))
+		    (setq name (ange-ftp-real-expand-file-name name)))
+		  ;; Strip off possible drive specifier.
+		  (if (string-match "^[a-zA-Z]:" name)
+		      (setq name (substring name 2))))
+		(if (string-match "^//" name)
+		    (setq name (substring name 1)))))
+	  
+	  ;; Now substitute the expanded name back into the overall filename.
+	  (ange-ftp-replace-name-component n name))
+      
+      ;; non-ange-ftp name.  Just expand normally.
+      (if (eq (string-to-char n) ?/)
+	  (ange-ftp-real-expand-file-name n)
+	(ange-ftp-real-expand-file-name
+	 (ange-ftp-real-file-name-nondirectory n)
+	 (ange-ftp-real-file-name-directory n))))))
+
+(defun ange-ftp-expand-file-name (name &optional default)
+  "Documented as original."
+  (save-match-data
+    (setq default (or default default-directory))
+    (cond ((eq (string-to-char name) ?~)
+	   (ange-ftp-real-expand-file-name name))
+	  ((eq (string-to-char name) ?/)
+	   (ange-ftp-canonize-filename name))
+	  ((and (eq system-type 'windows-nt)
+		(eq (string-to-char name) ?\\))
+	   (ange-ftp-canonize-filename name))
+	  ((and (eq system-type 'windows-nt)
+		(or (string-match "^[a-zA-Z]:" name)
+		    (string-match "^[a-zA-Z]:" default)))
+	   (ange-ftp-real-expand-file-name name default))
+	  ((zerop (length name))
+	   (ange-ftp-canonize-filename default))
+	  ((ange-ftp-canonize-filename
+	    (concat (file-name-as-directory default) name))))))
+
+;;; These are problems--they are currently not enabled.
+
+(defvar ange-ftp-file-name-as-directory-alist nil
+  "Association list of \( TYPE \. FUNC \) pairs.
+FUNC converts a filename to a directory name for the operating
+system TYPE.")
+
+(defun ange-ftp-file-name-as-directory (name)
+  "Documented as original."
+  (let ((parsed (ange-ftp-ftp-name name)))
+    (if parsed
+	(if (string-equal (nth 2 parsed) "")
+	    name
+	  (funcall (or (cdr (assq
+			     (ange-ftp-host-type (car parsed))
+			     ange-ftp-file-name-as-directory-alist))
+		       'ange-ftp-real-file-name-as-directory)
+		   name))
+      (ange-ftp-real-file-name-as-directory name))))
+ 	
+(defun ange-ftp-file-name-directory (name)
+  "Documented as original."
+  (let ((parsed (ange-ftp-ftp-name name)))
+    (if parsed
+	(let ((filename (nth 2 parsed)))
+	  (if (save-match-data
+		(string-match "^~[^/]*$" filename))
+	      name
+	    (ange-ftp-replace-name-component
+	     name
+	     (ange-ftp-real-file-name-directory filename))))
+      (ange-ftp-real-file-name-directory name))))
+
+(defun ange-ftp-file-name-nondirectory (name)
+  "Documented as original."
+  (let ((parsed (ange-ftp-ftp-name name)))
+    (if parsed
+	(let ((filename (nth 2 parsed)))
+	  (if (save-match-data
+		(string-match "^~[^/]*$" filename))
+	      ""
+	    (ange-ftp-real-file-name-nondirectory filename)))
+      (ange-ftp-real-file-name-nondirectory name))))
+
+(defun ange-ftp-directory-file-name (dir)
+  "Documented as original."
+  (let ((parsed (ange-ftp-ftp-name dir)))
+    (if parsed
+	(ange-ftp-replace-name-component
+	   dir
+	   (ange-ftp-real-directory-file-name (nth 2 parsed)))
+      (ange-ftp-real-directory-file-name dir))))
+
+
+;;; Hooks that handle Emacs primitives.
+
+;; Returns non-nil if should transfer FILE in binary mode.
+(defun ange-ftp-binary-file (file)
+  (save-match-data
+    (string-match ange-ftp-binary-file-name-regexp file)))
+
+(defun ange-ftp-write-region (start end filename &optional append visit)
+  (setq filename (expand-file-name filename))
+  (let ((parsed (ange-ftp-ftp-name filename)))
+    (if parsed
+	(let* ((host (nth 0 parsed))
+	       (user (nth 1 parsed))
+	       (name (ange-ftp-quote-string (nth 2 parsed)))
+	       (temp (ange-ftp-make-tmp-name host))
+	       ;; What we REALLY need here is a way to determine if the mode
+	       ;; of the transfer is irrelevant, i.e. we can use binary mode
+	       ;; regardless. Maybe a system-type to host-type lookup?
+	       (binary (or (ange-ftp-binary-file filename)
+			   (memq (ange-ftp-host-type host user)
+				 '(unix dumb-unix))))
+	       (cmd (if append 'append 'put))
+	       (abbr (ange-ftp-abbreviate-filename filename))
+	       ;; we need to reset `last-coding-system-used' to its
+	       ;; value immediately after calling the real write-region,
+	       ;; so that `basic-save-buffer' doesn't see whatever value
+	       ;; might be used when communicating with the ftp process.
+	       (coding-system-used last-coding-system-used))
+	  (unwind-protect
+	      (progn
+		(let ((executing-kbd-macro t)
+		      (filename (buffer-file-name))
+		      (mod-p (buffer-modified-p)))
+		  (unwind-protect
+		      (ange-ftp-real-write-region start end temp nil visit)
+		    ;; cleanup forms
+		    (setq buffer-file-name filename)
+		    (set-buffer-modified-p mod-p)))
+		;; save value used by the real write-region
+		(setq coding-system-used last-coding-system-used)
+		(if binary
+		    (ange-ftp-set-binary-mode host user))
+
+		;; tell the process filter what size the transfer will be.
+		(let ((attr (file-attributes temp)))
+		  (if attr
+		      (ange-ftp-set-xfer-size host user (nth 7 attr))))
+
+		;; put or append the file.
+		(let ((result (ange-ftp-send-cmd host user
+						 (list cmd temp name)
+						 (format "Writing %s" abbr))))
+		  (or (car result)
+		      (signal 'ftp-error
+			      (list
+			       "Opening output file"
+			       (format "FTP Error: \"%s\"" (cdr result))
+			       filename)))))
+	    (ange-ftp-del-tmp-name temp)
+	    (if binary 
+		(ange-ftp-set-ascii-mode host user)))
+	  (if (eq visit t)
+	      (progn
+		(set-visited-file-modtime '(0 0))
+		(ange-ftp-set-buffer-mode)
+		(setq buffer-file-name filename)
+		(set-buffer-modified-p nil)))
+	  ;; ensure `last-coding-system-used' has an appropriate value
+	  (setq last-coding-system-used coding-system-used)
+	  (ange-ftp-message "Wrote %s" abbr)
+	  (ange-ftp-add-file-entry filename))
+      (ange-ftp-real-write-region start end filename append visit))))
+
+(defun ange-ftp-insert-file-contents (filename &optional visit beg end replace)
+  (barf-if-buffer-read-only)
+  (setq filename (expand-file-name filename))
+  (let ((parsed (ange-ftp-ftp-name filename)))
+    (if parsed
+	(progn
+	  (if visit
+	      (setq buffer-file-name filename))
+	  (if (or (file-exists-p filename)
+		  (progn
+		    (setq ange-ftp-ls-cache-file nil)
+		    (ange-ftp-del-hash-entry (file-name-directory filename)
+					     ange-ftp-files-hashtable)
+		    (file-exists-p filename)))
+	      (let* ((host (nth 0 parsed))
+		     (user (nth 1 parsed))
+		     (name (ange-ftp-quote-string (nth 2 parsed)))
+		     (temp (ange-ftp-make-tmp-name host))
+		     (binary (or (ange-ftp-binary-file filename)
+				 (memq (ange-ftp-host-type host user)
+				       '(unix dumb-unix))))
+		     (abbr (ange-ftp-abbreviate-filename filename))
+		     (coding-system-used last-coding-system-used)
+		     size)
+		(unwind-protect
+		    (progn
+		      (if binary
+			  (ange-ftp-set-binary-mode host user))
+		      (let ((result (ange-ftp-send-cmd host user
+					      (list 'get name temp)
+					      (format "Retrieving %s" abbr))))
+			(or (car result)
+			    (signal 'ftp-error
+				    (list
+				     "Opening input file"
+				     (format "FTP Error: \"%s\"" (cdr result))
+				     filename))))
+		      (if (or (ange-ftp-real-file-readable-p temp)
+			      (sleep-for ange-ftp-retry-time)
+			      ;; Wait for file to hopefully appear.
+			      (ange-ftp-real-file-readable-p temp))
+			  (setq
+			   size
+			   (nth 1 (ange-ftp-real-insert-file-contents
+				   temp visit beg end replace))
+			   coding-system-used last-coding-system-used
+			   ;; override autodetection of buffer file type
+			   ;; to ensure buffer is saved in DOS format
+			   buffer-file-type binary)
+			(signal 'ftp-error
+				(list
+				 "Opening input file:"
+				 (format
+				  "FTP Error: %s not arrived or readable"
+				  filename)))))
+		  (if binary
+		      ;; We must keep `last-coding-system-used'
+		      ;; unchanged.
+		      (let (last-coding-system-used)
+			(ange-ftp-set-ascii-mode host user)))
+		  (ange-ftp-del-tmp-name temp))
+		(if visit
+		    (progn
+		      (set-visited-file-modtime '(0 0))
+		      (setq buffer-file-name filename)))
+		(setq last-coding-system-used coding-system-used)
+		(list filename size))
+	    (signal 'file-error
+		    (list 
+		     "Opening input file"
+		     filename))))
+      (ange-ftp-real-insert-file-contents filename visit beg end replace))))
+ 
+(defun ange-ftp-expand-symlink (file dir)
+  (if (file-name-absolute-p file)
+      (ange-ftp-replace-name-component dir file)
+    (expand-file-name file dir)))
+
+(defun ange-ftp-file-symlink-p (file)
+  ;; call ange-ftp-expand-file-name rather than the normal
+  ;; expand-file-name to stop loops when using a package that
+  ;; redefines both file-symlink-p and expand-file-name.
+  (setq file (ange-ftp-expand-file-name file))
+  (if (ange-ftp-ftp-name file)
+      (let ((file-ent
+	     (ange-ftp-get-hash-entry
+	      (ange-ftp-get-file-part file)
+	      (ange-ftp-get-files (file-name-directory file)))))
+	(if (stringp file-ent)
+	    (if (file-name-absolute-p file-ent)
+		(ange-ftp-replace-name-component
+		      (file-name-directory file) file-ent)
+	      file-ent)))
+    (ange-ftp-real-file-symlink-p file)))
+
+(defun ange-ftp-file-exists-p (name)
+  (setq name (expand-file-name name))
+  (if (ange-ftp-ftp-name name)
+      (if (ange-ftp-file-entry-p name)
+	  (let ((file-ent (ange-ftp-get-file-entry name)))
+	    (if (stringp file-ent)
+		(file-exists-p
+		 (ange-ftp-expand-symlink file-ent
+					  (file-name-directory
+					   (directory-file-name name))))
+	      t)))
+    (ange-ftp-real-file-exists-p name)))
+
+(defun ange-ftp-file-directory-p (name)
+  (setq name (expand-file-name name))
+  (if (ange-ftp-ftp-name name)
+      ;; We do a file-name-as-directory on name here because some
+      ;; machines (VMS) use a .DIR to indicate the filename associated
+      ;; with a directory. This needs to be canonicalized.
+      (let ((file-ent (ange-ftp-get-file-entry
+		       (ange-ftp-file-name-as-directory name))))
+	(if (stringp file-ent)
+	    (file-directory-p
+	     (ange-ftp-expand-symlink file-ent
+				      (file-name-directory
+				       (directory-file-name name))))
+	  file-ent))
+    (ange-ftp-real-file-directory-p name)))
+
+(defun ange-ftp-directory-files (directory &optional full match
+					   &rest v19-args)
+  (setq directory (expand-file-name directory))
+  (if (ange-ftp-ftp-name directory)
+      (progn
+	(ange-ftp-barf-if-not-directory directory)
+	(let ((tail (ange-ftp-hash-table-keys
+		     (ange-ftp-get-files directory)))
+	      files f)
+	  (setq directory (file-name-as-directory directory))
+	  (save-match-data
+	    (while tail
+	      (setq f (car tail)
+		    tail (cdr tail))
+	      (if (or (not match) (string-match match f))
+		  (setq files
+			(cons (if full (concat directory f) f) files)))))
+	  (nreverse files)))
+    (apply 'ange-ftp-real-directory-files directory full match v19-args)))
+
+(defun ange-ftp-file-attributes (file)
+  (setq file (expand-file-name file))
+  (let ((parsed (ange-ftp-ftp-name file)))
+    (if parsed
+	(let ((part (ange-ftp-get-file-part file))
+	      (files (ange-ftp-get-files (file-name-directory file))))
+	  (if (ange-ftp-hash-entry-exists-p part files)
+	      (let ((host (nth 0 parsed))
+		    (user (nth 1 parsed))
+		    (name (nth 2 parsed))
+		    (dirp (ange-ftp-get-hash-entry part files))
+		    (inode (ange-ftp-get-hash-entry
+			    file ange-ftp-inodes-hashtable)))
+		(unless inode
+		  (setq inode ange-ftp-next-inode-number
+			ange-ftp-next-inode-number (1+ inode))
+		  (ange-ftp-put-hash-entry file inode ange-ftp-inodes-hashtable))
+		(list (if (and (stringp dirp) (file-name-absolute-p dirp))
+			  (ange-ftp-expand-symlink dirp
+						   (file-name-directory file))
+			dirp)		;0 file type
+		      -1		;1 link count
+		      -1		;2 uid
+		      -1		;3 gid
+		      '(0 0)		;4 atime
+		      '(0 0)		;5 mtime
+		      '(0 0)		;6 ctime
+		      -1		;7 size
+		      (concat (if (stringp dirp) "l" (if dirp "d" "-"))
+			      "?????????") ;8 mode
+		      nil		;9 gid weird
+		      inode		;10 "inode number".
+		      -1		;11 device number [v19 only]
+		      ))))
+      (ange-ftp-real-file-attributes file))))
+
+(defun ange-ftp-file-writable-p (file)
+  (setq file (expand-file-name file))
+  (if (ange-ftp-ftp-name file)
+      (or (file-exists-p file)		;guess here for speed
+	  (file-directory-p (file-name-directory file)))
+    (ange-ftp-real-file-writable-p file)))
+
+(defun ange-ftp-file-readable-p (file)
+  (setq file (expand-file-name file))
+  (if (ange-ftp-ftp-name file)
+      (file-exists-p file)
+    (ange-ftp-real-file-readable-p file)))
+
+(defun ange-ftp-file-executable-p (file)
+  (setq file (expand-file-name file))
+  (if (ange-ftp-ftp-name file)
+      (file-exists-p file)
+    (ange-ftp-real-file-executable-p file)))
+
+(defun ange-ftp-delete-file (file)
+  (interactive "fDelete file: ")
+  (setq file (expand-file-name file))
+  (let ((parsed (ange-ftp-ftp-name file)))
+    (if parsed
+	(let* ((host (nth 0 parsed))
+	       (user (nth 1 parsed))
+	       (name (ange-ftp-quote-string (nth 2 parsed)))
+	       (abbr (ange-ftp-abbreviate-filename file))
+	       (result (ange-ftp-send-cmd host user
+					  (list 'delete name)
+					  (format "Deleting %s" abbr))))
+	  (or (car result)
+	      (signal 'ftp-error
+		      (list
+		       "Removing old name"
+		       (format "FTP Error: \"%s\"" (cdr result))
+		       file)))
+	  (ange-ftp-delete-file-entry file))
+      (ange-ftp-real-delete-file file))))
+
+(defun ange-ftp-verify-visited-file-modtime (buf)
+  (let ((name (buffer-file-name buf)))
+    (if (and (stringp name) (ange-ftp-ftp-name name))
+	t
+      (ange-ftp-real-verify-visited-file-modtime buf))))
+
+;;;; ------------------------------------------------------------
+;;;; File copying support... totally re-written 6/24/92.
+;;;; ------------------------------------------------------------
+
+(defun ange-ftp-barf-or-query-if-file-exists (absname querystring interactive)
+  (if (file-exists-p absname)
+      (if (not interactive)
+	  (signal 'file-already-exists (list absname))
+	(if (not (yes-or-no-p (format "File %s already exists; %s anyway? "
+				      absname querystring)))
+	    (signal 'file-already-exists (list absname))))))
+
+;; async local copy commented out for now since I don't seem to get
+;; the process sentinel called for some processes.
+;;
+;; (defun ange-ftp-copy-file-locally (filename newname ok-if-already-exists
+;; 					    keep-date cont)
+;;   "Kludge to copy a local file and call a continuation when the copy
+;; finishes."
+;;   ;; check to see if we can overwrite
+;;   (if (or (not ok-if-already-exists)
+;; 	  (numberp ok-if-already-exists))
+;;       (ange-ftp-barf-or-query-if-file-exists newname "copy to it" 
+;; 					     (numberp ok-if-already-exists)))
+;;   (let ((proc (start-process " *copy*"
+;; 			     (generate-new-buffer "*copy*")
+;; 			     "cp"
+;; 			     filename
+;; 			     newname))
+;; 	res)
+;;     (set-process-sentinel proc (function ange-ftp-copy-file-locally-sentinel))
+;;     (process-kill-without-query proc)
+;;     (save-excursion
+;;       (set-buffer (process-buffer proc))
+;;       (make-variable-buffer-local 'copy-cont)
+;;       (setq copy-cont cont))))
+;; 
+;; (defun ange-ftp-copy-file-locally-sentinel (proc status)
+;;   (save-excursion
+;;     (set-buffer (process-buffer proc))
+;;     (let ((cont copy-cont)
+;; 	  (result (buffer-string)))
+;;       (unwind-protect
+;; 	  (if (and (string-equal status "finished\n")
+;; 		   (zerop (length result)))
+;; 	      (ange-ftp-call-cont cont t nil)
+;; 	    (ange-ftp-call-cont cont
+;; 				nil
+;; 				(if (zerop (length result))
+;; 				    (substring status 0 -1)
+;; 				  (substring result 0 -1))))
+;; 	(kill-buffer (current-buffer))))))
+
+;; this is the extended version of ange-ftp-copy-file-internal that works
+;; asynchronously if asked nicely.
+(defun ange-ftp-copy-file-internal (filename newname ok-if-already-exists
+					     keep-date &optional msg cont nowait)
+  (setq filename (expand-file-name filename)
+	newname (expand-file-name newname))
+
+  ;; canonicalize newname if a directory.
+  (if (file-directory-p newname)
+      (setq newname (expand-file-name (file-name-nondirectory filename) newname)))
+
+  (let ((f-parsed (ange-ftp-ftp-name filename))
+	(t-parsed (ange-ftp-ftp-name newname)))
+
+    ;; local file to local file copy?
+    (if (and (not f-parsed) (not t-parsed))
+	(progn
+	  (ange-ftp-real-copy-file filename newname ok-if-already-exists
+				   keep-date)
+	  (if cont
+	      (ange-ftp-call-cont cont t "Copied locally")))
+      ;; one or both files are remote.
+      (let* ((f-host (and f-parsed (nth 0 f-parsed)))
+	     (f-user (and f-parsed (nth 1 f-parsed)))
+	     (f-name (and f-parsed (ange-ftp-quote-string (nth 2 f-parsed))))
+	     (f-abbr (ange-ftp-abbreviate-filename filename))
+	     (t-host (and t-parsed (nth 0 t-parsed)))
+	     (t-user (and t-parsed (nth 1 t-parsed)))
+	     (t-name (and t-parsed (ange-ftp-quote-string (nth 2 t-parsed))))
+	     (t-abbr (ange-ftp-abbreviate-filename newname filename))
+	     (binary (or (ange-ftp-binary-file filename)
+			 (ange-ftp-binary-file newname)
+			 (and (memq (ange-ftp-host-type f-host f-user)
+				    '(unix dumb-unix))
+			      (memq (ange-ftp-host-type t-host t-user)
+				    '(unix dumb-unix)))))
+	     temp1
+	     temp2)
+
+	;; check to see if we can overwrite
+	(if (or (not ok-if-already-exists)
+		(numberp ok-if-already-exists))
+	    (ange-ftp-barf-or-query-if-file-exists newname "copy to it" 
+						   (numberp ok-if-already-exists)))
+
+	;; do the copying.
+	(if f-parsed
+	    
+	    ;; filename was remote.
+	    (progn
+	      (if (or (ange-ftp-use-gateway-p f-host)
+		      t-parsed)
+		  ;; have to use intermediate file if we are getting via
+		  ;; gateway machine or we are doing a remote to remote copy.
+		  (setq temp1 (ange-ftp-make-tmp-name f-host)))
+	      
+	      (if binary
+		  (ange-ftp-set-binary-mode f-host f-user))
+
+	      (ange-ftp-send-cmd
+	       f-host
+	       f-user
+	       (list 'get f-name (or temp1 (ange-ftp-quote-string newname)))
+	       (or msg
+		   (if (and temp1 t-parsed)
+		       (format "Getting %s" f-abbr)
+		     (format "Copying %s to %s" f-abbr t-abbr)))
+	       (list (function ange-ftp-cf1)
+		     filename newname binary msg
+		     f-parsed f-host f-user f-name f-abbr
+		     t-parsed t-host t-user t-name t-abbr
+		     temp1 temp2 cont nowait)
+	       nowait))
+
+	  ;; filename wasn't remote.  newname must be remote.  call the
+	  ;; function which does the remainder of the copying work.
+	  (ange-ftp-cf1 t nil
+			filename newname binary msg
+			f-parsed f-host f-user f-name f-abbr
+			t-parsed t-host t-user t-name t-abbr
+			nil nil cont nowait))))))
+
+(defvar ange-ftp-waiting-flag nil)
+
+;; next part of copying routine.
+(defun ange-ftp-cf1 (result line
+			    filename newname binary msg
+			    f-parsed f-host f-user f-name f-abbr
+			    t-parsed t-host t-user t-name t-abbr
+			    temp1 temp2 cont nowait)
+  (if line
+      ;; filename must have been remote, and we must have just done a GET.
+      (unwind-protect
+	  (or result
+	      ;; GET failed for some reason.  Clean up and get out.
+	      (progn
+		(and temp1 (ange-ftp-del-tmp-name temp1))
+		(or cont
+		    (if ange-ftp-waiting-flag
+			(throw 'ftp-error t)
+		      (signal 'ftp-error
+			      (list "Opening input file"
+				    (format "FTP Error: \"%s\"" line)
+				    filename))))))
+	;; cleanup
+	(if binary
+	    (ange-ftp-set-ascii-mode f-host f-user))))
+
+  (if result
+      ;; We now have to copy either temp1 or filename to newname.
+      (if t-parsed
+      
+	  ;; newname was remote.
+	  (progn
+	    (if (ange-ftp-use-gateway-p t-host)
+		(setq temp2 (ange-ftp-make-tmp-name t-host)))
+	    
+	    ;; make sure data is moved into the right place for the
+	    ;; outgoing transfer.  gateway temporary files complicate
+	    ;; things nicely.
+	    (if temp1
+		(if temp2
+		    (if (string-equal temp1 temp2)
+			(setq temp1 nil)
+		      (ange-ftp-real-copy-file temp1 temp2 t))
+		  (setq temp2 temp1 temp1 nil))
+	      (if temp2
+		  (ange-ftp-real-copy-file filename temp2 t)))
+	    
+	    (if binary
+		(ange-ftp-set-binary-mode t-host t-user))
+
+	    ;; tell the process filter what size the file is.
+	    (let ((attr (file-attributes (or temp2 filename))))
+	      (if attr
+		  (ange-ftp-set-xfer-size t-host t-user (nth 7 attr))))
+
+	    (ange-ftp-send-cmd
+	     t-host
+	     t-user
+	     (list 'put (or temp2 filename) t-name)
+	     (or msg
+		 (if (and temp2 f-parsed)
+		     (format "Putting %s" newname)
+		   (format "Copying %s to %s" f-abbr t-abbr)))
+	     (list (function ange-ftp-cf2)
+		   newname t-host t-user binary temp1 temp2 cont)
+	     nowait))
+    
+	;; newname wasn't remote.
+	(ange-ftp-cf2 t nil newname t-host t-user binary temp1 temp2 cont))
+
+    ;; first copy failed, tell caller
+    (ange-ftp-call-cont cont result line)))
+
+;; last part of copying routine.
+(defun ange-ftp-cf2 (result line newname t-host t-user binary temp1 temp2 cont)
+  (unwind-protect
+      (if line
+	  ;; result from doing a local to remote copy.
+	  (unwind-protect
+	      (progn
+		(or result
+		    (or cont
+			(if ange-ftp-waiting-flag
+			    (throw 'ftp-error t)
+			  (signal 'ftp-error
+				  (list "Opening output file"
+					(format "FTP Error: \"%s\"" line)
+					newname)))))
+		
+		(ange-ftp-add-file-entry newname))
+	    
+	    ;; cleanup.
+	    (if binary
+		(ange-ftp-set-ascii-mode t-host t-user)))
+	      
+	;; newname was local.
+	(if temp1
+	    (ange-ftp-real-copy-file temp1 newname t)))
+	  
+    ;; clean up
+    (and temp1 (ange-ftp-del-tmp-name temp1))
+    (and temp2 (ange-ftp-del-tmp-name temp2))
+    (ange-ftp-call-cont cont result line)))
+
+(defun ange-ftp-copy-file (filename newname &optional ok-if-already-exists
+				    keep-date)
+  (interactive "fCopy file: \nFCopy %s to file: \np")
+  (ange-ftp-copy-file-internal filename
+			       newname
+			       ok-if-already-exists
+			       keep-date
+			       nil
+			       nil
+			       (interactive-p)))
+
+;;;; ------------------------------------------------------------
+;;;; File renaming support.
+;;;; ------------------------------------------------------------
+
+(defun ange-ftp-rename-remote-to-remote (filename newname f-parsed t-parsed)
+  "Rename remote file FILE to remote file NEWNAME."
+  (let ((f-host (nth 0 f-parsed))
+	(f-user (nth 1 f-parsed))
+	(t-host (nth 0 t-parsed))
+	(t-user (nth 1 t-parsed)))
+    (if (and (string-equal f-host t-host)
+	     (string-equal f-user t-user))
+	(let* ((f-name (ange-ftp-quote-string (nth 2 f-parsed)))
+	       (t-name (ange-ftp-quote-string (nth 2 t-parsed)))
+	       (cmd (list 'rename f-name t-name))
+	       (fabbr (ange-ftp-abbreviate-filename filename))
+	       (nabbr (ange-ftp-abbreviate-filename newname filename))
+	       (result (ange-ftp-send-cmd f-host f-user cmd
+					  (format "Renaming %s to %s"
+						  fabbr
+						  nabbr))))
+	  (or (car result)
+	      (signal 'ftp-error
+		      (list
+		       "Renaming"
+		       (format "FTP Error: \"%s\"" (cdr result))
+		       filename
+		       newname)))
+	  (ange-ftp-add-file-entry newname)
+	  (ange-ftp-delete-file-entry filename))
+      (ange-ftp-copy-file-internal filename newname t nil)
+      (delete-file filename))))
+
+(defun ange-ftp-rename-local-to-remote (filename newname)
+  "Rename local FILENAME to remote file NEWNAME."
+  (let* ((fabbr (ange-ftp-abbreviate-filename filename))
+	 (nabbr (ange-ftp-abbreviate-filename newname filename))
+	 (msg (format "Renaming %s to %s" fabbr nabbr)))
+    (ange-ftp-copy-file-internal filename newname t nil msg)
+    (let (ange-ftp-process-verbose)
+      (delete-file filename))))
+
+(defun ange-ftp-rename-remote-to-local (filename newname)
+  "Rename remote file FILENAME to local file NEWNAME."
+  (let* ((fabbr (ange-ftp-abbreviate-filename filename))
+	 (nabbr (ange-ftp-abbreviate-filename newname filename))
+	 (msg (format "Renaming %s to %s" fabbr nabbr)))
+    (ange-ftp-copy-file-internal filename newname t nil msg)
+    (let (ange-ftp-process-verbose)
+      (delete-file filename))))
+
+(defun ange-ftp-rename-file (filename newname &optional ok-if-already-exists)
+  (interactive "fRename file: \nFRename %s to file: \np")
+  (setq filename (expand-file-name filename))
+  (setq newname (expand-file-name newname))
+  (let* ((f-parsed (ange-ftp-ftp-name filename))
+	 (t-parsed (ange-ftp-ftp-name newname)))
+    (if (and (or f-parsed t-parsed)
+	     (or (not ok-if-already-exists)
+		 (numberp ok-if-already-exists)))
+	(ange-ftp-barf-or-query-if-file-exists
+	 newname
+	 "rename to it"
+	 (numberp ok-if-already-exists)))
+    (if f-parsed
+	(if t-parsed
+	    (ange-ftp-rename-remote-to-remote filename newname f-parsed
+					      t-parsed)
+	  (ange-ftp-rename-remote-to-local filename newname))
+      (if t-parsed
+	  (ange-ftp-rename-local-to-remote filename newname)
+	(ange-ftp-real-rename-file filename newname ok-if-already-exists)))))
+
+;;;; ------------------------------------------------------------
+;;;; File name completion support.
+;;;; ------------------------------------------------------------
+
+;; If the file entry SYM is a symlink, returns whether its file exists.
+;; Note that `ange-ftp-this-dir' is used as a free variable.
+(defun ange-ftp-file-entry-active-p (sym)
+  (let ((val (get sym 'val)))
+    (or (not (stringp val))
+	(file-exists-p (ange-ftp-expand-symlink val ange-ftp-this-dir)))))
+
+;; If the file entry is not a directory (nor a symlink pointing to a directory)
+;; returns whether the file (or file pointed to by the symlink) is ignored
+;; by completion-ignored-extensions.
+;; Note that `ange-ftp-this-dir' and `ange-ftp-completion-ignored-pattern'
+;; are used as free variables.
+(defun ange-ftp-file-entry-not-ignored-p (sym)
+  (let ((val (get sym 'val))
+	(symname (symbol-name sym)))
+    (if (stringp val)
+	(let ((file (ange-ftp-expand-symlink val ange-ftp-this-dir)))
+	  (or (file-directory-p file)
+	      (and (file-exists-p file)
+		   (not (string-match ange-ftp-completion-ignored-pattern
+				      symname)))))
+      (or val ; is a directory name
+	  (not (string-match ange-ftp-completion-ignored-pattern symname))))))
+
+(defun ange-ftp-file-name-all-completions (file dir)
+  (let ((ange-ftp-this-dir (expand-file-name dir)))
+    (if (ange-ftp-ftp-name ange-ftp-this-dir)
+	(progn
+	  (ange-ftp-barf-if-not-directory ange-ftp-this-dir)
+	  (setq ange-ftp-this-dir
+		(ange-ftp-real-file-name-as-directory ange-ftp-this-dir))
+	  (let* ((tbl (ange-ftp-get-files ange-ftp-this-dir))
+		 (completions
+		  (all-completions file tbl
+				   (function ange-ftp-file-entry-active-p))))
+
+	    ;; see whether each matching file is a directory or not...
+	    (mapcar
+	     (function
+	      (lambda (file)
+		(let ((ent (ange-ftp-get-hash-entry file tbl)))
+		  (if (and ent
+			   (or (not (stringp ent))
+			       (file-directory-p
+				(ange-ftp-expand-symlink ent
+							 ange-ftp-this-dir))))
+		      (concat file "/")
+		    file))))
+	     completions)))
+
+      (if (or (and (eq system-type 'windows-nt)
+		   (string-match "^[a-zA-Z]:[/\\]$" ange-ftp-this-dir))
+	      (string-equal "/" ange-ftp-this-dir))
+	  (nconc (all-completions file (ange-ftp-generate-root-prefixes))
+		 (ange-ftp-real-file-name-all-completions file
+							  ange-ftp-this-dir))
+	(ange-ftp-real-file-name-all-completions file ange-ftp-this-dir)))))
+
+(defun ange-ftp-file-name-completion (file dir)
+  (let ((ange-ftp-this-dir (expand-file-name dir)))
+    (if (ange-ftp-ftp-name ange-ftp-this-dir)
+	(progn
+	  (ange-ftp-barf-if-not-directory ange-ftp-this-dir)
+	  (if (equal file "")
+	      ""
+	    (setq ange-ftp-this-dir
+		  (ange-ftp-real-file-name-as-directory ange-ftp-this-dir))	;real?
+	    (let* ((tbl (ange-ftp-get-files ange-ftp-this-dir))
+		   (ange-ftp-completion-ignored-pattern
+		    (mapconcat (function
+				(lambda (s) (if (stringp s)
+						(concat (regexp-quote s) "$")
+					      "/"))) ; / never in filename
+			       completion-ignored-extensions
+			       "\\|")))
+	      (save-match-data
+		(or (ange-ftp-file-name-completion-1
+		     file tbl ange-ftp-this-dir
+		     (function ange-ftp-file-entry-not-ignored-p))
+		    (ange-ftp-file-name-completion-1
+		     file tbl ange-ftp-this-dir
+		     (function ange-ftp-file-entry-active-p)))))))
+
+      (if (or (and (eq system-type 'windows-nt)
+		   (string-match "^[a-zA-Z]:[/\\]$" ange-ftp-this-dir))
+	      (string-equal "/" ange-ftp-this-dir))
+	  (try-completion
+	   file
+	   (nconc (ange-ftp-generate-root-prefixes)
+		  (mapcar 'list
+			  (ange-ftp-real-file-name-all-completions
+			   file ange-ftp-this-dir))))
+	(ange-ftp-real-file-name-completion file ange-ftp-this-dir)))))
+
+
+(defun ange-ftp-file-name-completion-1 (file tbl dir predicate)
+  (let ((bestmatch (try-completion file tbl predicate)))
+    (if bestmatch
+	(if (eq bestmatch t)
+	    (if (file-directory-p (expand-file-name file dir))
+		(concat file "/")
+	      t)
+	  (if (and (eq (try-completion bestmatch tbl predicate) t)
+		   (file-directory-p
+		    (expand-file-name bestmatch dir)))
+	      (concat bestmatch "/")
+	    bestmatch)))))
+
+;; Put these lines uncommmented in your .emacs if you want C-r to refresh
+;; ange-ftp's cache whilst doing filename completion.
+;;
+;;(define-key minibuffer-local-completion-map "\C-r" 'ange-ftp-re-read-dir)
+;;(define-key minibuffer-local-must-match-map "\C-r" 'ange-ftp-re-read-dir)
+
+;; The autoload cookie is to make sure the doc is always available.
+;;;###autoload (defalias 'ange-ftp-re-read-dir 'ange-ftp-reread-dir)
+;;;###autoload
+(defun ange-ftp-reread-dir (&optional dir)
+  "Reread remote directory DIR to update the directory cache.
+The implementation of remote ftp file names caches directory contents
+for speed.  Therefore, when new remote files are created, Emacs
+may not know they exist.  You can use this command to reread a specific
+directory, so that Emacs will know its current contents."
+  (interactive)
+  (if dir
+      (setq dir (expand-file-name dir))
+    (setq dir (file-name-directory (expand-file-name (buffer-string)))))
+  (if (ange-ftp-ftp-name dir)
+      (progn
+	(setq ange-ftp-ls-cache-file nil)
+	(ange-ftp-del-hash-entry dir ange-ftp-files-hashtable)
+	(ange-ftp-get-files dir t))))
+
+(defun ange-ftp-make-directory (dir &optional parents)
+  (interactive (list (expand-file-name (read-file-name "Make directory: "))))
+  (if parents
+      (let ((parent (file-name-directory (directory-file-name dir))))
+	(or (file-exists-p parent)
+	    (ange-ftp-make-directory parent parents))))
+  (if (file-exists-p dir)
+      (error "Cannot make directory %s: file already exists" dir)
+    (let ((parsed (ange-ftp-ftp-name dir)))
+      (if parsed
+	  (let* ((host (nth 0 parsed))
+		 (user (nth 1 parsed))
+		 ;; Some ftp's on unix machines (at least on Suns)
+		 ;; insist that mkdir take a filename, and not a
+		 ;; directory-name name as an arg. Argh!! This is a bug.
+		 ;; Non-unix machines will probably always insist
+		 ;; that mkdir takes a directory-name as an arg
+		 ;; (as the ftp man page says it should).
+		 (name (ange-ftp-quote-string
+			(if (eq (ange-ftp-host-type host) 'unix)
+			    (ange-ftp-real-directory-file-name (nth 2 parsed))
+			  (ange-ftp-real-file-name-as-directory
+			   (nth 2 parsed)))))
+		 (abbr (ange-ftp-abbreviate-filename dir))
+		 (result (ange-ftp-send-cmd host user
+					    (list 'mkdir name)
+					    (format "Making directory %s"
+						    abbr))))
+	    (or (car result)
+		(ange-ftp-error host user
+				(format "Could not make directory %s: %s"
+					dir
+					(cdr result))))
+	    (ange-ftp-add-file-entry dir t))
+	(ange-ftp-real-make-directory dir)))))
+
+(defun ange-ftp-delete-directory (dir)
+  (if (file-directory-p dir)
+      (let ((parsed (ange-ftp-ftp-name dir)))
+	(if parsed
+	    (let* ((host (nth 0 parsed))
+		   (user (nth 1 parsed))
+		   ;; Some ftp's on unix machines (at least on Suns)
+		   ;; insist that rmdir take a filename, and not a
+		   ;; directory-name name as an arg. Argh!! This is a bug.
+		   ;; Non-unix machines will probably always insist
+		   ;; that rmdir takes a directory-name as an arg
+		   ;; (as the ftp man page says it should).
+		   (name (ange-ftp-quote-string
+			  (if (eq (ange-ftp-host-type host) 'unix)
+			      (ange-ftp-real-directory-file-name
+			       (nth 2 parsed))
+			    (ange-ftp-real-file-name-as-directory
+			     (nth 2 parsed)))))
+		  (abbr (ange-ftp-abbreviate-filename dir))
+		  (result (ange-ftp-send-cmd host user
+					     (list 'rmdir name)
+					     (format "Removing directory %s"
+						     abbr))))
+	      (or (car result)
+		  (ange-ftp-error host user
+				  (format "Could not remove directory %s: %s"
+					  dir
+					  (cdr result))))
+	      (ange-ftp-delete-file-entry dir t))
+	  (ange-ftp-real-delete-directory dir)))
+    (error "Not a directory: %s" dir)))
+
+;; Make a local copy of FILE and return its name.
+
+(defun ange-ftp-file-local-copy (file)
+  (let* ((fn1 (expand-file-name file))
+	 (pa1 (ange-ftp-ftp-name fn1)))
+    (if pa1
+	(let ((tmp1 (ange-ftp-make-tmp-name (car pa1))))
+	  (ange-ftp-copy-file-internal fn1 tmp1 t nil
+				       (format "Getting %s" fn1))
+	  tmp1))))
+
+(defun ange-ftp-load (file &optional noerror nomessage nosuffix)
+  (if (ange-ftp-ftp-name file)
+      (let ((tryfiles (if nosuffix
+			  (list file)
+			(list (concat file ".elc") (concat file ".el") file)))
+	    ;; make sure there are no references to temp files
+	    (load-force-doc-strings t)
+	    copy)
+	(while (and tryfiles (not copy))
+	  (catch 'ftp-error
+	    (let ((ange-ftp-waiting-flag t))
+	      (condition-case error
+		  (setq copy (ange-ftp-file-local-copy (car tryfiles)))
+		(ftp-error nil))))
+	  (setq tryfiles (cdr tryfiles)))
+	(if copy
+	    (unwind-protect
+		(funcall 'load copy noerror nomessage nosuffix)
+	      (delete-file copy))
+	  (or noerror
+	      (signal 'file-error (list "Cannot open load file" file)))
+	  nil))
+    (ange-ftp-real-load file noerror nomessage nosuffix)))
+
+;; Calculate default-unhandled-directory for a given ange-ftp buffer.
+(defun ange-ftp-unhandled-file-name-directory (filename)
+  (file-name-directory ange-ftp-tmp-name-template))
+
+
+;; Need the following functions for making filenames of compressed
+;; files, because some OS's (unlike UNIX) do not allow a filename to
+;; have two extensions.
+
+(defvar ange-ftp-make-compressed-filename-alist nil
+  "Alist of host-type-specific functions to process file names for compression.
+Each element has the form (TYPE . FUNC).
+FUNC should take one argument, a file name, and return a list
+of the form (COMPRESSING NEWNAME).
+COMPRESSING should be t if the specified file should be compressed, 
+and nil if it should be uncompressed (that is, if it is a compressed file).
+NEWNAME should be the name to give the new compressed or uncompressed file.")
+
+(defun ange-ftp-dired-compress-file (name)
+  (let ((parsed (ange-ftp-ftp-name name))
+	conversion-func)
+    (if (and parsed
+	     (setq conversion-func
+		   (cdr (assq (ange-ftp-host-type (car parsed))
+			      ange-ftp-make-compressed-filename-alist))))
+	(let* ((decision
+		(save-match-data (funcall conversion-func name)))
+	       (compressing (car decision))
+	       (newfile (nth 1 decision)))
+	  (if compressing
+	      (ange-ftp-compress name newfile)
+	    (ange-ftp-uncompress name newfile)))
+      (let (file-name-handler-alist)
+	(dired-compress-file name)))))
+
+;; Copy FILE to this machine, compress it, and copy out to NFILE.
+(defun ange-ftp-compress (file nfile)
+  (let* ((parsed (ange-ftp-ftp-name file))
+	 (tmp1 (ange-ftp-make-tmp-name (car parsed)))
+	 (tmp2 (ange-ftp-make-tmp-name (car parsed)))
+	 (abbr (ange-ftp-abbreviate-filename file))
+	 (nabbr (ange-ftp-abbreviate-filename nfile))
+	 (msg1 (format "Getting %s" abbr))
+	 (msg2 (format "Putting %s" nabbr)))
+    (unwind-protect
+	(progn
+	  (ange-ftp-copy-file-internal file tmp1 t nil msg1)
+	  (and ange-ftp-process-verbose
+	       (ange-ftp-message "Compressing %s..." abbr))
+	  (call-process-region (point)
+			       (point)
+			       shell-file-name
+			       nil
+			       t
+			       nil
+			       "-c"
+			       (format "compress -f -c < %s > %s" tmp1 tmp2))
+	  (and ange-ftp-process-verbose
+	       (ange-ftp-message "Compressing %s...done" abbr))
+	  (if (zerop (buffer-size))
+	      (progn
+		(let (ange-ftp-process-verbose)
+		  (delete-file file))
+		(ange-ftp-copy-file-internal tmp2 nfile t nil msg2))))
+      (ange-ftp-del-tmp-name tmp1)
+      (ange-ftp-del-tmp-name tmp2))))
+    
+;; Copy FILE to this machine, uncompress it, and copy out to NFILE.
+(defun ange-ftp-uncompress (file nfile)
+  (let* ((parsed (ange-ftp-ftp-name file))
+	 (tmp1 (ange-ftp-make-tmp-name (car parsed)))
+	 (tmp2 (ange-ftp-make-tmp-name (car parsed)))
+	 (abbr (ange-ftp-abbreviate-filename file))
+	 (nabbr (ange-ftp-abbreviate-filename nfile))
+	 (msg1 (format "Getting %s" abbr))
+	 (msg2 (format "Putting %s" nabbr))
+;;	 ;; Cheap hack because of problems with binary file transfers from
+;;	 ;; VMS hosts.
+;;	 (gbinary (not (eq 'vms (ange-ftp-host-type (car parsed)))))
+	 )
+    (unwind-protect
+	(progn
+	  (ange-ftp-copy-file-internal file tmp1 t nil msg1)
+	  (and ange-ftp-process-verbose
+	       (ange-ftp-message "Uncompressing %s..." abbr))
+	  (call-process-region (point)
+			       (point)
+			       shell-file-name
+			       nil
+			       t
+			       nil
+			       "-c"
+			       (format "uncompress -c < %s > %s" tmp1 tmp2))
+	  (and ange-ftp-process-verbose
+	       (ange-ftp-message "Uncompressing %s...done" abbr))
+	  (if (zerop (buffer-size))
+	      (progn
+		(let (ange-ftp-process-verbose)
+		  (delete-file file))
+		(ange-ftp-copy-file-internal tmp2 nfile t nil msg2))))
+      (ange-ftp-del-tmp-name tmp1)
+      (ange-ftp-del-tmp-name tmp2))))
+
+(defun ange-ftp-find-backup-file-name (fn)
+  ;; Either return the ordinary backup name, etc.,
+  ;; or return nil meaning don't make a backup.
+  (if ange-ftp-make-backup-files
+      (ange-ftp-real-find-backup-file-name fn)))
+
+;;; Define the handler for special file names
+;;; that causes ange-ftp to be invoked.
+
+;;;###autoload
+(defun ange-ftp-hook-function (operation &rest args)
+  (let ((fn (get operation 'ange-ftp)))
+    (if fn (apply fn args)
+      (ange-ftp-run-real-handler operation args))))
+
+
+;;; This regexp takes care of real ange-ftp file names (with a slash
+;;; and colon).
+;;; Don't allow the host name to end in a period--some systems use /.:
+;;;###autoload
+(or (assoc "^/[^/:]*[^/:.]:" file-name-handler-alist)
+    (setq file-name-handler-alist
+	  (cons '("^/[^/:]*[^/:.]:" . ange-ftp-hook-function)
+		file-name-handler-alist)))
+
+;;; This regexp recognizes absolute filenames with only one component,
+;;; for the sake of hostname completion.
+;;;###autoload
+(or (assoc "^/[^/:]*\\'" file-name-handler-alist)
+    (setq file-name-handler-alist
+	  (cons '("^/[^/:]*\\'" . ange-ftp-completion-hook-function)
+		file-name-handler-alist)))
+
+;;; This regexp recognizes absolute filenames with only one component
+;;; on Windows, for the sake of hostname completion.
+;;; NB. Do not mark this as autoload, because it is very common to
+;;; do completions in the root directory of drives on Windows.
+(and (memq system-type '(ms-dos windows-nt))
+     (or (assoc "^[a-zA-Z]:/[^/:]*\\'" file-name-handler-alist)
+	 (setq file-name-handler-alist
+	       (cons '("^[a-zA-Z]:/[^/:]*\\'" . 
+		       ange-ftp-completion-hook-function)
+		     file-name-handler-alist))))
+
+;;; The above two forms are sufficient to cause this file to be loaded
+;;; if the user ever uses a file name with a colon in it.
+
+;;; This sets the mode 
+(or (memq 'ange-ftp-set-buffer-mode find-file-hooks)
+    (setq find-file-hooks
+	  (cons 'ange-ftp-set-buffer-mode find-file-hooks)))
+
+;;; Now say where to find the handlers for particular operations.
+
+(put 'file-name-directory 'ange-ftp 'ange-ftp-file-name-directory)
+(put 'file-name-nondirectory 'ange-ftp 'ange-ftp-file-name-nondirectory)
+(put 'file-name-as-directory 'ange-ftp 'ange-ftp-file-name-as-directory)
+(put 'directory-file-name 'ange-ftp 'ange-ftp-directory-file-name)
+(put 'expand-file-name 'ange-ftp 'ange-ftp-expand-file-name)
+(put 'make-directory 'ange-ftp 'ange-ftp-make-directory)
+(put 'delete-directory 'ange-ftp 'ange-ftp-delete-directory)
+(put 'insert-file-contents 'ange-ftp 'ange-ftp-insert-file-contents)
+(put 'directory-files 'ange-ftp 'ange-ftp-directory-files)
+(put 'file-directory-p 'ange-ftp 'ange-ftp-file-directory-p)
+(put 'file-writable-p 'ange-ftp 'ange-ftp-file-writable-p)
+(put 'file-readable-p 'ange-ftp 'ange-ftp-file-readable-p)
+(put 'file-executable-p 'ange-ftp 'ange-ftp-file-executable-p)
+(put 'file-symlink-p 'ange-ftp 'ange-ftp-file-symlink-p)
+(put 'delete-file 'ange-ftp 'ange-ftp-delete-file)
+(put 'read-file-name-internal 'ange-ftp 'ange-ftp-read-file-name-internal)
+(put 'verify-visited-file-modtime 'ange-ftp
+     'ange-ftp-verify-visited-file-modtime)
+(put 'file-exists-p 'ange-ftp 'ange-ftp-file-exists-p)
+(put 'write-region 'ange-ftp 'ange-ftp-write-region)
+(put 'backup-buffer 'ange-ftp 'ange-ftp-backup-buffer)
+(put 'copy-file 'ange-ftp 'ange-ftp-copy-file)
+(put 'rename-file 'ange-ftp 'ange-ftp-rename-file)
+(put 'file-attributes 'ange-ftp 'ange-ftp-file-attributes)
+(put 'file-name-all-completions 'ange-ftp 'ange-ftp-file-name-all-completions)
+(put 'file-name-completion 'ange-ftp 'ange-ftp-file-name-completion)
+(put 'insert-directory 'ange-ftp 'ange-ftp-insert-directory)
+(put 'file-local-copy 'ange-ftp 'ange-ftp-file-local-copy)
+(put 'unhandled-file-name-directory 'ange-ftp
+     'ange-ftp-unhandled-file-name-directory)
+(put 'file-name-sans-versions 'ange-ftp 'ange-ftp-file-name-sans-versions)
+(put 'dired-uncache 'ange-ftp 'ange-ftp-dired-uncache)
+(put 'dired-compress-file 'ange-ftp 'ange-ftp-dired-compress-file)
+(put 'load 'ange-ftp 'ange-ftp-load)
+(put 'find-backup-file-name 'ange-ftp 'ange-ftp-find-backup-file-name)
+
+;; Turn off truename processing to save time.
+;; Treat each name as its own truename.
+(put 'file-truename 'ange-ftp 'identity)
+
+;; Turn off RCS/SCCS processing to save time.
+;; This returns nil for any file name as argument.
+(put 'vc-registered 'ange-ftp 'null)
+
+(put 'dired-call-process 'ange-ftp 'ange-ftp-dired-call-process)
+(put 'shell-command 'ange-ftp 'ange-ftp-shell-command)
+
+;;; Define ways of getting at unmodified Emacs primitives,
+;;; turning off our handler.
+
+(defun ange-ftp-run-real-handler (operation args)
+  (let ((inhibit-file-name-handlers
+	 (cons 'ange-ftp-hook-function
+	       (cons 'ange-ftp-completion-hook-function
+		     (and (eq inhibit-file-name-operation operation)
+			  inhibit-file-name-handlers))))
+	(inhibit-file-name-operation operation))
+    (apply operation args)))
+
+(defun ange-ftp-real-file-name-directory (&rest args)
+  (ange-ftp-run-real-handler 'file-name-directory args))
+(defun ange-ftp-real-file-name-nondirectory (&rest args)
+  (ange-ftp-run-real-handler 'file-name-nondirectory args))
+(defun ange-ftp-real-file-name-as-directory (&rest args)
+  (ange-ftp-run-real-handler 'file-name-as-directory args))
+(defun ange-ftp-real-directory-file-name (&rest args)
+  (ange-ftp-run-real-handler 'directory-file-name args))
+(defun ange-ftp-real-expand-file-name (&rest args)
+  (ange-ftp-run-real-handler 'expand-file-name args))
+(defun ange-ftp-real-make-directory (&rest args)
+  (ange-ftp-run-real-handler 'make-directory args))
+(defun ange-ftp-real-delete-directory (&rest args)
+  (ange-ftp-run-real-handler 'delete-directory args))
+(defun ange-ftp-real-insert-file-contents (&rest args)
+  (ange-ftp-run-real-handler 'insert-file-contents args))
+(defun ange-ftp-real-directory-files (&rest args)
+  (ange-ftp-run-real-handler 'directory-files args))
+(defun ange-ftp-real-file-directory-p (&rest args)
+  (ange-ftp-run-real-handler 'file-directory-p args))
+(defun ange-ftp-real-file-writable-p (&rest args)
+  (ange-ftp-run-real-handler 'file-writable-p args))
+(defun ange-ftp-real-file-readable-p (&rest args)
+  (ange-ftp-run-real-handler 'file-readable-p args))
+(defun ange-ftp-real-file-executable-p (&rest args)
+  (ange-ftp-run-real-handler 'file-executable-p args))
+(defun ange-ftp-real-file-symlink-p (&rest args)
+  (ange-ftp-run-real-handler 'file-symlink-p args))
+(defun ange-ftp-real-delete-file (&rest args)
+  (ange-ftp-run-real-handler 'delete-file args))
+(defun ange-ftp-real-read-file-name-internal (&rest args)
+  (ange-ftp-run-real-handler 'read-file-name-internal args))
+(defun ange-ftp-real-verify-visited-file-modtime (&rest args)
+  (ange-ftp-run-real-handler 'verify-visited-file-modtime args))
+(defun ange-ftp-real-file-exists-p (&rest args)
+  (ange-ftp-run-real-handler 'file-exists-p args))
+(defun ange-ftp-real-write-region (&rest args)
+  (ange-ftp-run-real-handler 'write-region args))
+(defun ange-ftp-real-backup-buffer (&rest args)
+  (ange-ftp-run-real-handler 'backup-buffer args))
+(defun ange-ftp-real-copy-file (&rest args)
+  (ange-ftp-run-real-handler 'copy-file args))
+(defun ange-ftp-real-rename-file (&rest args)
+  (ange-ftp-run-real-handler 'rename-file args))
+(defun ange-ftp-real-file-attributes (&rest args)
+  (ange-ftp-run-real-handler 'file-attributes args))
+(defun ange-ftp-real-file-name-all-completions (&rest args)
+  (ange-ftp-run-real-handler 'file-name-all-completions args))
+(defun ange-ftp-real-file-name-completion (&rest args)
+  (ange-ftp-run-real-handler 'file-name-completion args))
+(defun ange-ftp-real-insert-directory (&rest args)
+  (ange-ftp-run-real-handler 'insert-directory args))
+(defun ange-ftp-real-file-name-sans-versions (&rest args)
+  (ange-ftp-run-real-handler 'file-name-sans-versions args))
+(defun ange-ftp-real-shell-command (&rest args)
+  (ange-ftp-run-real-handler 'shell-command args))
+(defun ange-ftp-real-load (&rest args)
+  (ange-ftp-run-real-handler 'load args))
+(defun ange-ftp-real-find-backup-file-name (&rest args)
+  (ange-ftp-run-real-handler 'find-backup-file-name args))
+
+;; Here we support using dired on remote hosts.
+;; I have turned off the support for using dired on foreign directory formats.
+;; That involves too many unclean hooks.
+;; It would be cleaner to support such operations by 
+;; converting the foreign directory format to something dired can understand;
+;; something close to ls -l output.
+;; The logical place to do this is in the functions ange-ftp-parse-...-listing.
+
+;; Some of the old dired hooks would still be needed even if this is done.
+;; I have preserved (and modernized) those hooks.
+;; So the format conversion should be all that is needed.
+
+(defun ange-ftp-insert-directory (file switches &optional wildcard full)
+  (let ((short (ange-ftp-abbreviate-filename file))
+	(parsed (ange-ftp-ftp-name (expand-file-name file))))
+    (if parsed
+	(insert
+	 (if wildcard
+	     (let ((default-directory (file-name-directory file)))
+	       (ange-ftp-ls (file-name-nondirectory file) switches nil nil t))
+	   (ange-ftp-ls file switches full)))
+      (ange-ftp-real-insert-directory file switches wildcard full))))
+
+(defun ange-ftp-dired-uncache (dir)
+  (if (ange-ftp-ftp-name (expand-file-name dir))
+      (setq ange-ftp-ls-cache-file nil)))
+
+(defvar ange-ftp-sans-version-alist nil
+  "Alist of mapping host type into function to remove file version numbers.")
+
+(defun ange-ftp-file-name-sans-versions (file keep-backup-version)
+  (let* ((short (ange-ftp-abbreviate-filename file))
+	 (parsed (ange-ftp-ftp-name short))
+	 host-type func)
+    (if parsed
+	(setq host-type (ange-ftp-host-type (car parsed))
+	      func (cdr (assq (ange-ftp-host-type (car parsed))
+			      ange-ftp-sans-version-alist))))
+    (if func (funcall func file keep-backup-version)
+      (ange-ftp-real-file-name-sans-versions file keep-backup-version))))
+
+;; This is the handler for shell-command.
+(defun ange-ftp-shell-command (command &optional output-buffer error-buffer)
+  (let* ((parsed (ange-ftp-ftp-name default-directory))
+	 (host (nth 0 parsed))
+	 (user (nth 1 parsed))
+	 (name (nth 2 parsed)))
+    (if (not parsed)
+	(ange-ftp-real-shell-command command output-buffer error-buffer)
+      (if (> (length name) 0)		; else it's $HOME
+	  (setq command (concat "cd " name "; " command)))
+      (setq command
+	    (format  "%s %s \"%s\""	; remsh -l USER does not work well
+					; on a hp-ux machine I tried
+		     remote-shell-program host command))
+      (ange-ftp-message "Remote command '%s' ..." command)
+      ;; Cannot call ange-ftp-real-dired-run-shell-command here as it
+      ;; would prepend "cd default-directory" --- which bombs because
+      ;; default-directory is in ange-ftp syntax for remote file names.
+      (ange-ftp-real-shell-command command output-buffer error-buffer))))
+
+;;; This is the handler for call-process.
+(defun ange-ftp-dired-call-process (program discard &rest arguments)
+  ;; PROGRAM is always one of those below in the cond in dired.el.
+  ;; The ARGUMENTS are (nearly) always files.
+  (if (ange-ftp-ftp-name default-directory)
+      ;; Can't use ange-ftp-dired-host-type here because the current
+      ;; buffer is *dired-check-process output*
+      (condition-case oops
+	  (cond ((equal dired-chmod-program program)
+		 (ange-ftp-call-chmod arguments))
+		;; ((equal "chgrp" program))
+		;; ((equal dired-chown-program program))
+		(t (error "Unknown remote command: %s" program)))
+	(ftp-error (insert (format "%s: %s, %s\n"
+				    (nth 1 oops)
+				    (nth 2 oops)
+				    (nth 3 oops)))
+		   ;; Caller expects nonzero value to mean failure.
+		   1)
+	(error (insert (format "%s\n" (nth 1 oops)))
+	       1))
+    (apply 'call-process program nil (not discard) nil arguments)))
+
+(defvar ange-ftp-remote-shell "rsh" 
+  "Remote shell to use for chmod, if FTP server rejects the `chmod' command.")
+
+;; Handle an attempt to run chmod on a remote file
+;; by using the ftp chmod command.
+(defun ange-ftp-call-chmod (args)
+  (if (< (length args) 2)
+      (error "ange-ftp-call-chmod: missing mode and/or filename: %s" args))
+  (let ((mode (car args))
+	(rest (cdr args)))
+    (if (equal "--" (car rest))
+	(setq rest (cdr rest)))
+    (mapcar
+     (function
+      (lambda (file)
+	(setq file (expand-file-name file))
+	(let ((parsed (ange-ftp-ftp-name file)))
+	  (if parsed
+	      (let* ((host (nth 0 parsed))
+		     (user (nth 1 parsed))
+		     (name (ange-ftp-quote-string (nth 2 parsed)))
+		     (abbr (ange-ftp-abbreviate-filename file))
+		     (result (ange-ftp-send-cmd host user
+						(list 'chmod mode name)
+						(format "doing chmod %s"
+							abbr))))
+		(or (car result)
+		    (call-process 
+		     ange-ftp-remote-shell
+		     nil t nil host dired-chmod-program mode name)))))))
+     rest))
+  (setq ange-ftp-ls-cache-file nil)	;Stop confusing Dired.
+  0)
+
+;;; This is turned off because it has nothing properly to do
+;;; with dired.  It could be reasonable to adapt this to
+;;; replace ange-ftp-copy-file.
+
+;;;;; ------------------------------------------------------------
+;;;;; Noddy support for async copy-file within dired.
+;;;;; ------------------------------------------------------------
+
+;;(defun ange-ftp-dired-copy-file (from to ok-flag &optional cont nowait)
+;;  "Documented as original."
+;;  (dired-handle-overwrite to)
+;;  (ange-ftp-copy-file-internal from to ok-flag dired-copy-preserve-time nil
+;;			       cont nowait))
+
+;;(defun ange-ftp-dired-do-create-files (op-symbol file-creator operation arg
+;;						 &optional marker-char op1
+;;						 how-to)
+;;  "Documented as original."
+;;  ;; we need to let ange-ftp-dired-create-files know that we indirectly
+;;  ;; called it rather than somebody else.
+;;  (let ((ange-ftp-dired-do-create-files t)) ; tell who caller is
+;;    (ange-ftp-real-dired-do-create-files op-symbol file-creator operation
+;;					 arg marker-char op1 how-to)))
+
+;;(defun ange-ftp-dired-create-files (file-creator operation fn-list name-constructor
+;;						 &optional marker-char)
+;;  "Documented as original."
+;;  (if (and (boundp 'ange-ftp-dired-do-create-files)
+;;	   ;; called from ange-ftp-dired-do-create-files?
+;;	   ange-ftp-dired-do-create-files
+;;	   ;; any files worth copying?
+;;	   fn-list
+;;	   ;; we only support async copy-file at the mo.
+;;	   (eq file-creator 'dired-copy-file)
+;;	   ;; it is only worth calling the alternative function for remote files
+;;	   ;; as we tie ourself in recursive knots otherwise.
+;;	   (or (ange-ftp-ftp-name (car fn-list))
+;;	       ;; we can only call the name constructor for dired-do-create-files
+;;	       ;; since the one for regexps starts prompting here, there and
+;;	       ;; everywhere.
+;;	       (ange-ftp-ftp-name (funcall name-constructor (car fn-list)))))
+;;      ;; use the process-filter driven routine rather than the iterative one.
+;;      (ange-ftp-dcf-1 file-creator
+;;   		      operation
+;; 		      fn-list
+;; 		      name-constructor
+;; 		      (and (boundp 'target) target)	;dynamically bound
+;; 		      marker-char
+;; 		      (current-buffer)
+;; 		      nil	;overwrite-query
+;; 		      nil	;overwrite-backup-query
+;; 		      nil	;failures
+;; 		      nil	;skipped
+;; 		      0		;success-count
+;; 		      (length fn-list) ;total
+;; 		      )
+;;    ;; normal case... use the interactive routine... much cheaper.
+;;    (ange-ftp-real-dired-create-files file-creator operation fn-list
+;;				      name-constructor marker-char)))
+
+;;(defun ange-ftp-dcf-1 (file-creator operation fn-list name-constructor
+;;		       target marker-char buffer overwrite-query 
+;;		       overwrite-backup-query failures skipped
+;;		       success-count total)
+;;  (let ((old-buf (current-buffer)))
+;;    (unwind-protect
+;;	(progn
+;;	  (set-buffer buffer)
+;;	  (if (null fn-list)
+;;	      (ange-ftp-dcf-3 failures operation total skipped
+;;			      success-count buffer)
+	    
+;;	    (let* ((from (car fn-list))
+;;		   (to (funcall name-constructor from)))
+;;	      (if (equal to from)
+;;		  (progn
+;;		    (setq to nil)
+;;		    (dired-log "Cannot %s to same file: %s\n"
+;;			       (downcase operation) from)))
+;;	      (if (not to)
+;;		  (ange-ftp-dcf-1 file-creator
+;;				  operation
+;;				  (cdr fn-list)
+;;				  name-constructor
+;;				  target
+;;				  marker-char
+;;				  buffer
+;;				  overwrite-query
+;;				  overwrite-backup-query
+;;				  failures
+;;				  (cons (dired-make-relative from) skipped)
+;;				  success-count
+;;				  total)
+;;		(let* ((overwrite (file-exists-p to))
+;;		       (overwrite-confirmed	; for dired-handle-overwrite
+;;			(and overwrite
+;;			     (let ((help-form '(format "\
+;;Type SPC or `y' to overwrite file `%s',
+;;DEL or `n' to skip to next,
+;;ESC or `q' to not overwrite any of the remaining files,
+;;`!' to overwrite all remaining files with no more questions." to)))
+;;			       (dired-query 'overwrite-query
+;;					    "Overwrite `%s'?" to))))
+;;		       ;; must determine if FROM is marked before file-creator
+;;		       ;; gets a chance to delete it (in case of a move).
+;;		       (actual-marker-char
+;;			(cond  ((integerp marker-char) marker-char)
+;;			       (marker-char (dired-file-marker from)) ; slow
+;;			       (t nil))))
+;;		  (condition-case err
+;;		      (funcall file-creator from to overwrite-confirmed
+;;			       (list (function ange-ftp-dcf-2)
+;;				     nil	;err
+;;				     file-creator operation fn-list
+;;				     name-constructor
+;;				     target
+;;				     marker-char actual-marker-char
+;;				     buffer to from
+;;				     overwrite
+;;				     overwrite-confirmed
+;;				     overwrite-query 
+;;				     overwrite-backup-query
+;;				     failures skipped success-count
+;;				     total)
+;;			       t)
+;;		    (file-error		; FILE-CREATOR aborted
+;;		     (ange-ftp-dcf-2 nil ;result
+;;				     nil ;line
+;;				     err
+;;				     file-creator operation fn-list
+;;				     name-constructor
+;;				     target
+;;				     marker-char actual-marker-char
+;;				     buffer to from
+;;				     overwrite
+;;				     overwrite-confirmed
+;;				     overwrite-query 
+;;				     overwrite-backup-query
+;;				     failures skipped success-count
+;;				     total))))))))
+;;      (set-buffer old-buf))))
+
+;;(defun ange-ftp-dcf-2 (result line err
+;;			      file-creator operation fn-list
+;;			      name-constructor
+;;			      target
+;;			      marker-char actual-marker-char
+;;			      buffer to from
+;;			      overwrite
+;;			      overwrite-confirmed
+;;			      overwrite-query 
+;;			      overwrite-backup-query
+;;			      failures skipped success-count
+;;			      total)
+;;  (let ((old-buf (current-buffer)))
+;;    (unwind-protect
+;;	(progn
+;;	  (set-buffer buffer)
+;;	  (if (or err (not result))
+;;	      (progn
+;;		(setq failures (cons (dired-make-relative from) failures))
+;;		(dired-log "%s `%s' to `%s' failed:\n%s\n"
+;;			   operation from to (or err line)))
+;;	    (if overwrite
+;;		;; If we get here, file-creator hasn't been aborted
+;;		;; and the old entry (if any) has to be deleted
+;;		;; before adding the new entry.
+;;		(dired-remove-file to))
+;;	    (setq success-count (1+ success-count))
+;;	    (message "%s: %d of %d" operation success-count total)
+;;	    (dired-add-file to actual-marker-char))
+	  
+;;	  (ange-ftp-dcf-1 file-creator operation (cdr fn-list)
+;;			  name-constructor
+;;			  target
+;;			  marker-char
+;;			  buffer
+;;			  overwrite-query 
+;;			  overwrite-backup-query
+;;			  failures skipped success-count
+;;			  total))
+;;      (set-buffer old-buf))))
+
+;;(defun ange-ftp-dcf-3 (failures operation total skipped success-count
+;;				buffer)
+;;  (let ((old-buf (current-buffer)))
+;;    (unwind-protect
+;;	(progn
+;;	  (set-buffer buffer)
+;;	  (cond
+;;	   (failures
+;;	    (dired-log-summary
+;;	     (message "%s failed for %d of %d file%s %s"
+;;		      operation (length failures) total
+;;		      (dired-plural-s total) failures)))
+;;	   (skipped
+;;	    (dired-log-summary
+;;	     (message "%s: %d of %d file%s skipped %s"
+;;		      operation (length skipped) total
+;;		      (dired-plural-s total) skipped)))
+;;	   (t
+;;	    (message "%s: %s file%s."
+;;		     operation success-count (dired-plural-s success-count))))
+;;	  (dired-move-to-filename))
+;;      (set-buffer old-buf))))
+
+;;;; -----------------------------------------------
+;;;; Unix Descriptive Listing (dl) Support
+;;;; -----------------------------------------------
+
+;; This is turned off because nothing uses it currently
+;; and because I don't understand what it's supposed to be for. --rms.
+
+;;(defconst ange-ftp-dired-dl-re-dir
+;;  "^. [^ /]+/[ \n]"
+;;  "Regular expression to use to search for dl directories.")
+
+;;(or (assq 'unix:dl ange-ftp-dired-re-dir-alist)
+;;    (setq ange-ftp-dired-re-dir-alist
+;;	  (cons (cons 'unix:dl  ange-ftp-dired-dl-re-dir)
+;;		ange-ftp-dired-re-dir-alist)))
+
+;;(defun ange-ftp-dired-dl-move-to-filename (&optional raise-error eol)
+;;  "In dired, move to the first character of the filename on this line."
+;;  ;; This is the Unix dl version.
+;;  (or eol (setq eol (progn (end-of-line) (point))))
+;;  (let (case-fold-search)
+;;    (beginning-of-line)
+;;    (if (looking-at ". [^ ]+ +\\([0-9]+\\|-\\|=\\) ")
+;;	(goto-char (+ (point) 2))
+;;      (if raise-error
+;;	  (error "No file on this line")
+;;	nil))))
+
+;;(or (assq 'unix:dl ange-ftp-dired-move-to-filename-alist)
+;;    (setq ange-ftp-dired-move-to-filename-alist
+;;	  (cons '(unix:dl . ange-ftp-dired-dl-move-to-filename)
+;;		ange-ftp-dired-move-to-filename-alist)))
+
+;;(defun ange-ftp-dired-dl-move-to-end-of-filename (&optional no-error eol)
+;;  ;; Assumes point is at beginning of filename.
+;;  ;; So, it should be called only after (dired-move-to-filename t).
+;;  ;; On failure, signals an error or returns nil.
+;;  ;; This is the Unix dl version.
+;;  (let ((opoint (point))
+;;	case-fold-search hidden)
+;;    (or eol (setq eol (save-excursion (end-of-line) (point))))
+;;    (setq hidden (and selective-display
+;;		       (save-excursion
+;;			 (search-forward "\r" eol t))))
+;;    (if hidden
+;;	(if no-error
+;;	    nil
+;;	  (error
+;;	   (substitute-command-keys
+;;	    "File line is hidden, type \\[dired-hide-subdir] to unhide")))
+;;      (skip-chars-forward "^ /" eol)
+;;      (if (eq opoint (point))
+;;	  (if no-error
+;;	      nil
+;;	    (error "No file on this line"))
+;;	(point)))))
+
+;;(or (assq 'unix:dl ange-ftp-dired-move-to-end-of-filename-alist)
+;;    (setq ange-ftp-dired-move-to-end-of-filename-alist
+;;	  (cons '(unix:dl . ange-ftp-dired-dl-move-to-end-of-filename)
+;;		ange-ftp-dired-move-to-end-of-filename-alist)))
+
+;;;; ------------------------------------------------------------
+;;;; VOS support (VOS support is probably broken,
+;;;; but I don't know anything about VOS.)
+;;;; ------------------------------------------------------------
+;
+;(defun ange-ftp-fix-name-for-vos (name &optional reverse)
+;  (setq name (copy-sequence name))
+;  (let ((from (if reverse ?\> ?\/))
+;	(to (if reverse ?\/ ?\>))
+;	(i (1- (length name))))
+;    (while (>= i 0)
+;      (if (= (aref name i) from)
+;	  (aset name i to))
+;      (setq i (1- i)))
+;    name))
+;
+;(or (assq 'vos ange-ftp-fix-name-func-alist)
+;    (setq ange-ftp-fix-name-func-alist
+;	  (cons '(vos . ange-ftp-fix-name-for-vos)
+;		ange-ftp-fix-name-func-alist)))
+;
+;(or (memq 'vos ange-ftp-dumb-host-types)
+;    (setq ange-ftp-dumb-host-types
+;	  (cons 'vos ange-ftp-dumb-host-types)))
+;
+;(defun ange-ftp-fix-dir-name-for-vos (dir-name)
+;  (ange-ftp-fix-name-for-vos
+;   (concat dir-name
+;	   (if (eq ?/ (aref dir-name (1- (length dir-name))))
+;	       "" "/")
+;	   "*")))
+;
+;(or (assq 'vos ange-ftp-fix-dir-name-func-alist)
+;    (setq ange-ftp-fix-dir-name-func-alist
+;	  (cons '(vos . ange-ftp-fix-dir-name-for-vos)
+;		ange-ftp-fix-dir-name-func-alist)))
+;
+;(defvar ange-ftp-vos-host-regexp nil
+;  "If a host matches this regexp then it is assumed to be running VOS.")
+;
+;(defun ange-ftp-vos-host (host)
+;  (and ange-ftp-vos-host-regexp
+;       (save-match-data
+;	 (string-match ange-ftp-vos-host-regexp host))))
+;
+;(defun ange-ftp-parse-vos-listing ()
+;  "Parse the current buffer which is assumed to be in VOS list -all
+;format, and return a hashtable as the result."
+;  (let ((tbl (ange-ftp-make-hashtable))
+;	(type-list
+;	 '(("^Files: [0-9]+ +Blocks: [0-9]+\n+" nil 40)
+;	   ("^Dirs: [0-9]+\n+" t 30)))
+;	type-regexp type-is-dir type-col file)
+;    (goto-char (point-min))
+;    (save-match-data
+;      (while type-list
+;	(setq type-regexp (car (car type-list))
+;	      type-is-dir (nth 1 (car type-list))
+;	      type-col (nth 2 (car type-list))
+;	      type-list (cdr type-list))
+;	(if (re-search-forward type-regexp nil t)
+;	    (while (eq (char-after (point)) ? )
+;	      (move-to-column type-col)
+;	      (setq file (buffer-substring (point)
+;					   (progn
+;					     (end-of-line 1)
+;					     (point))))
+;	      (ange-ftp-put-hash-entry file type-is-dir tbl)
+;	      (forward-line 1))))
+;      (ange-ftp-put-hash-entry "." 'vosdir tbl)
+;      (ange-ftp-put-hash-entry ".." 'vosdir tbl))
+;    tbl))
+;
+;(or (assq 'vos ange-ftp-parse-list-func-alist)
+;    (setq ange-ftp-parse-list-func-alist
+;	  (cons '(vos . ange-ftp-parse-vos-listing)
+;		ange-ftp-parse-list-func-alist)))
+
+;;;; ------------------------------------------------------------
+;;;; VMS support.
+;;;; ------------------------------------------------------------
+
+;; Convert NAME from UNIX-ish to VMS.  If REVERSE given then convert from VMS
+;; to UNIX-ish.
+(defun ange-ftp-fix-name-for-vms (name &optional reverse)
+  (save-match-data
+    (if reverse
+	(if (string-match "^\\([^:]+:\\)?\\(\\[.*\\]\\)?\\([^][]*\\)$" name)
+	    (let (drive dir file)
+	      (if (match-beginning 1)
+		  (setq drive (substring name
+					 (match-beginning 1)
+					 (match-end 1))))
+	      (if (match-beginning 2)
+		  (setq dir
+			(substring name (match-beginning 2) (match-end 2))))
+	      (if (match-beginning 3)
+		  (setq file
+			(substring name (match-beginning 3) (match-end 3))))
+	      (and dir
+		   (setq dir (apply (function concat)
+				    (mapcar (function
+					     (lambda (char)
+					       (if (= char ?.)
+						   (vector ?/)
+						 (vector char))))
+					    (substring dir 1 -1)))))
+	      (concat (and drive
+			   (concat "/" drive "/"))
+		      dir (and dir "/")
+		      file))
+	  (error "name %s didn't match" name))
+      (let (drive dir file tmp)
+	(if (string-match "^/[^:]+:/" name)
+	    (setq drive (substring name 1
+				   (1- (match-end 0)))
+		  name (substring name (match-end 0))))
+	(setq tmp (file-name-directory name))
+	(if tmp
+	    (setq dir (apply (function concat)
+			     (mapcar (function
+				      (lambda (char)
+					(if (= char ?/)
+					    (vector ?.)
+					  (vector char))))
+				     (substring tmp 0 -1)))))
+	(setq file (file-name-nondirectory name))
+	(concat drive
+		(and dir (concat "[" (if drive nil ".") dir "]"))
+		file)))))
+
+;; (ange-ftp-fix-name-for-vms "/PUB$:/ANONYMOUS/SDSCPUB/NEXT/Readme.txt;1")
+;; (ange-ftp-fix-name-for-vms "/PUB$:[ANONYMOUS.SDSCPUB.NEXT]Readme.txt;1" t)
+
+(or (assq 'vms ange-ftp-fix-name-func-alist)
+    (setq ange-ftp-fix-name-func-alist
+	  (cons '(vms . ange-ftp-fix-name-for-vms)
+		ange-ftp-fix-name-func-alist)))
+
+(or (memq 'vms ange-ftp-dumb-host-types)
+    (setq ange-ftp-dumb-host-types
+	  (cons 'vms ange-ftp-dumb-host-types)))
+
+;; It is important that this function barf for directories for which we know
+;; that we cannot possibly get a directory listing, such as "/" and "/DEV:/".
+;; This is because it saves an unnecessary FTP error, or possibly the listing
+;; might succeed, but give erroneous info. This last case is particularly
+;; likely for OS's (like MTS) for which we need to use a wildcard in order
+;; to list a directory.
+
+;; Convert name from UNIX-ish to VMS ready for a DIRectory listing.
+(defun ange-ftp-fix-dir-name-for-vms (dir-name)
+  ;; Should there be entries for .. -> [-] and . -> [] below. Don't
+  ;; think so, because expand-filename should have already short-circuited
+  ;; them.
+  (cond ((string-equal dir-name "/")
+	 (error "Cannot get listing for fictitious \"/\" directory."))
+	((string-match "^/[-A-Z0-9_$]+:/$" dir-name)
+	 (error "Cannot get listing for device."))
+	((ange-ftp-fix-name-for-vms dir-name))))
+  
+(or (assq 'vms ange-ftp-fix-dir-name-func-alist)
+    (setq ange-ftp-fix-dir-name-func-alist
+	  (cons '(vms . ange-ftp-fix-dir-name-for-vms)
+		ange-ftp-fix-dir-name-func-alist)))
+
+(defvar ange-ftp-vms-host-regexp nil)
+
+;; Return non-nil if HOST is running VMS.
+(defun ange-ftp-vms-host (host)
+  (and ange-ftp-vms-host-regexp
+       (save-match-data
+	 (string-match ange-ftp-vms-host-regexp host))))
+
+;; Because some VMS ftp servers convert filenames to lower case
+;; we allow a-z in the filename regexp. I'm not too happy about this.
+
+(defconst ange-ftp-vms-filename-regexp
+  (concat
+   "\\(\\([_A-Za-z0-9$]?\\|[_A-Za-z0-9$][-_A-Za-z0-9$]*\\)\\."
+   "[-_A-Za-z0-9$]*;+[0-9]*\\)")
+  "Regular expression to match for a valid VMS file name in Dired buffer.
+Stupid freaking bug! Position of _ and $ shouldn't matter but they do.
+Having [A-Z0-9$_] bombs on filename _$$CHANGE_LOG$.TXT$ and $CHANGE_LOG$.TX
+Other orders of $ and _ seem to all work just fine.")
+
+;; These parsing functions are as general as possible because the syntax
+;; of ftp listings from VMS hosts is a bit erratic. What saves us is that
+;; the VMS filename syntax is so rigid. If they bomb on a listing in the
+;; standard VMS Multinet format, then this is a bug. If they bomb on a listing
+;; from vms.weird.net, then too bad.
+
+;; Extract the next filename from a VMS dired-like listing.
+(defun ange-ftp-parse-vms-filename ()
+  (if (re-search-forward
+	 ange-ftp-vms-filename-regexp
+	 nil t)
+	(buffer-substring (match-beginning 0) (match-end 0))))
+
+;; Parse the current buffer which is assumed to be in MultiNet FTP dir
+;; format, and return a hashtable as the result.
+(defun ange-ftp-parse-vms-listing ()
+  (let ((tbl (ange-ftp-make-hashtable))
+	file)
+    (goto-char (point-min))
+    (save-match-data
+      (while (setq file (ange-ftp-parse-vms-filename))
+	(if (string-match "\\.\\(DIR\\|dir\\);[0-9]+" file)
+	    ;; deal with directories
+	    (ange-ftp-put-hash-entry
+	     (substring file 0 (match-beginning 0)) t tbl)
+	  (ange-ftp-put-hash-entry file nil tbl)
+	  (if (string-match ";[0-9]+$" file) ; deal with extension
+	      ;; sans extension
+	      (ange-ftp-put-hash-entry
+	       (substring file 0 (match-beginning 0)) nil tbl)))
+	(forward-line 1))
+      ;; Would like to look for a "Total" line, or a "Directory" line to
+      ;; make sure that the listing isn't complete garbage before putting
+      ;; in "." and "..", but we can't even count on all VAX's giving us
+      ;; either of these.
+	   (ange-ftp-put-hash-entry "." t tbl)
+	   (ange-ftp-put-hash-entry ".." t tbl))
+    tbl))
+
+(or (assq 'vms ange-ftp-parse-list-func-alist)
+    (setq ange-ftp-parse-list-func-alist
+	  (cons '(vms . ange-ftp-parse-vms-listing)
+		ange-ftp-parse-list-func-alist)))
+
+;; This version only deletes file entries which have
+;; explicit version numbers, because that is all VMS allows.
+
+;; Can the following two functions be speeded up using file
+;; completion functions?
+
+(defun ange-ftp-vms-delete-file-entry (name &optional dir-p)
+  (if dir-p
+      (ange-ftp-internal-delete-file-entry name t)
+    (save-match-data
+      (let ((file (ange-ftp-get-file-part name)))
+	(if (string-match ";[0-9]+$" file)
+	    ;; In VMS you can't delete a file without an explicit	
+	    ;; version number, or wild-card (e.g. FOO;*)
+	    ;; For now, we give up on wildcards.
+	    (let ((files (ange-ftp-get-hash-entry
+			  (file-name-directory name)
+			  ange-ftp-files-hashtable)))
+	      (if files
+		  (let* ((root (substring file 0
+					  (match-beginning 0)))
+			 (regexp (concat "^"
+					 (regexp-quote root)
+					 ";[0-9]+$"))
+			 versions)
+		    (ange-ftp-del-hash-entry file files)
+		    ;; Now we need to check if there are any
+		    ;; versions left. If not, then delete the
+		    ;; root entry.
+		    (mapatoms
+		     '(lambda (sym)
+			(and (string-match regexp (get sym 'key))
+			     (setq versions t)))
+		     files)
+		    (or versions
+			(ange-ftp-del-hash-entry root files))))))))))
+
+(or (assq 'vms ange-ftp-delete-file-entry-alist)
+    (setq ange-ftp-delete-file-entry-alist
+	  (cons '(vms . ange-ftp-vms-delete-file-entry)
+		ange-ftp-delete-file-entry-alist)))
+
+(defun ange-ftp-vms-add-file-entry (name &optional dir-p)
+  (if dir-p
+      (ange-ftp-internal-add-file-entry name t)
+    (let ((files (ange-ftp-get-hash-entry
+		  (file-name-directory name)
+		  ange-ftp-files-hashtable)))
+      (if files
+	  (let ((file (ange-ftp-get-file-part name)))
+	    (save-match-data
+	      (if (string-match ";[0-9]+$" file)
+		  (ange-ftp-put-hash-entry
+		   (substring file 0 (match-beginning 0))
+		   nil files)
+		;; Need to figure out what version of the file
+		;; is being added.
+		(let ((regexp (concat "^"
+				      (regexp-quote file)
+				      ";\\([0-9]+\\)$"))
+		      (version 0))
+		  (mapatoms
+		   '(lambda (sym)
+		      (let ((name (get sym 'key)))
+			(and (string-match regexp name)
+			     (setq version
+				   (max version
+					(string-to-int
+					 (substring name
+						    (match-beginning 1)
+						    (match-end 1))))))))
+		   files)
+		  (setq version (1+ version))
+		  (ange-ftp-put-hash-entry
+		   (concat file ";" (int-to-string version))
+		   nil files))))
+	    (ange-ftp-put-hash-entry file nil files))))))
+
+(or (assq 'vms ange-ftp-add-file-entry-alist)
+    (setq ange-ftp-add-file-entry-alist
+	  (cons '(vms . ange-ftp-vms-add-file-entry)
+		ange-ftp-add-file-entry-alist)))
+
+
+(defun ange-ftp-add-vms-host (host)
+  "Mark HOST as the name of a machine running VMS."
+  (interactive
+   (list (read-string "Host: "
+		      (let ((name (or (buffer-file-name) default-directory)))
+			(and name (car (ange-ftp-ftp-name name)))))))
+  (if (not (ange-ftp-vms-host host))
+      (setq ange-ftp-vms-host-regexp
+	    (concat "^" (regexp-quote host) "$"
+		    (and ange-ftp-vms-host-regexp "\\|")
+		    ange-ftp-vms-host-regexp)
+	    ange-ftp-host-cache nil)))
+
+
+(defun ange-ftp-vms-file-name-as-directory (name)
+  (save-match-data
+    (if (string-match "\\.\\(DIR\\|dir\\)\\(;[0-9]+\\)?$" name)
+	(setq name (substring name 0 (match-beginning 0))))
+    (ange-ftp-real-file-name-as-directory name)))
+
+(or (assq 'vms ange-ftp-file-name-as-directory-alist)
+    (setq ange-ftp-file-name-as-directory-alist
+	  (cons '(vms . ange-ftp-vms-file-name-as-directory)
+		ange-ftp-file-name-as-directory-alist)))
+
+;;; Tree dired support:
+
+;; For this code I have borrowed liberally from Sebastian Kremer's
+;; dired-vms.el
+
+
+;;;; These regexps must be anchored to beginning of line.
+;;;; Beware that the ftpd may put the device in front of the filename.
+
+;;(defconst ange-ftp-dired-vms-re-exe "^. [^ \t.]+\\.\\(EXE\\|exe\\)[; ]"
+;;  "Regular expression to use to search for VMS executable files.")
+
+;;(defconst ange-ftp-dired-vms-re-dir "^. [^ \t.]+\\.\\(DIR\\|dir\\)[; ]"
+;;  "Regular expression to use to search for VMS directories.")
+
+;;(or (assq 'vms ange-ftp-dired-re-exe-alist)
+;;    (setq ange-ftp-dired-re-exe-alist
+;;	  (cons (cons 'vms  ange-ftp-dired-vms-re-exe)
+;;		ange-ftp-dired-re-exe-alist)))
+
+;;(or (assq 'vms ange-ftp-dired-re-dir-alist)
+;;    (setq ange-ftp-dired-re-dir-alist
+;;	  (cons (cons 'vms  ange-ftp-dired-vms-re-dir)
+;;		ange-ftp-dired-re-dir-alist)))
+
+;;(defun ange-ftp-dired-vms-insert-headerline (dir)
+;;  ;; VMS inserts a headerline. I would prefer the headerline
+;;  ;; to be in ange-ftp format. This version tries to
+;;  ;; be careful, because we can't count on a headerline
+;;  ;; over ftp, and we wouldn't want to delete anything
+;;  ;; important.
+;;  (save-excursion
+;;    (if (looking-at "^  wildcard ")
+;;	(forward-line 1))
+;;    (if (looking-at "^[ \n\t]*[^\n]+\\][ \t]*\n")
+;;	(delete-region (point) (match-end 0))))
+;;  (ange-ftp-real-dired-insert-headerline dir))
+
+;;(or (assq 'vms ange-ftp-dired-insert-headerline-alist)
+;;    (setq ange-ftp-dired-insert-headerline-alist
+;;	  (cons '(vms . ange-ftp-dired-vms-insert-headerline)
+;;		ange-ftp-dired-insert-headerline-alist)))
+
+;;(defun ange-ftp-dired-vms-move-to-filename (&optional raise-error eol)
+;;  "In dired, move to first char of filename on this line.
+;;Returns position (point) or nil if no filename on this line."
+;;  ;; This is the VMS version.
+;;  (let (case-fold-search)
+;;    (or eol (setq eol (progn (end-of-line) (point))))
+;;    (beginning-of-line)
+;;    (if (re-search-forward ange-ftp-vms-filename-regexp eol t)
+;;	(goto-char (match-beginning 1))
+;;      (if raise-error
+;;	  (error "No file on this line")
+;;	nil))))
+
+;;(or (assq 'vms ange-ftp-dired-move-to-filename-alist)
+;;    (setq ange-ftp-dired-move-to-filename-alist
+;;	  (cons '(vms . ange-ftp-dired-vms-move-to-filename)
+;;		ange-ftp-dired-move-to-filename-alist)))
+
+;;(defun ange-ftp-dired-vms-move-to-end-of-filename (&optional no-error eol)
+;;  ;; Assumes point is at beginning of filename.
+;;  ;; So, it should be called only after (dired-move-to-filename t).
+;;  ;; case-fold-search must be nil, at least for VMS.
+;;  ;; On failure, signals an error or returns nil.
+;;  ;; This is the VMS version.
+;;  (let (opoint hidden case-fold-search)
+;;    (setq opoint (point))
+;;    (or eol (setq eol (save-excursion (end-of-line) (point))))
+;;    (setq hidden (and selective-display
+;;		      (save-excursion (search-forward "\r" eol t))))
+;;    (if hidden
+;;	nil
+;;      (re-search-forward ange-ftp-vms-filename-regexp eol t))
+;;    (or no-error
+;;	(not (eq opoint (point)))
+;;	(error
+;;	 (if hidden
+;;	     (substitute-command-keys
+;;	      "File line is hidden, type \\[dired-hide-subdir] to unhide")
+;;	   "No file on this line")))
+;;    (if (eq opoint (point))
+;;	nil
+;;      (point))))
+
+;;(or (assq 'vms ange-ftp-dired-move-to-end-of-filename-alist)
+;;    (setq ange-ftp-dired-move-to-end-of-filename-alist
+;;	  (cons '(vms . ange-ftp-dired-vms-move-to-end-of-filename)
+;;		ange-ftp-dired-move-to-end-of-filename-alist)))
+
+;;(defun ange-ftp-dired-vms-between-files ()
+;;  (save-excursion
+;;    (beginning-of-line)
+;;    (or (equal (following-char) 10) ; newline
+;;     (equal (following-char) 9)     ; tab
+;;     (progn (forward-char 2)
+;;	    (or (looking-at "Total of")
+;;		(equal (following-char) 32))))))
+
+;;(or (assq 'vms ange-ftp-dired-between-files-alist)
+;;    (setq ange-ftp-dired-between-files-alist
+;;	  (cons '(vms . ange-ftp-dired-vms-between-files)
+;;		ange-ftp-dired-between-files-alist)))
+
+;; Beware! In VMS filenames must be of the form "FILE.TYPE".
+;; Therefore, we cannot just append a ".Z" to filenames for
+;; compressed files. Instead, we turn "FILE.TYPE" into
+;; "FILE.TYPE-Z". Hope that this is a reasonable thing to do.
+
+(defun ange-ftp-vms-make-compressed-filename (name &optional reverse)
+  (cond
+   ((string-match "-Z;[0-9]+$" name)
+    (list nil (substring name 0 (match-beginning 0))))
+   ((string-match ";[0-9]+$" name)
+    (list nil (substring name 0 (match-beginning 0))))
+   ((string-match "-Z$" name)
+    (list nil (substring name 0 -2)))
+   (t
+    (list t
+	  (if (string-match ";[0-9]+$" name)
+	      (concat (substring name 0 (match-beginning 0))
+		      "-Z")
+	    (concat name "-Z"))))))
+
+(or (assq 'vms ange-ftp-make-compressed-filename-alist)
+    (setq ange-ftp-make-compressed-filename-alist
+	  (cons '(vms . ange-ftp-vms-make-compressed-filename)
+		ange-ftp-make-compressed-filename-alist)))
+
+;;;; When the filename is too long, VMS will use two lines to list a file
+;;;; (damn them!) This will confuse dired. To solve this, need to convince
+;;;; Sebastian to use a function dired-go-to-end-of-file-line, instead of
+;;;; (forward-line 1). This would require a number of changes to dired.el.
+;;;; If dired gets confused, revert-buffer will fix it.
+
+;;(defun ange-ftp-dired-vms-ls-trim ()
+;;  (goto-char (point-min))
+;;  (let ((case-fold-search nil))
+;;    (re-search-forward  ange-ftp-vms-filename-regexp))
+;;  (beginning-of-line)
+;;  (delete-region (point-min) (point))
+;;  (forward-line 1)
+;;  (delete-region (point) (point-max)))
+
+
+;;(or (assq 'vms ange-ftp-dired-ls-trim-alist)
+;;    (setq ange-ftp-dired-ls-trim-alist
+;;	  (cons '(vms . ange-ftp-dired-vms-ls-trim)
+;;		ange-ftp-dired-ls-trim-alist)))	
+
+(defun ange-ftp-vms-sans-version (name &rest args)
+  (save-match-data
+    (if (string-match ";[0-9]+$" name)
+	(substring name 0 (match-beginning 0))
+      name)))
+
+(or (assq 'vms ange-ftp-sans-version-alist)
+    (setq ange-ftp-sans-version-alist
+	  (cons '(vms . ange-ftp-vms-sans-version)
+		ange-ftp-sans-version-alist)))
+
+;;(defvar ange-ftp-file-version-alist)
+
+;;;;; The vms version of clean-directory has 2 more optional args
+;;;;; than the usual dired version. This is so that it can be used by
+;;;;; ange-ftp-dired-vms-flag-backup-files.
+
+;;(defun ange-ftp-dired-vms-clean-directory (keep &optional marker msg)
+;;  "Flag numerical backups for deletion.
+;;Spares `dired-kept-versions' latest versions, and `kept-old-versions' oldest.
+;;Positive prefix arg KEEP overrides `dired-kept-versions';
+;;Negative prefix arg KEEP overrides `kept-old-versions' with KEEP made positive.
+
+;;To clear the flags on these files, you can use \\[dired-flag-backup-files]
+;;with a prefix argument."
+;;;  (interactive "P") ; Never actually called interactively.
+;;  (setq keep (max 1 (if keep (prefix-numeric-value keep) dired-kept-versions)))
+;;  (let ((early-retention (if (< keep 0) (- keep) kept-old-versions))
+;;	;; late-retention must NEVER be allowed to be less than 1 in VMS!
+;;	;; This could wipe ALL copies of the file.
+;;	(late-retention (max 1 (if (<= keep 0) dired-kept-versions keep)))
+;;	(action (or msg "Cleaning"))
+;;	(ange-ftp-trample-marker (or marker dired-del-marker))
+;;	(ange-ftp-file-version-alist ()))
+;;    (message (concat action
+;;		     " numerical backups (keeping %d late, %d old)...")
+;;	     late-retention early-retention)
+;;    ;; Look at each file.
+;;    ;; If the file has numeric backup versions,
+;;    ;; put on ange-ftp-file-version-alist an element of the form
+;;    ;; (FILENAME . VERSION-NUMBER-LIST)
+;;    (dired-map-dired-file-lines (function
+;;				 ange-ftp-dired-vms-collect-file-versions))
+;;    ;; Sort each VERSION-NUMBER-LIST,
+;;    ;; and remove the versions not to be deleted.
+;;    (let ((fval ange-ftp-file-version-alist))
+;;      (while fval
+;;	(let* ((sorted-v-list (cons 'q (sort (cdr (car fval)) '<)))
+;;	       (v-count (length sorted-v-list)))
+;;	  (if (> v-count (+ early-retention late-retention))
+;;	      (rplacd (nthcdr early-retention sorted-v-list)
+;;		      (nthcdr (- v-count late-retention)
+;;			      sorted-v-list)))
+;;	  (rplacd (car fval)
+;;		  (cdr sorted-v-list)))
+;;	(setq fval (cdr fval))))
+;;    ;; Look at each file.  If it is a numeric backup file,
+;;    ;; find it in a VERSION-NUMBER-LIST and maybe flag it for deletion.
+;;    (dired-map-dired-file-lines
+;;     (function
+;;      ange-ftp-dired-vms-trample-file-versions mark))
+;;    (message (concat action " numerical backups...done"))))
+
+;;(or (assq 'vms ange-ftp-dired-clean-directory-alist)
+;;    (setq ange-ftp-dired-clean-directory-alist
+;;	  (cons '(vms . ange-ftp-dired-vms-clean-directory)
+;;		ange-ftp-dired-clean-directory-alist)))
+
+;;(defun ange-ftp-dired-vms-collect-file-versions (fn)
+;;  ;;  "If it looks like file FN has versions, return a list of the versions.
+;;  ;;That is a list of strings which are file names.
+;;  ;;The caller may want to flag some of these files for deletion."
+;;(let ((name (nth 2 (ange-ftp-ftp-name fn))))
+;;  (if (string-match ";[0-9]+$" name)
+;;      (let* ((name (substring name 0 (match-beginning 0)))
+;;	     (fn (ange-ftp-replace-name-component fn name)))
+;;	(if (not (assq fn ange-ftp-file-version-alist))
+;;	    (let* ((base-versions
+;;		    (concat (file-name-nondirectory name) ";"))
+;;		   (bv-length (length base-versions))
+;;		   (possibilities (file-name-all-completions
+;;				   base-versions
+;;				   (file-name-directory fn)))
+;;		   (versions (mapcar
+;;			      '(lambda (arg)
+;;				 (if (and (string-match
+;;					   "[0-9]+$" arg bv-length)
+;;					  (= (match-beginning 0) bv-length))
+;;				     (string-to-int (substring arg bv-length))
+;;				   0))
+;;			      possibilities)))
+;;	      (if versions
+;;		  (setq
+;;		   ange-ftp-file-version-alist
+;;		   (cons (cons fn versions)
+;;			 ange-ftp-file-version-alist)))))))))
+
+;;(defun ange-ftp-dired-vms-trample-file-versions (fn)
+;;  (let* ((start-vn (string-match ";[0-9]+$" fn))
+;;	 base-version-list)
+;;    (and start-vn
+;;	 (setq base-version-list	; there was a base version to which
+;;	       (assoc (substring fn 0 start-vn)	; this looks like a
+;;		      ange-ftp-file-version-alist))	; subversion
+;;	 (not (memq (string-to-int (substring fn (1+ start-vn)))
+;;		    base-version-list))	; this one doesn't make the cut
+;;	 (progn (beginning-of-line)
+;;		(delete-char 1)
+;;		(insert ange-ftp-trample-marker)))))
+
+;;(defun ange-ftp-dired-vms-flag-backup-files (&optional unflag-p)
+;;  (let ((dired-kept-versions 1)
+;;	(kept-old-versions 0)
+;;	marker msg)
+;;    (if unflag-p
+;;	(setq marker ?\040 msg "Unflagging")
+;;      (setq marker dired-del-marker msg "Cleaning"))
+;;    (ange-ftp-dired-vms-clean-directory nil marker msg)))
+
+;;(or (assq 'vms ange-ftp-dired-flag-backup-files-alist)
+;;    (setq ange-ftp-dired-flag-backup-files-alist
+;;	  (cons '(vms . ange-ftp-dired-vms-flag-backup-files)
+;;		ange-ftp-dired-flag-backup-files-alist)))
+
+;;(defun ange-ftp-dired-vms-backup-diff (&optional switches)
+;;  (let ((file (dired-get-filename 'no-dir))
+;;	bak)
+;;    (if (and (string-match ";[0-9]+$" file)
+;;	     ;; Find most recent previous version.
+;;	     (let ((root (substring file 0 (match-beginning 0)))
+;;		   (ver
+;;		    (string-to-int (substring file (1+ (match-beginning 0)))))
+;;		   found)
+;;	       (setq ver (1- ver))
+;;	       (while (and (> ver 0) (not found))
+;;		 (setq bak (concat root ";" (int-to-string ver)))
+;;		 (and (file-exists-p bak) (setq found t))
+;;		 (setq ver (1- ver)))
+;;	       found))
+;;	(if switches
+;;	    (diff (expand-file-name bak) (expand-file-name file) switches)
+;;	  (diff (expand-file-name bak) (expand-file-name file)))
+;;      (error "No previous version found for %s" file))))
+
+;;(or (assq 'vms ange-ftp-dired-backup-diff-alist)
+;;    (setq ange-ftp-dired-backup-diff-alist
+;;	  (cons '(vms . ange-ftp-dired-vms-backup-diff)
+;;		ange-ftp-dired-backup-diff-alist)))
+
+
+;;;; ------------------------------------------------------------
+;;;; MTS support
+;;;; ------------------------------------------------------------
+
+
+;; Convert NAME from UNIX-ish to MTS. If REVERSE given then convert from
+;; MTS to UNIX-ish.
+(defun ange-ftp-fix-name-for-mts (name &optional reverse)
+  (save-match-data
+    (if reverse
+	(if (string-match "^\\([^:]+:\\)?\\(.*\\)$" name)
+	    (let (acct file)
+	      (if (match-beginning 1)
+		  (setq acct (substring name 0 (match-end 1))))
+	      (if (match-beginning 2)
+		  (setq file (substring name
+					(match-beginning 2) (match-end 2))))
+	      (concat (and acct (concat "/" acct "/"))
+		      file))
+	  (error "name %s didn't match" name))
+      (if (string-match "^/\\([^:]+:\\)/\\(.*\\)$" name)
+	  (concat (substring name 1 (match-end 1))
+		  (substring name (match-beginning 2) (match-end 2)))
+	;; Let's hope that mts will recognize it anyway.
+	name))))
+
+(or (assq 'mts ange-ftp-fix-name-func-alist)
+    (setq ange-ftp-fix-name-func-alist
+	  (cons '(mts . ange-ftp-fix-name-for-mts)
+		ange-ftp-fix-name-func-alist)))
+
+;; Convert name from UNIX-ish to MTS ready for a DIRectory listing.
+;; Remember that there are no directories in MTS.
+(defun ange-ftp-fix-dir-name-for-mts (dir-name)
+  (if (string-equal dir-name "/")
+      (error "Cannot get listing for fictitious \"/\" directory.")
+    (let ((dir-name (ange-ftp-fix-name-for-mts dir-name)))
+      (cond
+       ((string-equal dir-name "")
+	"?")
+       ((string-match ":$" dir-name)
+	(concat dir-name "?"))
+       (dir-name))))) ; It's just a single file.
+
+(or (assq 'mts ange-ftp-fix-dir-name-func-alist)
+    (setq ange-ftp-fix-dir-name-func-alist
+	  (cons '(mts . ange-ftp-fix-dir-name-for-mts)
+		ange-ftp-fix-dir-name-func-alist)))
+
+(or (memq 'mts ange-ftp-dumb-host-types)
+    (setq ange-ftp-dumb-host-types
+	  (cons 'mts ange-ftp-dumb-host-types)))
+
+(defvar ange-ftp-mts-host-regexp nil)
+
+;; Return non-nil if HOST is running MTS.
+(defun ange-ftp-mts-host (host)
+  (and ange-ftp-mts-host-regexp
+       (save-match-data
+	 (string-match ange-ftp-mts-host-regexp host))))
+
+;; Parse the current buffer which is assumed to be in mts ftp dir format.
+(defun ange-ftp-parse-mts-listing ()
+  (let ((tbl (ange-ftp-make-hashtable)))
+    (goto-char (point-min))
+    (save-match-data
+      (while (re-search-forward ange-ftp-date-regexp nil t)
+	(end-of-line)
+	(skip-chars-backward " ")
+	(let ((end (point)))
+	  (skip-chars-backward "-A-Z0-9_.!")
+	  (ange-ftp-put-hash-entry (buffer-substring (point) end) nil tbl))
+	(forward-line 1)))
+      ;; Don't need to bother with ..
+    (ange-ftp-put-hash-entry "." t tbl)
+    tbl))
+
+(or (assq 'mts ange-ftp-parse-list-func-alist)
+    (setq ange-ftp-parse-list-func-alist
+	  (cons '(mts . ange-ftp-parse-mts-listing)
+		ange-ftp-parse-list-func-alist)))
+
+(defun ange-ftp-add-mts-host (host)
+  "Mark HOST as the name of a machine running MTS."
+  (interactive
+   (list (read-string "Host: "
+		      (let ((name (or (buffer-file-name) default-directory)))
+			(and name (car (ange-ftp-ftp-name name)))))))
+  (if (not (ange-ftp-mts-host host))
+      (setq ange-ftp-mts-host-regexp
+	    (concat "^" (regexp-quote host) "$"
+		    (and ange-ftp-mts-host-regexp "\\|")
+		    ange-ftp-mts-host-regexp)
+	    ange-ftp-host-cache nil)))
+
+;;; Tree dired support:
+
+;;;; There aren't too many systems left that use MTS. This dired support will
+;;;; work for the implementation of ftp on mtsg.ubc.ca. I hope other mts systems
+;;;; implement ftp in the same way. If not, it might be necessary to make the
+;;;; following more flexible.
+
+;;(defun ange-ftp-dired-mts-move-to-filename (&optional raise-error eol)
+;;  "In dired, move to first char of filename on this line.
+;;Returns position (point) or nil if no filename on this line."
+;;  ;; This is the MTS version.
+;;  (or eol (setq eol (progn (end-of-line) (point))))
+;;  (beginning-of-line)
+;;  (if (re-search-forward
+;;       ange-ftp-date-regexp eol t)
+;;      (progn
+;;	(skip-chars-forward " ")          ; Eat blanks after date
+;;	(skip-chars-forward "0-9:" eol)   ; Eat time or year
+;;	(skip-chars-forward " " eol)      ; one space before filename
+;;	;; When listing an account other than the users own account it appends
+;;	;; ACCT: to the beginning of the filename. Skip over this.
+;;	(and (looking-at "[A-Z0-9_.]+:")
+;;	     (goto-char (match-end 0)))
+;;	(point))
+;;    (if raise-error
+;;	(error "No file on this line")
+;;      nil)))
+
+;;(or (assq 'mts ange-ftp-dired-move-to-filename-alist)
+;;    (setq ange-ftp-dired-move-to-filename-alist
+;;	  (cons '(mts . ange-ftp-dired-mts-move-to-filename)
+;;		ange-ftp-dired-move-to-filename-alist)))
+
+;;(defun ange-ftp-dired-mts-move-to-end-of-filename (&optional no-error eol)
+;;  ;; Assumes point is at beginning of filename.
+;;  ;; So, it should be called only after (dired-move-to-filename t).
+;;  ;; On failure, signals an error or returns nil.
+;;  ;; This is the MTS version.
+;;  (let (opoint hidden case-fold-search)
+;;    (setq opoint (point)
+;;	  eol (save-excursion (end-of-line) (point))
+;;	  hidden (and selective-display
+;;		      (save-excursion (search-forward "\r" eol t))))
+;;    (if hidden
+;;	nil
+;;      (skip-chars-forward "-A-Z0-9._!" eol))
+;;    (or no-error
+;;	(not (eq opoint (point)))
+;;	(error
+;;	 (if hidden
+;;	     (substitute-command-keys
+;;	      "File line is hidden, type \\[dired-hide-subdir] to unhide")
+;;	   "No file on this line")))
+;;    (if (eq opoint (point))
+;;	nil
+;;      (point))))
+
+;;(or (assq 'mts ange-ftp-dired-move-to-end-of-filename-alist)
+;;    (setq ange-ftp-dired-move-to-end-of-filename-alist
+;;	  (cons '(mts . ange-ftp-dired-mts-move-to-end-of-filename)
+;;		ange-ftp-dired-move-to-end-of-filename-alist)))
+
+;;;; ------------------------------------------------------------
+;;;; CMS support
+;;;; ------------------------------------------------------------
+
+;; Since CMS doesn't have any full file name syntax, we have to fudge
+;; things with cd's. We actually send too many cd's, but it's dangerous
+;; to try to remember the current minidisk, because if the connection
+;; is closed and needs to be reopened, we will find ourselves back in
+;; the default minidisk. This is fairly likely since CMS ftp servers
+;; usually close the connection after 5 minutes of inactivity.
+
+;; Have I got the filename character set right?
+
+(defun ange-ftp-fix-name-for-cms (name &optional reverse)
+  (save-match-data
+    (if reverse
+	;; Since we only convert output from a pwd in this direction,
+	;; we'll assume that it's a minidisk, and make it into a
+	;; directory file name. Note that the expand-dir-hashtable
+	;; stores directories without the trailing /. Is this
+	;; consistent?
+	(concat "/" name)
+      (if (string-match "^/\\([-A-Z0-9$*._]+\\)/\\([-A-Z0-9$._]+\\)?$"
+			name)
+	  (let ((minidisk (substring name 1 (match-end 1))))
+	    (if (match-beginning 2)
+		(let ((file (substring name (match-beginning 2)
+				       (match-end 2)))
+		      (cmd (concat "cd " minidisk))
+
+		      ;; Note that host and user are bound in the call
+		      ;; to ange-ftp-send-cmd
+		      (proc (ange-ftp-get-process ange-ftp-this-host
+						  ange-ftp-this-user)))
+
+		  ;; Must use ange-ftp-raw-send-cmd here to avoid
+		  ;; an infinite loop.
+		  (if (car (ange-ftp-raw-send-cmd proc cmd ange-ftp-this-msg))
+		      file
+		    ;; failed... try ONCE more.
+		    (setq proc (ange-ftp-get-process ange-ftp-this-host
+						     ange-ftp-this-user))
+		    (let ((result (ange-ftp-raw-send-cmd proc cmd
+							 ange-ftp-this-msg)))
+		      (if (car result)
+			  file
+			;; failed.  give up.
+			(ange-ftp-error ange-ftp-this-host ange-ftp-this-user
+					(format "cd to minidisk %s failed: %s"
+						minidisk (cdr result)))))))
+	      ;; return the minidisk
+	      minidisk))
+	(error "Invalid CMS filename")))))
+
+(or (assq 'cms ange-ftp-fix-name-func-alist)
+    (setq ange-ftp-fix-name-func-alist
+	  (cons '(cms . ange-ftp-fix-name-for-cms)
+		ange-ftp-fix-name-func-alist)))
+
+(or (memq 'cms ange-ftp-dumb-host-types)
+    (setq ange-ftp-dumb-host-types
+	  (cons 'cms ange-ftp-dumb-host-types)))
+
+;; Convert name from UNIX-ish to CMS ready for a DIRectory listing.
+(defun ange-ftp-fix-dir-name-for-cms (dir-name)
+  (cond
+   ((string-equal "/" dir-name)
+    (error "Cannot get listing for fictitious \"/\" directory."))
+   ((string-match "^/\\([-A-Z0-9$*._]+\\)/\\([-A-Z0-9$._]+\\)?$" dir-name)
+    (let* ((minidisk (substring dir-name (match-beginning 1) (match-end 1)))
+	   ;; host and user are bound in the call to ange-ftp-send-cmd
+	   (proc (ange-ftp-get-process ange-ftp-this-host ange-ftp-this-user))
+	   (cmd (concat "cd " minidisk))
+	   (file (if (match-beginning 2)
+		     ;; it's a single file
+		     (substring dir-name (match-beginning 2)
+				(match-end 2))
+		   ;; use the wild-card
+		   "*")))
+      (if (car (ange-ftp-raw-send-cmd proc cmd))
+	  file
+	;; try again...
+	(setq proc (ange-ftp-get-process ange-ftp-this-host
+					 ange-ftp-this-user))
+	(let ((result (ange-ftp-raw-send-cmd proc cmd)))
+	  (if (car result)
+	      file
+	    ;; give up
+	    (ange-ftp-error ange-ftp-this-host ange-ftp-this-user
+			    (format "cd to minidisk %s failed: %s"
+				    minidisk (cdr result))))))))
+   (t (error "Invalid CMS file name"))))
+
+(or (assq 'cms ange-ftp-fix-dir-name-func-alist)
+    (setq ange-ftp-fix-dir-name-func-alist
+	  (cons '(cms . ange-ftp-fix-dir-name-for-cms)
+		ange-ftp-fix-dir-name-func-alist)))
+
+(defvar ange-ftp-cms-host-regexp nil
+  "Regular expression to match hosts running the CMS operating system.")
+
+;; Return non-nil if HOST is running CMS.
+(defun ange-ftp-cms-host (host)
+  (and ange-ftp-cms-host-regexp
+       (save-match-data
+	 (string-match ange-ftp-cms-host-regexp host))))
+
+(defun ange-ftp-add-cms-host (host)
+  "Mark HOST as the name of a CMS host."
+  (interactive
+   (list (read-string "Host: "
+		      (let ((name (or (buffer-file-name) default-directory)))
+			(and name (car (ange-ftp-ftp-name name)))))))
+  (if (not (ange-ftp-cms-host host))
+      (setq ange-ftp-cms-host-regexp
+	    (concat "^" (regexp-quote host) "$"
+		    (and ange-ftp-cms-host-regexp "\\|")
+		    ange-ftp-cms-host-regexp)
+	    ange-ftp-host-cache nil)))
+
+(defun ange-ftp-parse-cms-listing ()
+  ;; Parse the current buffer which is assumed to be a CMS directory listing.
+  ;; If we succeed in getting a listing, then we will assume that the minidisk
+  ;; exists. file is bound by the call to ange-ftp-ls. This doesn't work
+  ;; because ange-ftp doesn't know that the root hashtable has only part of
+  ;; the info. It will assume that if a minidisk isn't in it, then it doesn't
+  ;; exist. It would be nice if completion worked for minidisks, as we
+  ;; discover them.
+;  (let* ((dir-file (directory-file-name file))
+;	 (root (file-name-directory dir-file))
+;	 (minidisk (ange-ftp-get-file-part dir-file))
+;	 (root-tbl (ange-ftp-get-hash-entry root ange-ftp-files-hashtable)))
+;    (if root-tbl
+;	(ange-ftp-put-hash-entry minidisk t root-tbl)
+;      (setq root-tbl (ange-ftp-make-hashtable))
+;      (ange-ftp-put-hash-entry minidisk t root-tbl)
+;      (ange-ftp-put-hash-entry "." t root-tbl)
+;      (ange-ftp-set-files root root-tbl)))
+  ;; Now do the usual parsing
+  (let ((tbl (ange-ftp-make-hashtable)))
+    (goto-char (point-min))
+    (save-match-data
+      (while
+	  (re-search-forward
+	   "^\\([-A-Z0-9$_]+\\) +\\([-A-Z0-9$_]+\\) +[VF] +[0-9]+ " nil t)
+	(ange-ftp-put-hash-entry
+	 (concat (buffer-substring (match-beginning 1)
+				   (match-end 1))
+		 "."
+		 (buffer-substring (match-beginning 2)
+				   (match-end 2)))
+	 nil tbl)
+	(forward-line 1))
+      (ange-ftp-put-hash-entry "." t tbl))
+    tbl))
+
+(or (assq 'cms ange-ftp-parse-list-func-alist)
+    (setq ange-ftp-parse-list-func-alist
+	  (cons '(cms . ange-ftp-parse-cms-listing)
+		ange-ftp-parse-list-func-alist)))
+    
+;;;;; Tree dired support:
+
+;;(defconst ange-ftp-dired-cms-re-exe
+;;  "^. [-A-Z0-9$_]+ +EXEC "
+;;  "Regular expression to use to search for CMS executables.")
+
+;;(or (assq 'cms ange-ftp-dired-re-exe-alist)
+;;    (setq ange-ftp-dired-re-exe-alist
+;;	  (cons (cons 'cms  ange-ftp-dired-cms-re-exe)
+;;		ange-ftp-dired-re-exe-alist)))
+
+
+;;(defun ange-ftp-dired-cms-insert-headerline (dir)
+;;  ;; CMS has no total line, so we insert a blank line for
+;;  ;; aesthetics.
+;;  (insert "\n")
+;;  (forward-char -1)
+;;  (ange-ftp-real-dired-insert-headerline dir))
+
+;;(or (assq 'cms ange-ftp-dired-insert-headerline-alist)
+;;    (setq ange-ftp-dired-insert-headerline-alist
+;;	  (cons '(cms . ange-ftp-dired-cms-insert-headerline)
+;;		ange-ftp-dired-insert-headerline-alist)))
+
+;;(defun ange-ftp-dired-cms-move-to-filename (&optional raise-error eol)
+;;  "In dired, move to the first char of filename on this line."
+;;  ;; This is the CMS version.
+;;  (or eol (setq eol (progn (end-of-line) (point))))
+;;  (let (case-fold-search)
+;;    (beginning-of-line)
+;;    (if (re-search-forward " [-A-Z0-9$_]+ +[-A-Z0-9$_]+ +[VF] +[0-9]+ " eol t)
+;;	(goto-char (1+ (match-beginning 0)))
+;;      (if raise-error
+;;	  (error "No file on this line")
+;;	nil))))
+
+;;(or (assq 'cms ange-ftp-dired-move-to-filename-alist)
+;;    (setq ange-ftp-dired-move-to-filename-alist
+;;	  (cons '(cms . ange-ftp-dired-cms-move-to-filename)
+;;		ange-ftp-dired-move-to-filename-alist)))
+
+;;(defun ange-ftp-dired-cms-move-to-end-of-filename (&optional no-error eol)
+;;  ;; Assumes point is at beginning of filename.
+;;  ;; So, it should be called only after (dired-move-to-filename t).
+;;  ;; case-fold-search must be nil, at least for VMS.
+;;  ;; On failure, signals an error or returns nil.
+;;  ;; This is the CMS version.
+;;  (let ((opoint (point))
+;;	case-fold-search hidden)
+;;    (or eol (setq eol (save-excursion (end-of-line) (point))))
+;;    (setq hidden (and selective-display
+;;		      (save-excursion
+;;			(search-forward "\r" eol t))))
+;;    (if hidden
+;;	(if no-error
+;;	    nil
+;;	  (error
+;;	   (substitute-command-keys
+;;	    "File line is hidden, type \\[dired-hide-subdir] to unhide")))
+;;      (skip-chars-forward "-A-Z0-9$_" eol)
+;;      (skip-chars-forward " " eol)
+;;      (skip-chars-forward "-A-Z0-9$_" eol)
+;;      (if (eq opoint (point))
+;;	  (if no-error
+;;	      nil
+;;	    (error "No file on this line"))
+;;	(point)))))
+
+;;(or (assq 'cms ange-ftp-dired-move-to-end-of-filename-alist)
+;;    (setq ange-ftp-dired-move-to-end-of-filename-alist
+;;	  (cons '(cms . ange-ftp-dired-cms-move-to-end-of-filename)
+;;		ange-ftp-dired-move-to-end-of-filename-alist)))
+
+(defun ange-ftp-cms-make-compressed-filename (name &optional reverse)
+  (if (string-match "-Z$" name)
+      (list nil (substring name 0 -2))
+    (list t (concat name "-Z"))))
+
+(or (assq 'cms ange-ftp-make-compressed-filename-alist)
+    (setq ange-ftp-make-compressed-filename-alist
+	  (cons '(cms . ange-ftp-cms-make-compressed-filename)
+		ange-ftp-make-compressed-filename-alist)))
+
+;;(defun ange-ftp-dired-cms-get-filename (&optional localp no-error-if-not-filep)
+;;  (let ((name (ange-ftp-real-dired-get-filename localp no-error-if-not-filep)))
+;;    (and name
+;;	 (if (string-match "^\\([^ ]+\\) +\\([^ ]+\\)$" name)
+;;	     (concat (substring name 0 (match-end 1))
+;;		     "."
+;;		     (substring name (match-beginning 2) (match-end 2)))
+;;	   name))))
+
+;;(or (assq 'cms ange-ftp-dired-get-filename-alist)
+;;    (setq ange-ftp-dired-get-filename-alist
+;;	  (cons '(cms . ange-ftp-dired-cms-get-filename)
+;;		ange-ftp-dired-get-filename-alist)))
+
+;;;; ------------------------------------------------------------
+;;;; Finally provide package.
+;;;; ------------------------------------------------------------
+
+(provide 'ange-ftp)
+
+;;; ange-ftp.el ends here
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lisp/net/browse-url.el	Mon Mar 20 13:12:14 2000 +0000
@@ -0,0 +1,1033 @@
+;;; browse-url.el --- Pass a URL to a WWW browser
+
+;; Copyright (C) 1995, 96, 97, 98, 99, 2000 Free Software Foundation, Inc.
+
+;; Author: Denis Howe <dbh@doc.ic.ac.uk>
+;; Maintainer: Dave Love <fx@gnu.org>
+;; Created: 03 Apr 1995
+;; Keywords: hypertext, hypermedia, mouse
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; This package provides functions which read a URL (Uniform Resource
+;; Locator) from the minibuffer, defaulting to the URL around point,
+;; and ask a World-Wide Web browser to load it.  It can also load the
+;; URL associated with the current buffer.  Different browsers use
+;; different methods of remote control so there is one function for
+;; each supported browser.  If the chosen browser is not running, it
+;; is started.  Currently there is support for:
+
+;; Function              Browser     Earliest version
+;; browse-url-netscape   Netscape    1.1b1
+;; browse-url-mosaic     XMosaic/mMosaic <= 2.4
+;; browse-url-cci        XMosaic     2.5
+;; browse-url-w3         w3          0
+;; browse-url-w3-gnudoit w3 remotely
+;; browse-url-iximosaic  IXI Mosaic  ?
+;; browse-url-lynx-*	 Lynx	     0
+;; browse-url-grail      Grail       0.3b1
+;; browse-url-mmm        MMM         ?
+;; browse-url-generic    arbitrary
+
+;; [A version of the Netscape browser is now free software
+;; <URL:http://www.mozilla.org/>, albeit not GPLed, so it is
+;; reasonable to have that as the default.]
+
+;; Note that versions of Netscape before 1.1b1 did not have remote
+;; control.  <URL:http://www.netscape.com/newsref/std/x-remote.html>.
+
+;; Browsers can cache Web pages so it may be necessary to tell them to
+;; reload the current page if it has changed (e.g. if you have edited
+;; it).  There is currently no perfect automatic solution to this.
+
+;; Netscape allows you to specify the id of the window you want to
+;; control but which window DO you want to control and how do you
+;; discover its id?
+
+;; If using XMosaic before version 2.5, check the definition of
+;; browse-url-usr1-signal below.
+;; <URL:http://www.ncsa.uiuc.edu/SDG/Software/XMosaic/remote-control.html>
+
+;; XMosaic version 2.5 introduced Common Client Interface allowing you
+;; to control mosaic through Unix sockets.
+;; <URL:http://www.ncsa.uiuc.edu/SDG/Software/XMosaic/CCI/cci-spec.html>
+
+;; William M. Perry's excellent "w3" WWW browser for
+;; Emacs <URL:ftp://cs.indiana.edu/pub/elisp/w3/>
+;; has a function w3-follow-url-at-point, but that
+;; doesn't let you edit the URL like browse-url.
+;; The `gnuserv' package that can be used to control it in another
+;; Emacs process is available from
+;; <URL:ftp://ftp.splode.com/pub/users/friedman/packages/>.
+
+;; Grail is the freely available WWW browser implemented in Python, a
+;; cool object-oriented freely available interpreted language.  Grail
+;; 0.3b1 was the first version to have remote control as distributed.
+;; For more information on Grail see
+;; <URL:http://grail.cnri.reston.va.us/> and for more information on
+;; Python see <url:http://www.python.org/>.  Grail support in
+;; browse-url.el written by Barry Warsaw <bwarsaw@python.org>.
+
+;; MMM is a semi-free WWW browser implemented in Objective Caml, an
+;; interesting impure functional programming language.  See
+;; <URL:http://pauillac.inria.fr/%7Erouaix/mmm/>.
+
+;; Lynx is now distributed by the FSF.  See also
+;; <URL:http://lynx.browser.org/>.
+
+;; Free graphical browsers that could be used by `browse-url-generic'
+;; include Chimera <URL:ftp://ftp.cs.unlv.edu/pub/chimera> and
+;; <URL:http://www.unlv.edu/chimera/>, Arena
+;; <URL:ftp://ftp.yggdrasil.com/pub/dist/web/arena> and Amaya
+;; <URL:ftp://ftp.w3.org/pub/amaya>.  mMosaic
+;; <URL:ftp://sig.enst.fr/pub/multicast/mMosaic/>,
+;; <URL:http://sig.enst.fr/~dauphin/mMosaic/> (with development
+;; support for Java applets and multicast) can be used like Mosaic by
+;; setting `browse-url-mosaic-program' appropriately.
+
+;; I [Denis Howe, not Dave Love] recommend Nelson Minar
+;; <nelson@santafe.edu>'s excellent html-helper-mode.el for editing
+;; HTML and thank Nelson for his many useful comments on this code.
+;; <URL:http://www.santafe.edu/%7Enelson/hhm-beta/>
+
+;; See also hm--html-menus <URL:http://www.tnt.uni-hannover.de/%7Emuenkel/
+;; software/own/hm--html-menus/>.  For composing correct HTML see also
+;; PSGML the general SGML structure editor package
+;; <URL:ftp://ftp.lysator.liu.se/pub/sgml>; hm--html-menus can be used
+;; with this.
+
+;; This package generalises function html-previewer-process in Marc
+;; Andreessen's html-mode (LCD modes/html-mode.el.Z).  See also the
+;; ffap.el package.  The huge hyperbole package also contains similar
+;; functions.
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Help!
+
+;; Can you write and test some code for the Macintrash and Windoze
+;; Netscape remote control APIs?  (See the URL above).
+
+;; Do any other browsers have remote control?
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Usage
+
+;; To display the URL at or before point:
+;; M-x browse-url-at-point RET
+;; or, similarly but with the opportunity to edit the URL extracted from
+;; the buffer, use:
+;; M-x browse-url
+
+;; To display a URL by shift-clicking on it, put this in your ~/.emacs
+;; file:
+;;      (global-set-key [S-mouse-2] 'browse-url-at-mouse)
+;; (Note that using Shift-mouse-1 is not desirable because
+;; that event has a standard meaning in Emacs.)
+
+;; To display the current buffer in a web browser:
+;; M-x browse-url-of-buffer RET
+
+;; To display the current region in a web browser:
+;; M-x browse-url-of-region RET
+
+;; In Dired, to display the file named on the current line:
+;; M-x browse-url-of-dired-file RET
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Customisation (~/.emacs)
+
+;; To see what variables are available for customization, type
+;; `M-x set-variable browse-url TAB'.  Better, use
+;; `M-x customize-group browse-url'.
+
+;; Bind the browse-url commands to keys with the `C-c C-z' prefix
+;; (as used by html-helper-mode):
+;;	(global-set-key "\C-c\C-z." 'browse-url-at-point)
+;;	(global-set-key "\C-c\C-zb" 'browse-url-of-buffer)
+;;	(global-set-key "\C-c\C-zr" 'browse-url-of-region)
+;;	(global-set-key "\C-c\C-zu" 'browse-url)
+;;	(global-set-key "\C-c\C-zv" 'browse-url-of-file)
+;;	(add-hook 'dired-mode-hook
+;;		  (lambda ()
+;;	             (local-set-key "\C-c\C-zf" 'browse-url-of-dired-file)))
+
+;; Browse URLs in mail messages by clicking mouse-2:
+;;	(add-hook 'rmail-mode-hook (lambda () ; rmail-mode startup
+;;	  (define-key rmail-mode-map [mouse-2] 'browse-url-at-mouse)))
+
+;; Browse URLs in Usenet messages by clicking mouse-2:
+;;	(eval-after-load "gnus"
+;;	  '(define-key gnus-article-mode-map [mouse-2] 'browse-url-at-mouse))
+;; [The current version of Gnus provides a standard feature to
+;; activate URLs in article buffers for invocation of browse-url with
+;; mouse-2.]
+
+;; Use the Emacs w3 browser when not running under X11:
+;;	(or (eq window-system 'x)
+;;	    (setq browse-url-browser-function 'browse-url-w3))
+
+;; To always save modified buffers before displaying the file in a browser:
+;;	(setq browse-url-save-file t)
+
+;; To get round the Netscape caching problem, you could EITHER have
+;; write-file in html-helper-mode make Netscape reload the document:
+;;
+;;	(autoload 'browse-url-netscape-reload "browse-url"
+;;	  "Ask a WWW browser to redisplay the current file." t)
+;;	(add-hook 'html-helper-mode-hook
+;;		  (lambda ()
+;;		     (add-hook 'local-write-file-hooks
+;;			       (lambda ()
+;;				  (let ((local-write-file-hooks))
+;;				    (save-buffer))
+;;				  (browse-url-netscape-reload)
+;;				  t)			; => file written by hook
+;;			       t)))			; append to l-w-f-hooks
+;;
+;; OR have browse-url-of-file ask Netscape to load and then reload the
+;; file:
+;;
+;;	(add-hook 'browse-url-of-file-hook 'browse-url-netscape-reload)
+
+;; You may also want to customise browse-url-netscape-arguments, e.g.
+;;	(setq browse-url-netscape-arguments '("-install"))
+;;
+;; or similarly for the other browsers.
+
+;; To invoke different browsers for different URLs:
+;;      (setq browse-url-browser-function '(("^mailto:" . browse-url-mail)
+;;      				    ("." . browse-url-netscape)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; Code:
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Variables
+
+(eval-when-compile (require 'thingatpt)
+                   (require 'term)
+		   (require 'dired)
+		   (require 'w3-auto nil t))
+
+(defgroup browse-url nil
+  "Use a web browser to look at a URL."
+  :prefix "browse-url-"
+  :group 'hypermedia)
+
+;;;###autoload
+(defcustom browse-url-browser-function
+  (if (eq system-type 'windows-nt)
+      'browse-url-default-windows-browser
+    'browse-url-netscape)
+  "*Function to display the current buffer in a WWW browser.
+This is used by the `browse-url-at-point', `browse-url-at-mouse', and
+`browse-url-of-file' commands.
+
+If the value is not a function it should be a list of pairs
+(REGEXP . FUNCTION).  In this case the function called will be the one
+associated with the first REGEXP which matches the current URL.  The
+function is passed the URL and any other args of `browse-url'.  The last
+regexp should probably be \".\" to specify a default browser."
+  :type '(choice
+           (function-item :tag "Emacs W3" :value  browse-url-w3)
+           (function-item :tag "W3 in another Emacs via `gnudoit'"
+                          :value  browse-url-w3-gnudoit)
+           (function-item :tag "Netscape" :value  browse-url-netscape)
+           (function-item :tag "Mosaic" :value  browse-url-mosaic)
+           (function-item :tag "Mosaic using CCI" :value  browse-url-cci)
+           (function-item :tag "IXI Mosaic" :value  browse-url-iximosaic)
+           (function-item :tag "Lynx in an xterm window"
+                          :value browse-url-lynx-xterm)
+           (function-item :tag "Lynx in an Emacs window"
+                          :value browse-url-lynx-emacs)
+           (function-item :tag "Grail" :value  browse-url-grail)
+           (function-item :tag "MMM" :value  browse-url-mmm)
+           (function-item :tag "Specified by `Browse Url Generic Program'"
+                          :value browse-url-generic)
+           (function-item :tag "Default Windows browser"
+                          :value  browse-url-default-windows-browser)
+           (function :tag "Your own function"))
+  :version "20.4"
+  :group 'browse-url)
+
+(defcustom browse-url-netscape-program "netscape"
+  ;; Info about netscape-remote from Karl Berry.
+  "The name by which to invoke Netscape.
+
+The free program `netscape-remote' from
+<URL:http://home.netscape.com/newsref/std/remote.c> is said to start
+up very much quicker than `netscape'.  Reported to compile on a GNU
+system, given vroot.h from the same directory, with cc flags
+ -DSTANDALONE -L/usr/X11R6/lib -lXmu -lX11."
+  :type 'string
+  :group 'browse-url)
+
+(defcustom browse-url-netscape-arguments nil
+  "A list of strings to pass to Netscape as arguments."
+  :type '(repeat (string :tag "Argument"))
+  :group 'browse-url)
+
+(defcustom browse-url-netscape-startup-arguments browse-url-netscape-arguments
+  "A list of strings to pass to Netscape when it starts up.
+Defaults to the value of `browse-url-netscape-arguments' at the time
+`browse-url' is loaded."
+  :type '(repeat (string :tag "Argument"))
+  :group 'browse-url)
+
+;;;###autoload
+(defcustom browse-url-new-window-p nil
+  "*If non-nil, always open a new browser window with appropriate browsers.
+Passing an interactive argument to \\[browse-url], or specific browser
+commands reverses the effect of this variable.  Requires Netscape version
+1.1N or later or XMosaic version 2.5 or later if using those browsers."
+  :type 'boolean
+  :group 'browse-url)
+
+;;;###autoload
+(defcustom browse-url-netscape-display nil
+  "*The X display for running Netscape, if not same as Emacs'."
+  :type '(choice string (const :tag "Default" nil))
+  :group 'browse-url)
+
+(defcustom browse-url-mosaic-program "xmosaic"
+  "The name by which to invoke Mosaic (or mMosaic)."
+  :type 'string
+  :version "20.3"
+  :group 'browse-url)
+
+(defcustom browse-url-mosaic-arguments nil
+  "A list of strings to pass to Mosaic as arguments."
+  :type '(repeat (string :tag "Argument"))
+  :group 'browse-url)
+
+(defcustom browse-url-filename-alist
+  '(("^/\\(ftp@\\|anonymous@\\)?\\([^:]+\\):/*" . "ftp://\\2/")
+    ;; The above loses the username to avoid the browser prompting for
+    ;; it in anonymous cases.  If it's not anonymous the next regexp
+    ;; applies.
+    ("^/\\([^:@]+@\\)?\\([^:]+\\):/*" . "ftp://\\1\\2/")
+    ("^/+" . "file:/"))
+  "An alist of (REGEXP . STRING) pairs used by `browse-url-of-file'.
+Any substring of a filename matching one of the REGEXPs is replaced by
+the corresponding STRING using `replace-match', not treating STRING
+literally.  All pairs are applied in the order given.  The default
+value converts ange-ftp/EFS-style paths into ftp URLs and prepends
+`file:' to any path beginning with `/'.
+
+For example, adding to the default a specific translation of an ange-ftp
+address to an HTTP URL:
+
+    (setq browse-url-filename-alist
+	  '((\"/webmaster@webserver:/home/www/html/\" .
+	     \"http://www.acme.co.uk/\")
+            (\"^/\\(ftp@\\|anonymous@\\)?\\([^:]+\\):/*\" . \"ftp://\\2/\")
+            (\"^/\\([^:@]+@\\)?\\([^:]+\\):/*\" . \"ftp://\\1\\2/\")
+	    (\"^/+\" . \"file:/\")))
+"
+  :type '(repeat (cons :format "%v"
+                       (regexp :tag "Regexp")
+                       (string :tag "Replacement")))
+  :version "20.3"
+  :group 'browse-url)
+
+;;;###autoload
+(defcustom browse-url-save-file nil
+  "*If non-nil, save the buffer before displaying its file.
+Used by the `browse-url-of-file' command."
+  :type 'boolean
+  :group 'browse-url)
+
+(defcustom browse-url-of-file-hook nil
+  "Run after `browse-url-of-file' has asked a browser to load a file.
+
+Set this to `browse-url-netscape-reload' to force Netscape to load the
+file rather than displaying a cached copy."
+  :type 'hook
+  :options '(browse-url-netscape-reload)
+  :group 'browse-url)
+
+(defvar browse-url-usr1-signal
+  (if (and (boundp 'emacs-major-version)
+	   (or (> emacs-major-version 19) (>= emacs-minor-version 29)))
+      'SIGUSR1 ; Why did I think this was in lower case before?
+    30)					; Check /usr/include/signal.h.
+  "The argument to `signal-process' for sending SIGUSR1 to XMosaic.
+Emacs 19.29 accepts 'SIGUSR1, earlier versions require an integer
+which is 30 on SunOS and 16 on HP-UX and Solaris.")
+
+(defcustom browse-url-CCI-port 3003
+  "Port to access XMosaic via CCI.
+This can be any number between 1024 and 65535 but must correspond to
+the value set in the browser."
+  :type 'integer
+  :group 'browse-url)
+
+(defcustom browse-url-CCI-host "localhost"
+  "*Host to access XMosaic via CCI.
+This should be the host name of the machine running XMosaic with CCI
+enabled.  The port number should be set in `browse-url-CCI-port'."
+  :type 'string
+  :group 'browse-url)
+
+(defvar browse-url-temp-file-name nil)
+(make-variable-buffer-local 'browse-url-temp-file-name)
+
+(defcustom browse-url-xterm-program "xterm"
+  "The name of the terminal emulator used by `browse-url-lynx-xterm'.
+This might, for instance, be a separate colour version of xterm."
+  :type 'string
+  :group 'browse-url)
+
+(defcustom browse-url-xterm-args nil
+  "*A list of strings defining options for `browse-url-xterm-program'.
+These might set its size, for instance."
+  :type '(repeat (string :tag "Argument"))
+  :group 'browse-url)
+
+(defcustom browse-url-lynx-emacs-args (and (not window-system) 
+                                           '("-show_cursor"))
+  "A list of strings defining options for Lynx in an Emacs buffer.
+
+The default is none in a window system, otherwise `-show_cursor' to
+indicate the position of the current link in the absence of
+highlighting, assuming the normal default for showing the cursor."
+  :type '(repeat (string :tag "Argument"))
+  :version "20.3"
+  :group 'browse-url)
+
+(defcustom browse-url-gnudoit-program "gnudoit"
+  "The name of the `gnudoit' program used by `browse-url-w3-gnudoit'."
+  :type 'string
+  :group 'browse-url)
+
+(defcustom browse-url-gnudoit-args '("-q")
+  "*A list of strings defining options for `browse-url-gnudoit-program'.
+These might set the port, for instance."
+  :type '(repeat (string :tag "Argument"))
+  :group 'browse-url)
+
+;;;###autoload
+(defcustom browse-url-generic-program nil
+  "*The name of the browser program used by `browse-url-generic'."
+  :type '(choice string (const :tag "None" nil))
+  :group 'browse-url)
+
+(defcustom browse-url-generic-args nil
+  "*A list of strings defining options for `browse-url-generic-program'."
+  :type '(repeat (string :tag "Argument"))
+  :group 'browse-url)
+
+(defcustom browse-url-temp-dir temporary-file-directory
+  "The name of a directory for browse-url's temporary files.
+Such files are generated by functions like `browse-url-of-region'.
+You might want to set this to somewhere with restricted read permissions
+for privacy's sake."
+  :type 'string
+  :group 'browse-url)
+
+(defcustom browse-url-netscape-version
+  3
+  "The version of Netscape you are using.
+This affects how URL reloading is done; the mechanism changed
+incompatibly at version 4."
+  :type 'number
+  :group 'browse-url)
+
+(defcustom browse-url-lynx-input-field 'avoid
+  "*Action on selecting an existing Lynx buffer at an input field.
+What to do when sending a new URL to an existing Lynx buffer in Emacs
+if the Lynx cursor is on an input field (in which case the `g' command
+would be entered as data).  Such fields are recognized by the
+underlines ____.  Allowed values: nil: disregard it, 'warn: warn the
+user and don't emit the URL, 'avoid: try to avoid the field by moving
+down (this *won't* always work)."
+  :type '(choice (const :tag "Move to try to avoid field" :value avoid)
+                 (const :tag "Disregard" :value nil)
+                 (const :tag "Warn, don't emit URL" :value warn))
+  :version "20.3"
+  :group 'browse-url)
+
+(defvar browse-url-lynx-input-attempts 10
+  "*How many times to try to move down from a series of lynx input fields.")
+
+(defcustom browse-url-lynx-input-delay 0.2
+  "How many seconds to wait for lynx between moves down from an input field.")
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; URL input
+
+(defun browse-url-url-at-point ()
+  (let ((url (thing-at-point 'url)))
+    (set-text-properties 0 (length url) nil url)
+    url))
+
+;; Having this as a separate function called by the browser-specific
+;; functions allows them to be stand-alone commands, making it easier
+;; to switch between browsers.
+
+(defun browse-url-interactive-arg (prompt)
+  "Read a URL from the minibuffer, prompting with PROMPT.
+Default to the URL at or before point.  If invoked with a mouse button,
+set point to the position clicked first.  Return a list for use in
+`interactive' containing the URL and `browse-url-new-window-p' or its
+negation if a prefix argument was given."
+  (let ((event (elt (this-command-keys) 0)))
+    (and (listp event) (mouse-set-point event)))
+  (list (read-string prompt (browse-url-url-at-point))
+	(not (eq (null browse-url-new-window-p)
+		 (null current-prefix-arg)))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Browse current buffer
+
+;;;###autoload
+(defun browse-url-of-file (&optional file)
+  "Ask a WWW browser to display FILE.
+Display the current buffer's file if FILE is nil or if called
+interactively.  Turn the filename into a URL with function
+`browse-url-file-url'.  Pass the URL to a browser using the
+`browse-url' function then run `browse-url-of-file-hook'."
+  (interactive)
+  (or file
+      (setq file (buffer-file-name))
+      (error "Current buffer has no file"))
+  (let ((buf (get-file-buffer file)))
+    (if buf
+	(save-excursion
+	  (set-buffer buf)
+	  (cond ((not (buffer-modified-p)))
+		(browse-url-save-file (save-buffer))
+		(t (message "%s modified since last save" file))))))
+  (browse-url (browse-url-file-url file))
+  (run-hooks 'browse-url-of-file-hook))
+
+(defun browse-url-file-url (file)
+  "Return the URL corresponding to FILE.
+Use variable `browse-url-filename-alist' to map filenames to URLs."
+  ;; URL-encode special chars, do % first
+  (let ((s 0))
+    (while (setq s (string-match "%" file s))
+      (setq file (replace-match "%25" t t file)
+	    s (1+ s))))
+  (while (string-match "[*\"()',=;? ]" file)
+    (let ((enc (format "%%%x" (aref file (match-beginning 0)))))
+      (setq file (replace-match enc t t file))))
+  (let ((maps browse-url-filename-alist))
+    (while maps
+      (let* ((map (car maps))
+	     (from-re (car map))
+	     (to-string (cdr map)))
+	(setq maps (cdr maps))
+	(and (string-match from-re file)
+	     (setq file (replace-match to-string t nil file))))))
+  file)
+
+;;;###autoload
+(defun browse-url-of-buffer (&optional buffer)
+  "Ask a WWW browser to display BUFFER.
+Display the current buffer if BUFFER is nil.  Display only the
+currently visible part of BUFFER (from a temporary file) if buffer is
+narrowed."
+  (interactive)
+  (save-excursion
+    (and buffer (set-buffer buffer))
+    (let ((file-name
+	   ;; Ignore real name if restricted
+	   (and (= (- (point-max) (point-min)) (buffer-size))
+		(or buffer-file-name
+		    (and (boundp 'dired-directory) dired-directory)))))
+      (or file-name
+	  (progn
+	    (or browse-url-temp-file-name
+		(setq browse-url-temp-file-name
+		      (convert-standard-filename
+		       (make-temp-file
+			(expand-file-name "burl" browse-url-temp-dir)))))
+	    (setq file-name browse-url-temp-file-name)
+	    (write-region (point-min) (point-max) file-name nil 'no-message)))
+      (browse-url-of-file file-name))))
+
+(defun browse-url-delete-temp-file (&optional temp-file-name)
+  ;; Delete browse-url-temp-file-name from the file system
+  ;; If optional arg TEMP-FILE-NAME is non-nil, delete it instead
+  (let ((file-name (or temp-file-name browse-url-temp-file-name)))
+    (if (and file-name (file-exists-p file-name))
+	(delete-file file-name))))
+
+(add-hook 'kill-buffer-hook 'browse-url-delete-temp-file)
+
+;;;###autoload
+(defun browse-url-of-dired-file ()
+  "In Dired, ask a WWW browser to display the file named on this line."
+  (interactive)
+  (browse-url-of-file (dired-get-filename)))
+
+;;;###autoload
+(defun browse-url-of-region (min max)
+  "Ask a WWW browser to display the current region."
+  (interactive "r")
+  (save-excursion
+    (save-restriction
+      (narrow-to-region min max)
+      (browse-url-of-buffer))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Browser-independent commands
+
+;; A generic command to call the current browse-url-browser-function
+
+;;;###autoload
+(defun browse-url (url &rest args)
+  "Ask a WWW browser to load URL.
+Prompts for a URL, defaulting to the URL at or before point.  Variable
+`browse-url-browser-function' says which browser to use."
+  (interactive (browse-url-interactive-arg "URL: "))
+  (if (functionp browse-url-browser-function)
+      (apply browse-url-browser-function url args)
+    ;; The `function' can be an alist; look down it for first match
+    ;; and apply the function (which might be a lambda).
+    (catch 'done
+      (mapcar
+       (lambda (bf)
+	 (when (string-match (car bf) url)
+	   (apply (cdr bf) url args)
+	   (throw 'done t)))
+       browse-url-browser-function)
+      (error "No browser in browse-url-browser-function matching URL %s"
+	     url))))
+
+;;;###autoload
+(defun browse-url-at-point ()
+  "Ask a WWW browser to load the URL at or before point.
+Doesn't let you edit the URL like `browse-url'.  Variable
+`browse-url-browser-function' says which browser to use."
+  (interactive)
+  (browse-url (browse-url-url-at-point)))
+
+(defun browse-url-event-buffer (event)
+  (window-buffer (posn-window (event-start event))))
+
+(defun browse-url-event-point (event)
+  (posn-point (event-start event)))
+
+;;;###autoload
+(defun browse-url-at-mouse (event)
+  "Ask a WWW browser to load a URL clicked with the mouse.
+The URL is the one around or before the position of the mouse click
+but point is not changed.  Doesn't let you edit the URL like
+`browse-url'.  Variable `browse-url-browser-function' says which browser
+to use."
+  (interactive "e")
+  (save-excursion
+    (set-buffer (browse-url-event-buffer event))
+    (goto-char (browse-url-event-point event))
+    (let ((url (browse-url-url-at-point)))
+      (if (string-equal url "")
+	  (error "No URL found"))
+      (browse-url url browse-url-new-window-p))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Browser-specific commands
+
+;; --- Default MS-Windows browser ---
+
+(defun browse-url-default-windows-browser (url &optional new-window)
+  (interactive (browse-url-interactive-arg "URL: "))
+  (w32-shell-execute "open" url))
+
+;; --- Netscape ---
+
+(defun browse-url-process-environment ()
+  "Set DISPLAY in the environment to the X display Netscape is running on.
+This is either the value of variable `browse-url-netscape-display' if
+non-nil, or the same display as Emacs if different from the current
+environment, otherwise just use the current environment."
+  (let ((display (or browse-url-netscape-display (browse-url-emacs-display))))
+    (if display
+	(cons (concat "DISPLAY=" display) process-environment)
+      process-environment)))
+
+(defun browse-url-emacs-display ()
+  "Return the X display Emacs is running on.
+This is nil if the display is the same as the DISPLAY environment variable.
+
+Actually Emacs could be using several displays; this just returns the
+one showing the selected frame."
+  (let ((display (cdr-safe (assq 'display (frame-parameters)))))
+    (and (not (equal display (getenv "DISPLAY")))
+         display)))
+
+;;;###autoload
+(defun browse-url-netscape (url &optional new-window)
+  "Ask the Netscape WWW browser to load URL.
+
+Default to the URL around or before point.  The strings in variable
+`browse-url-netscape-arguments' are also passed to Netscape.
+
+When called interactively, if variable `browse-url-new-window-p' is
+non-nil, load the document in a new Netscape window, otherwise use a
+random existing one.  A non-nil interactive prefix argument reverses
+the effect of `browse-url-new-window-p'.
+
+When called non-interactively, optional second argument NEW-WINDOW is
+used instead of `browse-url-new-window-p'."
+  (interactive (browse-url-interactive-arg "Netscape URL: "))
+  ;; URL encode any `confusing' characters in the URL.  This needs to
+  ;; include at least commas; presumably also close parens.
+  (while (string-match "[,)]" url)
+    (setq url (replace-match
+	       (format "%%%x" (string-to-char (match-string 0 url))) t t url)))
+  (let* ((process-environment (browse-url-process-environment))
+         (process (apply 'start-process
+			 (concat "netscape " url) nil
+			 browse-url-netscape-program
+			 (append
+			  browse-url-netscape-arguments
+			  (if (eq window-system 'w32)
+			      (list url)
+			    (append
+			     (if new-window '("-noraise"))
+			     (list "-remote"
+				   (concat "openURL(" url
+					   (if new-window ",new-window")
+					   ")"))))))))
+    (set-process-sentinel process
+			  (list 'lambda '(process change)
+				(list 'browse-url-netscape-sentinel 'process url)))))
+
+(defun browse-url-netscape-sentinel (process url)
+  "Handle a change to the process communicating with Netscape."
+  (or (eq (process-exit-status process) 0)
+      (let* ((process-environment (browse-url-process-environment)))
+	;; Netscape not running - start it
+	(message "Starting Netscape...")
+	(apply 'start-process (concat "netscape" url) nil
+	       browse-url-netscape-program
+	       (append browse-url-netscape-startup-arguments (list url))))))
+
+(defun browse-url-netscape-reload ()
+  "Ask Netscape to reload its current document.
+How depends on `browse-url-netscape-version'."
+  (interactive)
+  ;; Backwards incompatibility reported by
+  ;; <peter.kruse@psychologie.uni-regensburg.de>.
+  (browse-url-netscape-send (if (>= browse-url-netscape-version 4)
+				"xfeDoCommand(reload)"
+				"reload")))
+
+(defun browse-url-netscape-send (command)
+  "Send a remote control command to Netscape."
+  (let* ((process-environment (browse-url-process-environment)))
+    (apply 'start-process "netscape" nil
+           browse-url-netscape-program
+           (append browse-url-netscape-arguments
+                   (list "-remote" command)))))
+
+;; --- Mosaic ---
+
+;;;###autoload
+(defun browse-url-mosaic (url &optional new-window)
+  "Ask the XMosaic WWW browser to load URL.
+
+Default to the URL around or before point.  The strings in variable
+`browse-url-mosaic-arguments' are also passed to Mosaic and the
+program is invoked according to the variable
+`browse-url-mosaic-program'.
+
+When called interactively, if variable `browse-url-new-window-p' is
+non-nil, load the document in a new Mosaic window, otherwise use a
+random existing one.  A non-nil interactive prefix argument reverses
+the effect of `browse-url-new-window-p'.
+
+When called non-interactively, optional second argument NEW-WINDOW is
+used instead of `browse-url-new-window-p'."
+  (interactive (browse-url-interactive-arg "Mosaic URL: "))
+  (let ((pidfile (expand-file-name "~/.mosaicpid"))
+	pid)
+    (if (file-readable-p pidfile)
+	(save-excursion
+	  (find-file pidfile)
+	  (goto-char (point-min))
+	  (setq pid (read (current-buffer)))
+	  (kill-buffer nil)))
+    (if (and pid (zerop (signal-process pid 0))) ; Mosaic running
+	(save-excursion
+	  (find-file (format "/tmp/Mosaic.%d" pid))
+	  (erase-buffer)
+	  (insert (if new-window
+		      "newwin\n"
+		    "goto\n")
+		  url "\n")
+	  (save-buffer)
+	  (kill-buffer nil)
+	  ;; Send signal SIGUSR to Mosaic
+	  (message "Signalling Mosaic...")
+	  (signal-process pid browse-url-usr1-signal)
+	  ;; Or you could try:
+	  ;; (call-process "kill" nil 0 nil "-USR1" (int-to-string pid))
+	  (message "Signalling Mosaic...done")
+	  )
+      ;; Mosaic not running - start it
+      (message "Starting Mosaic...")
+      (apply 'start-process "xmosaic" nil browse-url-mosaic-program
+	     (append browse-url-mosaic-arguments (list url)))
+      (message "Starting Mosaic...done"))))
+
+;; --- Grail ---
+
+;;;###autoload
+(defvar browse-url-grail
+  (concat (or (getenv "GRAILDIR") "~/.grail") "/user/rcgrail.py")
+  "Location of Grail remote control client script `rcgrail.py'.
+Typically found in $GRAILDIR/rcgrail.py, or ~/.grail/user/rcgrail.py.")
+
+;;;###autoload
+(defun browse-url-grail (url &optional new-window)
+  "Ask the Grail WWW browser to load URL.
+Default to the URL around or before point.  Runs the program in the
+variable `browse-url-grail'."
+  (interactive (browse-url-interactive-arg "Grail URL: "))
+  (message "Sending URL to Grail...")
+  (save-excursion
+    (set-buffer (get-buffer-create " *Shell Command Output*"))
+    (erase-buffer)
+    ;; don't worry about this failing.
+    (if new-window
+	(call-process browse-url-grail nil 0 nil "-b" url)
+      (call-process browse-url-grail nil 0 nil url))
+    (message "Sending URL to Grail... done")))
+
+;; --- Mosaic using CCI ---
+
+;;;###autoload
+(defun browse-url-cci (url &optional new-window)
+  "Ask the XMosaic WWW browser to load URL.
+Default to the URL around or before point.
+
+This function only works for XMosaic version 2.5 or later.  You must
+select `CCI' from XMosaic's File menu, set the CCI Port Address to the
+value of variable `browse-url-CCI-port', and enable `Accept requests'.
+
+When called interactively, if variable `browse-url-new-window-p' is
+non-nil, load the document in a new browser window, otherwise use a
+random existing one.  A non-nil interactive prefix argument reverses
+the effect of `browse-url-new-window-p'.
+
+When called non-interactively, optional second argument NEW-WINDOW is
+used instead of `browse-url-new-window-p'."
+  (interactive (browse-url-interactive-arg "Mosaic URL: "))
+  (open-network-stream "browse-url" " *browse-url*"
+		       browse-url-CCI-host browse-url-CCI-port)
+  ;; Todo: start browser if fails
+  (process-send-string "browse-url"
+		       (concat "get url (" url ") output "
+			       (if new-window
+				   "new"
+				 "current")
+			       "\r\n"))
+  (process-send-string "browse-url" "disconnect\r\n")
+  (delete-process "browse-url"))
+
+;; --- IXI Mosaic ---
+
+;;;###autoload
+(defun browse-url-iximosaic (url &optional new-window)
+  ;; new-window ignored
+  "Ask the IXIMosaic WWW browser to load URL.
+Default to the URL around or before point."
+  (interactive (browse-url-interactive-arg "IXI Mosaic URL: "))
+  (start-process "tellw3b" nil "tellw3b"
+		 "-service WWW_BROWSER ixi_showurl " url))
+
+;; --- W3 ---
+
+;;;###autoload
+(defun browse-url-w3 (url &optional new-window)
+  "Ask the w3 WWW browser to load URL.
+Default to the URL around or before point.
+
+When called interactively, if variable `browse-url-new-window-p' is
+non-nil, load the document in a new window.  A non-nil interactive
+prefix argument reverses the effect of `browse-url-new-window-p'.
+
+When called non-interactively, optional second argument NEW-WINDOW is
+used instead of `browse-url-new-window-p'."
+  (interactive (browse-url-interactive-arg "W3 URL: "))
+  (require 'w3)				; w3-fetch-other-window not autoloaded
+  (if new-window
+      (w3-fetch-other-window url)
+    (w3-fetch url)))
+
+;;;###autoload
+(defun browse-url-w3-gnudoit (url &optional new-window)
+  ;; new-window ignored
+  "Ask another Emacs running gnuserv to load the URL using the W3 browser.
+The `browse-url-gnudoit-program' program is used with options given by
+`browse-url-gnudoit-args'.  Default to the URL around or before point."
+  (interactive (browse-url-interactive-arg "W3 URL: "))
+    (apply 'start-process (concat "gnudoit:" url) nil
+	   browse-url-gnudoit-program
+	   (append browse-url-gnudoit-args (list (concat "(w3-fetch \"" url "\")") "(raise-frame)"))))
+
+;; --- Lynx in an xterm ---
+
+;;;###autoload
+(defun browse-url-lynx-xterm (url &optional new-window)
+  ;; new-window ignored
+  "Ask the Lynx WWW browser to load URL.
+Default to the URL around or before point.  A new Lynx process is run
+in an Xterm window using the Xterm program named by `browse-url-xterm-program'
+with possible additional arguments `browse-url-xterm-args'."
+  (interactive (browse-url-interactive-arg "Lynx URL: "))
+  (apply #'start-process `(,(concat "lynx" url) nil ,browse-url-xterm-program
+             ,@browse-url-xterm-args "-e" "lynx" ,url)))
+
+;; --- Lynx in an Emacs "term" window ---
+
+;;;###autoload
+(defun browse-url-lynx-emacs (url &optional new-buffer)
+  "Ask the Lynx WWW browser to load URL.
+Default to the URL around or before point.  With a prefix argument, run
+a new Lynx process in a new buffer.
+
+When called interactively, if variable `browse-url-new-window-p' is
+non-nil, load the document in a new lynx in a new term window,
+otherwise use any existing one.  A non-nil interactive prefix argument
+reverses the effect of `browse-url-new-window-p'.
+
+When called non-interactively, optional second argument NEW-WINDOW is
+used instead of `browse-url-new-window-p'."
+  (interactive (browse-url-interactive-arg "Lynx URL: "))
+  (let* ((system-uses-terminfo t)       ; Lynx uses terminfo
+	 ;; (term-term-name "vt100") ; ??
+	 (buf (get-buffer "*lynx*"))
+	 (proc (and buf (get-buffer-process buf)))
+	 (n browse-url-lynx-input-attempts))
+    (if (and new-buffer buf)
+	;; Rename away the OLD buffer. This isn't very polite, but
+	;; term insists on working in a buffer named *lynx* and would
+	;; choke on *lynx*<1>
+	(progn (set-buffer buf)
+	       (rename-uniquely)))
+    (if (or new-buffer
+	    (not buf)
+	    (not proc)
+	    (not (memq (process-status proc) '(run stop))))
+	;; start a new lynx
+	(progn
+          (setq buf
+                (apply #'make-term
+                       `("lynx" "lynx" nil ,@browse-url-lynx-emacs-args ,url)))
+          (switch-to-buffer buf)
+          (term-char-mode)
+          (set-process-sentinel
+           (get-buffer-process buf)
+           ;; Don't leave around a dead one (especially because of its
+           ;; munged keymap.)
+           (lambda (process event)
+             (if (not (memq (process-status process) '(run stop)))
+                 (let ((buf (process-buffer process)))
+                   (if buf (kill-buffer buf)))))))
+      ;; send the url to lynx in the old buffer
+      (let ((win (get-buffer-window buf t)))
+	(if win
+	    (select-window win)
+	  (switch-to-buffer buf)))
+      (if (eq (following-char) ?_)
+	  (cond ((eq browse-url-lynx-input-field 'warn)
+		 (error "Please move out of the input field first."))
+		((eq browse-url-lynx-input-field 'avoid)
+		 (while (and (eq (following-char) ?_) (> n 0))
+		   (term-send-down) ; down arrow
+		   (sit-for browse-url-lynx-input-delay))
+		 (if (eq (following-char) ?_)
+		     (error "Cannot move out of the input field, sorry.")))))
+      (term-send-string proc (concat "g" ; goto
+				     "\C-u" ; kill default url
+				     url
+				     "\r")))))
+
+;; --- MMM ---
+
+;;;###autoload
+(defun browse-url-mmm (url &optional new-window)
+  "Ask the MMM WWW browser to load URL.
+Default to the URL around or before point."
+  (interactive (browse-url-interactive-arg "MMM URL: "))
+  (message "Sending URL to MMM...")
+  (save-excursion
+    (set-buffer (get-buffer-create " *Shell Command Output*"))
+    (erase-buffer)
+    ;; mmm_remote just SEGVs if the file isn't there...
+    (if (or (file-exists-p (expand-file-name "~/.mmm_remote"))
+	    ;; location in v 0.4:
+	    (file-exists-p (expand-file-name "~/.mmm/remote")))
+	(call-process "mmm_remote" nil 0 nil url)
+      (call-process "mmm" nil 0 nil "-external" url))
+    (message "Sending URL to MMM... done")))
+
+;; --- mailto ---
+
+;;;###autoload
+(defun browse-url-mail (url &optional new-window)
+  "Open a new mail message buffer within Emacs.
+Default to using the mailto: URL around or before point as the
+recipient's address.  Supplying a non-nil interactive prefix argument
+will cause the mail to be composed in another window rather than the
+current one.
+
+When called interactively, if variable `browse-url-new-window-p' is
+non-nil use `compose-mail-other-window', otherwise `compose-mail'.  A
+non-nil interactive prefix argument reverses the effect of
+`browse-url-new-window-p'.
+
+When called non-interactively, optional second argument NEW-WINDOW is
+used instead of `browse-url-new-window-p'."
+  (interactive (browse-url-interactive-arg "Mailto URL: "))
+  (save-excursion
+    (let ((to (if (string-match "^mailto:" url)
+		  (substring url 7)
+		url)))
+      (if new-window
+	  (compose-mail-other-window to nil nil nil
+				     (list 'insert-buffer (current-buffer)))
+	(compose-mail to nil nil nil nil
+		      (list 'insert-buffer (current-buffer)))))))
+
+;; --- Random browser ---
+
+;;;###autoload
+(defun browse-url-generic (url &optional new-window)
+  ;; new-window ignored
+  "Ask the WWW browser defined by `browse-url-generic-program' to load URL.
+Default to the URL around or before point.  A fresh copy of the
+browser is started up in a new process with possible additional arguments
+`browse-url-generic-args'.  This is appropriate for browsers which
+don't offer a form of remote control."
+  (interactive (browse-url-interactive-arg "URL: "))
+  (if (not browse-url-generic-program)
+    (error "No browser defined (`browse-url-generic-program')"))
+  (apply 'start-process (concat browse-url-generic-program url) nil
+	 browse-url-generic-program
+	 (append browse-url-generic-args (list url))))
+
+(provide 'browse-url)
+
+;;; browse-url.el ends here
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lisp/net/goto-addr.el	Mon Mar 20 13:12:14 2000 +0000
@@ -0,0 +1,234 @@
+;;; goto-addr.el --- click to browse URL or to send to e-mail address
+
+;; Copyright (C) 1995 Free Software Foundation, Inc.
+
+;; Author: Eric Ding <ericding@mit.edu>
+;; Maintainer: Eric Ding <ericding@mit.edu>
+;; Created: 15 Aug 1995
+;; Keywords: mh-e, www, mouse, mail
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; This package allows you to click or hit a key sequence while on a
+;; URL or e-mail address, and either load the URL into a browser of
+;; your choice using the browse-url package, or if it's an e-mail
+;; address, to send an e-mail to that address.  By default, we bind to
+;; the [mouse-2] and the [C-c return] key sequences.
+
+;; INSTALLATION
+;;
+;; To use goto-address in a particular mode (for example, while
+;; reading mail in mh-e), add something like this in your .emacs file:
+;;
+;; (add-hook 'mh-show-mode-hook 'goto-address)
+;;
+;; The mouse click method is bound to [mouse-2] on highlighted URL's or
+;; e-mail addresses only; it functions normally everywhere else.  To bind
+;; another mouse click to the function, add the following to your .emacs
+;; (for example):
+;;
+;; (setq goto-address-highlight-keymap
+;;   (let ((m (make-sparse-keymap)))
+;;     (define-key m [S-mouse-2] 'goto-address-at-mouse)
+;;     m))
+;;
+
+;; BUG REPORTS
+;;
+;; Please send bug reports to me at ericding@mit.edu.
+
+;; Known bugs/features:
+;; * goto-address-mail-regexp only catches foo@bar.org style addressing,
+;;   not stuff like X.400 addresses, etc.
+;; * regexp also catches Message-Id line, since it is in the format of
+;;   an Internet e-mail address (like Compuserve addresses)
+;; * If show buffer is fontified after goto-address-fontify is run
+;;   (say, using font-lock-fontify-buffer), then font-lock face will
+;;   override goto-address faces.
+
+;;; Code:
+
+(require 'browse-url)
+
+(defgroup goto-address nil
+  "Click to browse URL or to send to e-mail address."
+  :group 'mouse
+  :group 'hypermedia)
+
+
+;;; I don't expect users to want fontify'ing without highlighting.
+(defcustom goto-address-fontify-p t
+  "*If t, URL's and e-mail addresses in buffer are fontified.
+But only if `goto-address-highlight-p' is also non-nil."
+  :type 'boolean
+  :group 'goto-address)
+
+(defcustom goto-address-highlight-p t
+  "*If t, URL's and e-mail addresses in buffer are highlighted."
+  :type 'boolean
+  :group 'goto-address)
+
+(defcustom goto-address-fontify-maximum-size 30000
+  "*Maximum size of file in which to fontify and/or highlight URL's."
+  :type 'integer
+  :group 'goto-address)
+
+(defvar goto-address-mail-regexp
+  "[-a-zA-Z0-9._]+@\\([-a-zA-z0-9_]+\\.\\)+[a-zA-Z0-9]+"
+  "A regular expression probably matching an e-mail address.")
+
+(defvar goto-address-url-regexp
+  (concat "\\b\\(s?https?\\|ftp\\|file\\|gopher\\|news\\|"
+	  "telnet\\|wais\\):\\(//[-a-zA-Z0-9_.]+:"
+	  "[0-9]*\\)?[-a-zA-Z0-9_=?#$@~`%&*+|\\/.,]*"
+	  "[-a-zA-Z0-9_=#$@~`%&*+|\\/]")
+  "A regular expression probably matching a URL.")
+
+(defvar goto-address-highlight-keymap
+  (let ((m (make-sparse-keymap)))
+    (define-key m [mouse-2] 'goto-address-at-mouse)
+    m)
+  "keymap to hold goto-addr's mouse key defs under highlighted URLs.")
+
+(defcustom goto-address-url-face 'bold
+  "*Face to use for URLs."
+  :type 'face
+  :group 'goto-address)
+
+(defcustom goto-address-url-mouse-face 'highlight
+  "*Face to use for URLs when the mouse is on them."
+  :type 'face
+  :group 'goto-address)
+
+(defcustom goto-address-mail-face 'italic
+  "*Face to use for e-mail addresses."
+  :type 'face
+  :group 'goto-address)
+
+(defcustom goto-address-mail-mouse-face 'secondary-selection
+  "*Face to use for e-mail addresses when the mouse is on them."
+  :type 'face
+  :group 'goto-address)
+
+(defun goto-address-fontify ()
+  "Fontify the URL's and e-mail addresses in the current buffer.
+This function implements `goto-address-highlight-p'
+and `goto-address-fontify-p'."
+  (save-excursion
+    (let ((inhibit-read-only t)
+	  (inhibit-point-motion-hooks t)
+	  (modified (buffer-modified-p)))
+      (goto-char (point-min))
+      (if (< (- (point-max) (point)) goto-address-fontify-maximum-size)
+	  (progn
+	    (while (re-search-forward goto-address-url-regexp nil t)
+              (let* ((s (match-beginning 0))
+                     (e (match-end 0))
+                     (this-overlay (make-overlay s e)))
+		(and goto-address-fontify-p
+                     (overlay-put this-overlay 'face goto-address-url-face))
+		(overlay-put this-overlay
+                             'mouse-face goto-address-url-mouse-face)
+		(overlay-put this-overlay
+                             'local-map goto-address-highlight-keymap)))
+	    (goto-char (point-min))
+	    (while (re-search-forward goto-address-mail-regexp nil t)
+              (let* ((s (match-beginning 0))
+                     (e (match-end 0))
+                     (this-overlay (make-overlay s e)))
+		(and goto-address-fontify-p
+                     (overlay-put this-overlay 'face goto-address-mail-face))
+                (overlay-put this-overlay 'mouse-face
+                             goto-address-mail-mouse-face)
+                (overlay-put this-overlay
+                             'local-map goto-address-highlight-keymap)))))
+      (and (buffer-modified-p)
+	   (not modified)
+	   (set-buffer-modified-p nil)))))
+
+;;; code to find and goto addresses; much of this has been blatantly
+;;; snarfed from browse-url.el
+
+;;;###autoload
+(defun goto-address-at-mouse (event)
+  "Send to the e-mail address or load the URL clicked with the mouse.
+Send mail to address at position of mouse click.  See documentation for
+`goto-address-find-address-at-point'.  If no address is found
+there, then load the URL at or before the position of the mouse click."
+  (interactive "e")
+  (save-excursion
+    (let ((posn (event-start event)))
+      (set-buffer (window-buffer (posn-window posn)))
+      (goto-char (posn-point posn))
+      (let ((address
+	     (save-excursion (goto-address-find-address-at-point))))
+	(if (string-equal address "")
+	    (let ((url (browse-url-url-at-point)))
+	      (if (string-equal url "")
+		  (error "No e-mail address or URL found")
+		(browse-url url)))
+            (compose-mail address))))))
+
+;;;###autoload
+(defun goto-address-at-point ()
+  "Send to the e-mail address or load the URL at point.
+Send mail to address at point.  See documentation for
+`goto-address-find-address-at-point'.  If no address is found
+there, then load the URL at or before point."
+  (interactive)
+  (save-excursion
+    (let ((address (save-excursion (goto-address-find-address-at-point))))
+      (if (string-equal address "")
+	  (let ((url (browse-url-url-at-point)))
+	    (if (string-equal url "")
+		(error "No e-mail address or URL found")
+	      (browse-url url)))
+          (compose-mail address)))))
+
+(defun goto-address-find-address-at-point ()
+  "Find e-mail address around or before point.
+Then search backwards to beginning of line for the start of an e-mail
+address.  If no e-mail address found, return the empty string."
+  (let ((bol (save-excursion (beginning-of-line) (point))))
+    (re-search-backward "[^-_A-z0-9.@]" bol 'lim)
+    (if (or (looking-at goto-address-mail-regexp)  ; already at start
+	    (let ((eol (save-excursion (end-of-line) (point))))
+	      (and (re-search-forward goto-address-mail-regexp eol 'lim)
+		   (goto-char (match-beginning 0)))))
+	(buffer-substring (match-beginning 0) (match-end 0))
+      "")))m
+
+;;;###autoload
+(defun goto-address ()
+  "Sets up goto-address functionality in the current buffer.
+Allows user to use mouse/keyboard command to click to go to a URL
+or to send e-mail.
+By default, goto-address binds to mouse-2 and C-c RET.
+
+Also fontifies the buffer appropriately (see `goto-address-fontify-p' and
+`goto-address-highlight-p' for more information)."
+  (interactive)
+  (local-set-key "\C-c\r" 'goto-address-at-point)
+  (if goto-address-highlight-p
+      (goto-address-fontify)))
+
+(provide 'goto-addr)
+
+;;; goto-addr.el ends here.
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lisp/net/net-utils.el	Mon Mar 20 13:12:14 2000 +0000
@@ -0,0 +1,858 @@
+;;; net-utils.el --- Network functions
+
+;; Author:  Peter Breton <pbreton@cs.umb.edu>
+;; Created: Sun Mar 16 1997
+;; Keywords: network communications
+;; Time-stamp: <1999-11-13 10:19:01 pbreton>
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+;;
+;; There are three main areas of functionality:
+;; 
+;; * Wrap common network utility programs (ping, traceroute, netstat,
+;; nslookup, arp, route). Note that these wrappers are of the diagnostic
+;; functions of these programs only.
+;; 
+;; * Implement some very basic protocols in Emacs Lisp (finger and whois)
+;; 
+;; * Support connections to HOST/PORT, generally for debugging and the like.
+;; In other words, for doing much the same thing as "telnet HOST PORT", and
+;; then typing commands.
+;;
+;; PATHS
+;;
+;; On some systems, some of these programs are not in normal user path,
+;; but rather in /sbin, /usr/sbin, and so on. 
+
+
+;;; Code:
+(eval-when-compile
+  (require 'comint))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Customization Variables
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defgroup net-utils nil
+  "Network utility functions."
+  :prefix "net-utils-"
+  :group 'comm
+  :version "20.3"
+  )
+
+(defcustom net-utils-remove-ctl-m 
+  (member system-type (list 'windows-nt 'msdos))
+  "If non-nil, remove control-Ms from output."
+  :group 'net-utils
+  :type  'boolean
+  )
+
+(defcustom traceroute-program  
+  (if (eq system-type 'windows-nt) 
+      "tracert"
+    "traceroute")
+  "Program to trace network hops to a destination."
+  :group 'net-utils
+  :type  'string
+  )
+
+(defcustom traceroute-program-options nil
+  "Options for the traceroute program."
+  :group 'net-utils
+  :type  '(repeat string)
+  )
+
+(defcustom ping-program "ping"
+  "Program to send network test packets to a host."
+  :group 'net-utils
+  :type  'string
+  )
+
+;; On Linux and Irix, the system's ping program seems to send packets
+;; indefinitely unless told otherwise
+(defcustom ping-program-options 
+  (and (memq system-type (list 'linux 'gnu/linux 'irix))
+       (list "-c" "4"))
+  "Options for the ping program.
+These options can be used to limit how many ICMP packets are emitted."
+  :group 'net-utils
+  :type  '(repeat string)
+  )
+
+(defcustom ipconfig-program  
+  (if (eq system-type 'windows-nt)
+      "ipconfig"
+    "ifconfig")
+  "Program to print network configuration information."
+  :group 'net-utils
+  :type  'string
+  )
+
+(defcustom ipconfig-program-options
+   (list    
+    (if (eq system-type 'windows-nt)
+	"/all" "-a"))
+  "Options for ipconfig-program."
+  :group 'net-utils
+  :type  '(repeat string)
+  )
+
+(defcustom netstat-program  "netstat"
+  "Program to print network statistics."
+  :group 'net-utils
+  :type  'string
+  )
+
+(defcustom netstat-program-options 
+  (list "-a")
+  "Options for netstat-program."
+  :group 'net-utils
+  :type  '(repeat string)
+  )
+
+(defcustom arp-program  "arp"
+  "Program to print IP to address translation tables."
+  :group 'net-utils
+  :type  'string
+  )
+
+(defcustom arp-program-options 
+  (list "-a")
+  "Options for arp-program."
+  :group 'net-utils
+  :type  '(repeat string)
+  )
+
+(defcustom route-program  
+  (if (eq system-type 'windows-nt)
+      "route"
+    "netstat")
+  "Program to print routing tables."
+  :group 'net-utils
+  :type  'string
+  )
+
+(defcustom route-program-options 
+  (if (eq system-type 'windows-nt)
+      (list "print")
+    (list "-r"))
+  "Options for route-program."
+  :group 'net-utils
+  :type  '(repeat string)
+  )
+
+(defcustom nslookup-program  "nslookup"
+  "Program to interactively query DNS information."
+  :group 'net-utils
+  :type  'string
+  )
+
+(defcustom nslookup-program-options  nil
+  "List of options to pass to the nslookup program."
+  :group 'net-utils
+  :type  '(repeat string)
+  )
+
+(defcustom nslookup-prompt-regexp "^> "
+  "Regexp to match the nslookup prompt."
+  :group 'net-utils
+  :type  'regexp
+  )
+
+(defcustom dig-program  "dig"
+  "Program to query DNS information."
+  :group 'net-utils
+  :type  'string
+  )
+
+(defcustom ftp-program "ftp"
+  "Progam to run to do FTP transfers."
+  :group 'net-utils
+  :type  'string
+  )
+
+(defcustom ftp-program-options nil
+  "List of options to pass to the FTP program."
+  :group 'net-utils
+  :type  '(repeat string)
+  )
+
+(defcustom ftp-prompt-regexp "^ftp>"
+  "Regexp which matches the FTP program's prompt."
+  :group 'net-utils
+  :type  'regexp
+  )
+
+(defcustom smbclient-program "smbclient"
+  "Smbclient program."
+  :group 'net-utils
+  :type  'string
+  )
+
+(defcustom smbclient-program-options nil
+  "List of options to pass to the smbclient program."
+  :group 'net-utils
+  :type  '(repeat string)
+  )
+
+(defcustom smbclient-prompt-regexp "^smb: \>"
+  "Regexp which matches the smbclient program's prompt."
+  :group 'net-utils
+  :type  'regexp
+  )
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Nslookup goodies
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defconst nslookup-font-lock-keywords
+  (and window-system
+       (progn
+	 (require 'font-lock)
+	 (list
+	  (list nslookup-prompt-regexp 0 font-lock-reference-face)
+	  (list "^[A-Za-z0-9 _]+:"     0 font-lock-type-face)
+	  (list "\\<\\(SOA\\|NS\\|MX\\|A\\|CNAME\\)\\>" 
+		1 font-lock-keyword-face)
+	  ;; Dotted quads
+	  (list 
+	   (mapconcat 'identity
+		      (make-list 4 "[0-9]+")
+		      "\\.")
+	   0 font-lock-variable-name-face)
+	  ;; Host names
+	  (list 
+	   (let ((host-expression "[-A-Za-z0-9]+"))
+	     (concat 
+	      (mapconcat 'identity
+			 (make-list 2 host-expression)
+			 "\\.")
+	      "\\(\\." host-expression "\\)*")
+	     )
+	   0 font-lock-variable-name-face)
+	  )))
+	 "Expressions to font-lock for nslookup.")
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; FTP goodies
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defconst ftp-font-lock-keywords
+  (and window-system
+       (progn
+	 (require 'font-lock)
+	 (list
+	  (list ftp-prompt-regexp 0 font-lock-reference-face)))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; smbclient goodies
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(defconst smbclient-font-lock-keywords
+  (and window-system
+       (progn
+	 (require 'font-lock)
+	 (list
+	  (list smbclient-prompt-regexp 0 font-lock-reference-face)))))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Utility functions
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;; Simplified versions of some at-point functions from ffap.el.
+;; It's not worth loading all of ffap just for these.
+(defun net-utils-machine-at-point ()
+  (let ((pt (point)))
+    (buffer-substring-no-properties
+     (save-excursion
+       (skip-chars-backward "-a-zA-Z0-9.")
+       (point))
+     (save-excursion
+       (skip-chars-forward "-a-zA-Z0-9.")
+       (skip-chars-backward "." pt)
+       (point)))))
+
+(defun net-utils-url-at-point ()
+  (let ((pt (point)))
+    (buffer-substring-no-properties
+     (save-excursion
+       (skip-chars-backward "--:=&?$+@-Z_a-z~#,%")
+       (skip-chars-forward "^A-Za-z0-9" pt)
+       (point))
+     (save-excursion
+       (skip-chars-forward "--:=&?$+@-Z_a-z~#,%")
+       (skip-chars-backward ":;.,!?" pt)
+       (point)))))
+
+
+(defun net-utils-remove-ctrl-m-filter (process output-string)
+  "Remove trailing control Ms."
+  (let ((old-buffer (current-buffer))
+	(filtered-string output-string))
+    (unwind-protect
+	(let ((moving))
+	  (set-buffer (process-buffer process))
+	  (setq moving (= (point) (process-mark process)))
+	  
+	  (while (string-match "\r" filtered-string)
+	       (setq filtered-string
+		     (replace-match "" nil nil filtered-string)))
+
+	  (save-excursion
+	    ;; Insert the text, moving the process-marker.
+	    (goto-char (process-mark process))
+	    (insert filtered-string)
+	    (set-marker (process-mark process) (point)))
+	  (if moving (goto-char (process-mark process))))
+      (set-buffer old-buffer))))
+  
+(defmacro net-utils-run-program (name header program &rest args)
+  "Run a network information program."
+  ` (let ((buf (get-buffer-create (concat "*" ,name "*"))))
+      (set-buffer buf)
+      (erase-buffer)
+      (insert ,header "\n")
+      (set-process-filter 
+       (apply 'start-process ,name buf ,program ,@args)
+       'net-utils-remove-ctrl-m-filter)
+      (display-buffer buf)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Wrappers for external network programs
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;;;###autoload
+(defun traceroute (target)
+  "Run traceroute program for TARGET."
+  (interactive "sTarget: ")
+  (let ((options 
+	 (if traceroute-program-options
+	     (append traceroute-program-options (list target))
+	   (list target))))
+    (net-utils-run-program
+     (concat "Traceroute" " " target)
+     (concat "** Traceroute ** " traceroute-program " ** " target)
+     traceroute-program
+     options
+     )))
+
+;;;###autoload
+(defun ping (host)
+  "Ping HOST.
+If your system's ping continues until interrupted, you can try setting 
+`ping-program-options'."
+  (interactive 
+   (list (read-from-minibuffer "Ping host: " (net-utils-machine-at-point))))
+  (let ((options 
+	 (if ping-program-options
+	     (append ping-program-options (list host))
+	   (list host))))
+    (net-utils-run-program
+     (concat "Ping" " " host)
+     (concat "** Ping ** " ping-program " ** " host)
+     ping-program
+     options
+     )))
+
+;;;###autoload
+(defun ipconfig ()
+  "Run ipconfig program."
+  (interactive)
+  (net-utils-run-program
+   "Ipconfig"
+   (concat "** Ipconfig ** " ipconfig-program " ** ")
+   ipconfig-program
+   ipconfig-program-options
+   ))
+
+;; This is the normal name on most Unixes.
+;;;###autoload
+(defalias 'ifconfig 'ipconfig) 
+
+;;;###autoload
+(defun netstat ()
+  "Run netstat program."
+  (interactive)
+  (net-utils-run-program
+   "Netstat"
+   (concat "** Netstat ** " netstat-program " ** ")
+   netstat-program
+   netstat-program-options
+   ))
+
+;;;###autoload
+(defun arp ()
+  "Run the arp program."
+  (interactive)
+  (net-utils-run-program
+   "Arp"
+   (concat "** Arp ** " arp-program " ** ")
+   arp-program
+   arp-program-options
+   ))
+
+;;;###autoload
+(defun route ()
+  "Run the route program."
+  (interactive)
+  (net-utils-run-program
+   "Route"
+   (concat "** Route ** " route-program " ** ")
+   route-program
+   route-program-options
+   ))
+
+;; FIXME -- Needs to be a process filter
+;; (defun netstat-with-filter (filter)
+;;   "Run netstat program."
+;;   (interactive "sFilter: ")
+;;   (netstat)
+;;   (set-buffer (get-buffer "*Netstat*"))
+;;   (goto-char (point-min))
+;;   (delete-matching-lines filter)
+;;   )
+
+;;;###autoload
+(defun nslookup-host (host)
+  "Lookup the DNS information for HOST."
+  (interactive
+   (list (read-from-minibuffer "Lookup host: " (net-utils-machine-at-point))))
+  (let ((options 
+	 (if nslookup-program-options
+	     (append nslookup-program-options (list host))
+	   (list host))))
+    (net-utils-run-program
+     "Nslookup"
+     (concat "** "
+      (mapconcat 'identity
+		(list "Nslookup" host nslookup-program)
+		" ** "))
+     nslookup-program
+     options
+     )))
+
+
+;;;###autoload
+(defun nslookup ()
+  "Run nslookup program."
+  (interactive)
+  (require 'comint)
+  (comint-run nslookup-program)
+  (set-process-filter (get-buffer-process "*nslookup*")
+   'net-utils-remove-ctrl-m-filter)
+  (nslookup-mode)
+  )
+
+;; Using a derived mode gives us keymaps, hooks, etc.
+(define-derived-mode 
+  nslookup-mode comint-mode "Nslookup"
+  "Major mode for interacting with the nslookup program."
+  (set 
+   (make-local-variable 'font-lock-defaults)
+   '((nslookup-font-lock-keywords)))
+  (setq local-abbrev-table nslookup-mode-abbrev-table)
+  (abbrev-mode t)
+  (make-local-variable 'comint-prompt-regexp)
+  (setq comint-prompt-regexp nslookup-prompt-regexp)
+  (make-local-variable 'comint-input-autoexpand)
+  (setq comint-input-autoexpand t)
+  )
+
+(define-key nslookup-mode-map "\t" 'comint-dynamic-complete)
+
+(define-abbrev nslookup-mode-abbrev-table "e"   "exit")
+(define-abbrev nslookup-mode-abbrev-table "f"   "finger")
+(define-abbrev nslookup-mode-abbrev-table "h"   "help")
+(define-abbrev nslookup-mode-abbrev-table "lse" "lserver")
+(define-abbrev nslookup-mode-abbrev-table "q"   "exit")
+(define-abbrev nslookup-mode-abbrev-table "r"   "root")
+(define-abbrev nslookup-mode-abbrev-table "s"   "set")
+(define-abbrev nslookup-mode-abbrev-table "se"  "server")
+(define-abbrev nslookup-mode-abbrev-table "v"   "viewer")
+
+;;;###autoload
+(defun dig (host)
+  "Run dig program."
+  (interactive
+   (list
+    (progn
+      (require 'ffap)
+      (read-from-minibuffer 
+       "Lookup host: " 
+       (or (ffap-string-at-point 'machine) "")))))
+  (net-utils-run-program
+   "Dig"
+   (concat "** "
+	   (mapconcat 'identity
+		      (list "Dig" host dig-program)
+		      " ** "))
+   dig-program
+   (list host)
+   )) 
+
+;; This is a lot less than ange-ftp, but much simpler.
+;;;###autoload
+(defun ftp (host)
+  "Run ftp program."
+  (interactive 
+   (list
+    (read-from-minibuffer 
+     "Ftp to Host: " (net-utils-machine-at-point))))
+  (require 'comint)
+  (let ((buf (get-buffer-create (concat "*ftp [" host "]*"))))
+    (set-buffer buf)
+    (comint-mode)
+    (comint-exec buf (concat "ftp-" host) ftp-program nil
+		 (if ftp-program-options
+		     (append (list host) ftp-program-options)
+		   (list host)))
+    (ftp-mode)
+    (switch-to-buffer-other-window buf)
+    ))
+
+(define-derived-mode 
+  ftp-mode comint-mode "FTP"
+  "Major mode for interacting with the ftp program."
+
+  (set 
+   (make-local-variable 'font-lock-defaults)
+   '((ftp-font-lock-keywords)))
+  
+  (make-local-variable 'comint-prompt-regexp)
+  (setq comint-prompt-regexp ftp-prompt-regexp)
+  
+  (make-local-variable 'comint-input-autoexpand)
+  (setq comint-input-autoexpand t)
+  
+  ;; Already buffer local!
+  (setq comint-output-filter-functions
+	(list 'comint-watch-for-password-prompt))
+  
+  (setq local-abbrev-table ftp-mode-abbrev-table)
+  (abbrev-mode t)
+  )
+
+(define-abbrev ftp-mode-abbrev-table "q"    "quit")
+(define-abbrev ftp-mode-abbrev-table "g"    "get")
+(define-abbrev ftp-mode-abbrev-table "p"    "prompt")
+(define-abbrev ftp-mode-abbrev-table "anon" "anonymous")
+
+;; Occasionally useful
+(define-key ftp-mode-map "\t" 'comint-dynamic-complete)
+
+(defun smbclient (host service)
+  "Connect to SERVICE on HOST via SMB."
+  (interactive 
+   (list
+    (read-from-minibuffer 
+     "Connect to Host: " (net-utils-machine-at-point))
+    (read-from-minibuffer "SMB Service: ")))
+  (require 'comint)
+  (let* ((name (format "smbclient [%s\\%s]" host service))
+	 (buf (get-buffer-create (concat "*" name "*")))
+	 (service-name (concat "\\\\" host "\\" service)))
+    (set-buffer buf)
+    (comint-mode)
+    (comint-exec buf name smbclient-program nil
+		 (if smbclient-program-options
+		     (append (list service-name) smbclient-program-options)
+		   (list service-name)))
+    (smbclient-mode)
+    (switch-to-buffer-other-window buf)
+    ))
+
+(defun smbclient-list-shares (host)
+  "List services on HOST."
+  (interactive 
+   (list
+    (read-from-minibuffer 
+     "Connect to Host: " (net-utils-machine-at-point))
+    ))
+  (let ((buf (get-buffer-create (format "*SMB Shares on %s*" host))))
+    (set-buffer buf)
+    (comint-mode)
+    (comint-exec 
+     buf 
+     "smbclient-list-shares" 
+     smbclient-program 
+     nil
+     (list "-L" host)
+     )
+    (smbclient-mode)
+    (switch-to-buffer-other-window buf)))
+  
+(define-derived-mode 
+  smbclient-mode comint-mode "smbclient"
+  "Major mode for interacting with the smbclient program."
+
+  (set 
+   (make-local-variable 'font-lock-defaults)
+   '((smbclient-font-lock-keywords)))
+  
+  (make-local-variable 'comint-prompt-regexp)
+  (setq comint-prompt-regexp smbclient-prompt-regexp)
+  
+  (make-local-variable 'comint-input-autoexpand)
+  (setq comint-input-autoexpand t)
+  
+  ;; Already buffer local!
+  (setq comint-output-filter-functions
+	(list 'comint-watch-for-password-prompt))
+  
+  (setq local-abbrev-table smbclient-mode-abbrev-table)
+  (abbrev-mode t)
+  )
+
+(define-abbrev smbclient-mode-abbrev-table "q"    "quit")
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Network Connections
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;; Full list is available at:
+;; ftp://ftp.isi.edu/in-notes/iana/assignments/port-numbers
+(defvar network-connection-service-alist 
+  (list
+    (cons 'echo          7)
+    (cons 'active-users 11)
+    (cons 'daytime      13)
+    (cons 'chargen      19)
+    (cons 'ftp          21)
+    (cons 'telnet	23)
+    (cons 'smtp		25)
+    (cons 'time		37)
+    (cons 'whois        43)
+    (cons 'gopher       70)
+    (cons 'finger       79)
+    (cons 'www		80)
+    (cons 'pop2		109)
+    (cons 'pop3		110)
+    (cons 'sun-rpc	111)
+    (cons 'nntp		119)
+    (cons 'ntp		123)
+    (cons 'netbios-name 137)
+    (cons 'netbios-data 139)
+    (cons 'irc		194)
+    (cons 'https	443)
+    (cons 'rlogin	513)
+    )
+  "Alist of services and associated TCP port numbers.
+This list in not complete.")
+
+;; Workhorse macro
+(defmacro run-network-program (process-name host port 
+					    &optional initial-string)
+  `
+   (let ((tcp-connection)
+	 (buf)
+	 )
+    (setq buf (get-buffer-create (concat "*" ,process-name "*")))
+    (set-buffer buf)
+    (or 
+     (setq tcp-connection
+	   (open-network-stream 
+	    ,process-name
+	    buf
+	    ,host
+	    ,port
+	    ))
+     (error "Could not open connection to %s" ,host))
+    (erase-buffer)
+    (set-marker (process-mark tcp-connection) (point-min))
+    (set-process-filter tcp-connection 'net-utils-remove-ctrl-m-filter)
+    (and ,initial-string
+	 (process-send-string tcp-connection 
+			      (concat ,initial-string "\r\n")))
+    (display-buffer buf)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Simple protocols
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;; Finger protocol
+;;;###autoload
+(defun finger (user host)
+  "Finger USER on HOST."
+  ;; One of those great interactive statements that's actually
+  ;; longer than the function call! The idea is that if the user
+  ;; uses a string like "pbreton@cs.umb.edu", we won't ask for the
+  ;; host name. If we don't see an "@", we'll prompt for the host.
+  (interactive
+    (let* ((answer (read-from-minibuffer "Finger User: "
+					 (net-utils-url-at-point)))
+	   (index  (string-match (regexp-quote "@") answer)))
+      (if index
+	  (list 
+	   (substring answer 0 index)
+	   (substring answer (1+ index)))
+	(list
+	 answer
+	 (read-from-minibuffer "At Host: " (net-utils-machine-at-point))))))
+  (let* (
+	 (user-and-host (concat user "@" host))
+	 (process-name 
+	  (concat "Finger [" user-and-host "]"))
+	 )
+    (run-network-program 
+     process-name 
+     host 
+     (cdr (assoc 'finger network-connection-service-alist))
+     user-and-host
+     )))
+
+(defcustom whois-server-name "rs.internic.net"
+  "Default host name for the whois service."
+  :group 'net-utils
+  :type  'string
+  )
+
+(defcustom whois-server-list
+  '(("whois.arin.net")     ; Networks, ASN's, and related POC's (numbers)
+    ("rs.internic.net")  ; domain related info
+    ("whois.abuse.net")
+    ("whois.apnic.net")
+    ("nic.ddn.mil")
+    ("whois.nic.mil")
+    ("whois.nic.gov")
+    ("whois.ripe.net"))
+  "A list of whois servers that can be queried."
+  :group 'net-utils
+  :type '(repeat (list string)))
+
+(defcustom whois-server-tld
+  '(("rs.internic.net" . "com")
+    ("rs.internic.net" . "org")
+    ("whois.ripe.net" . "be")
+    ("whois.ripe.net" . "de")
+    ("whois.ripe.net" . "dk")
+    ("whois.ripe.net" . "it")
+    ("whois.ripe.net" . "fi")
+    ("whois.ripe.net" . "fr")
+    ("whois.ripe.net" . "uk")
+    ("whois.apnic.net" . "au")
+    ("whois.apnic.net" . "ch")
+    ("whois.apnic.net" . "hk")
+    ("whois.apnic.net" . "jp")
+    ("whois.nic.gov" . "gov")
+    ("whois.nic.mil" . "mil"))
+  "Alist to map top level domains to whois servers."
+  :group 'net-utils
+  :type '(repeat (cons string string)))
+
+(defcustom whois-guess-server t
+  "If non-nil then whois will try to deduce the appropriate whois
+server from the query.  If the query doesn't look like a domain or hostname
+then the server named by whois-server-name is used."
+  :group 'net-utils
+  :type 'boolean)
+
+(defun whois-get-tld (host)
+  "Return the top level domain of `host', or nil if it isn't a domain name."
+  (let ((i (1- (length host)))
+	(max-len (- (length host) 5)))
+    (while (not (or (= i max-len) (char-equal (aref host i) ?.)))
+      (setq i (1- i)))
+    (if (= i max-len)
+	nil
+      (substring host (1+ i)))))
+
+;; Whois protocol
+;;;###autoload
+(defun whois (arg search-string)
+  "Send SEARCH-STRING to server defined by the `whois-server-name' variable.
+If `whois-guess-server' is non-nil, then try to deduce the correct server
+from SEARCH-STRING.  With argument, prompt for whois server."
+  (interactive "P\nsWhois: ")
+  (let* ((whois-apropos-host (if whois-guess-server
+				 (rassoc (whois-get-tld search-string)
+					 whois-server-tld)
+			       nil))
+	 (server-name (if whois-apropos-host
+			  (car whois-apropos-host)
+			whois-server-name))
+	 (host
+	  (if arg
+	      (completing-read "Whois server name: "
+			       whois-server-list nil nil "whois.")
+	    server-name)))
+    (run-network-program 
+     "Whois"
+     host
+     (cdr (assoc 'whois network-connection-service-alist))
+     search-string
+     )))
+
+(defcustom whois-reverse-lookup-server "whois.arin.net"
+  "Server which provides inverse DNS mapping."
+  :group 'net-utils
+  :type  'string
+  )
+
+;;;###autoload
+(defun whois-reverse-lookup ()
+  (interactive)
+  (let ((whois-server-name whois-reverse-lookup-server))
+    (call-interactively 'whois)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;; General Network connection
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+;;;###autoload
+(defun network-connection-to-service (host service)
+  "Open a network connection to SERVICE on HOST."
+  (interactive 
+   (list
+    (read-from-minibuffer "Host: " (net-utils-machine-at-point))
+    (completing-read "Service: " 
+		     (mapcar 
+		      (function 
+		       (lambda (elt)
+			 (list (symbol-name (car elt)))))
+		      network-connection-service-alist))))
+  (network-connection 
+   host 
+   (cdr (assoc (intern service) network-connection-service-alist)))
+  )
+
+;;;###autoload
+(defun network-connection (host port)
+  "Open a network connection to HOST on PORT."
+  (interactive "sHost: \nnPort: ")
+  (network-service-connection host (number-to-string port)))
+
+(defun network-service-connection (host service)
+  "Open a network connection to SERVICE on HOST."
+  (require 'comint)
+  (let (
+	(process-name (concat "Network Connection [" host " " service "]"))
+	(portnum (string-to-number service))
+	)
+    (or (zerop portnum) (setq service portnum))
+    (make-comint 
+     process-name
+     (cons host service))
+    (pop-to-buffer (get-buffer (concat "*" process-name "*")))
+    ))
+
+(provide 'net-utils)
+
+;;; net-utils.el ends here
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lisp/net/quickurl.el	Mon Mar 20 13:12:14 2000 +0000
@@ -0,0 +1,552 @@
+;;; quickurl.el --- Insert an URL based on text at point in buffer.
+
+;; Copyright (C) 1999 Free Software Foundation, Inc.
+
+;; Author: Dave Pearson <davep@hagbard.demon.co.uk>
+;; Maintainer: Dave Pearson <davep@hagbard.demon.co.uk>
+;; Created: 1999-05-28
+;; Keywords: hypermedia
+
+;; This file is part of GNU emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+;;
+;; This package provides a simple method of inserting an URL based on the
+;; text at point in the current buffer. This is part of an on-going effort
+;; to increase the information I provide people while reducing the ammount
+;; of typing I need to do. No-doubt there are undiscovered Emacs packages
+;; out there that do all of this and do it better, feel free to point me to
+;; them, in the mean time I'm having fun playing with Emacs Lisp.
+;;
+;; The URLs are stored in an external file as a list of either cons cells,
+;; or lists. A cons cell entry looks like this:
+;;
+;;    (<Lookup> . <URL>)
+;;
+;; where <Lookup> is a string that acts as the keyword lookup and <URL> is
+;; the URL associated with it. An example might be:
+;;
+;;    ("GNU" . "http://www.gnu.org/")
+;;
+;; A list entry looks like:
+;;
+;;    (<Lookup> <URL> <Comment>)
+;;
+;; where <Lookup> and <URL> are the same as with the cons cell and <Comment>
+;; is any text you like that describes the URL. This description will be
+;; used when presenting a list of URLS using `quickurl-list'. An example
+;; might be:
+;;
+;;    ("FSF" "http://www.fsf.org/" "The Free Software Foundation")
+;;
+;; Given the above, your quickurl file might look like:
+;;
+;; (("GNU"    . "http://www.gnu.org/")
+;;  ("FSF"      "http://www.fsf.org/" "The Free Software Foundation")
+;;  ("emacs"  . "http://www.emacs.org/")
+;;  ("hagbard"  "http://www.hagbard.demon.co.uk" "Hagbard's World"))
+;;
+;; In case you're wondering about the mixture of cons cells and lists,
+;; quickurl started life using just the cons cells, there were no comments.
+;; URL comments are a later addition and so there is a mixture to keep
+;; backward compatibility with existing URL lists.
+;;
+;; The name and location of the file is up to you, the default name used by
+;; `quickurl' is stored in `quickurl-url-file'.
+;;
+;; quickurl is always available from:
+;;
+;;   <URL:http://www.hagbard.demon.co.uk/archives/quickurl.el>
+;;   <URL:http://www.acemake.com/hagbard/archives/quickurl.el>
+
+;;; TODO:
+;;
+;; o The quickurl-browse-url* functions pretty much duplicate their non
+;;   browsing friends. It would feel better if a more generic solution could
+;;   be found.
+
+;;; Code:
+
+;; Things we need:
+
+(eval-when-compile
+  (require 'cl))
+(require 'thingatpt)
+(require 'pp)
+(require 'browse-url)
+
+;; Attempt to handle older/other emacs.
+(eval-and-compile
+  ;; If customize isn't available just use defvar instead.
+  (unless (fboundp 'defgroup)
+    (defmacro defgroup  (&rest rest) nil)
+    (defmacro defcustom (symbol init docstring &rest rest)
+      `(defvar ,symbol ,init ,docstring))))
+
+;; Customize options.
+
+(defgroup quickurl nil
+  "Insert an URL based on text at point in buffer."
+  :version "21.1"
+  :group  'abbrev
+  :prefix "quickurl-")
+
+(defcustom quickurl-url-file "~/.quickurls"
+  "*File that contains the URL list."
+  :type  'file
+  :group 'quickurl)
+
+(defcustom quickurl-format-function (lambda (url) (format "<URL:%s>" url))
+  "*Function to format the URL before insertion into the current buffer."
+  :type  'function
+  :group 'quickurl)
+
+(defcustom quickurl-sort-function (lambda (list)
+                                    (sort list
+                                          (lambda (x y)
+                                            (string<
+                                             (downcase (quickurl-url-description x))
+                                             (downcase (quickurl-url-description y))))))
+  "*Function to sort the URL list."
+  :type  'function
+  :group 'quickurl)
+
+(defcustom quickurl-grab-lookup-function #'current-word
+  "*Function to grab the thing to lookup."
+  :type  'function
+  :group 'quickurl)
+
+(defcustom quickurl-assoc-function #'assoc-ignore-case
+  "*Function to use for alist lookup into `quickurl-urls'."
+  :type  'function
+  :group 'quickurl)
+
+(defcustom quickurl-completion-ignore-case t
+  "*Should `quickurl-ask' ignore case when doing the input lookup?"
+  :type  'boolean
+  :group 'quickurl)
+
+(defcustom quickurl-prefix ";; -*- lisp -*-\n\n"
+  "*Text to write to `quickurl-url-file' before writing the URL list."
+  :type  'string
+  :group 'quickurl)
+
+(defcustom quickurl-postfix ""
+  "*Text to write to `quickurl-url-file' after writing the URL list.
+
+See the constant `quickurl-reread-hook-postfix' for some example text that
+could be used here."
+  :type  'string
+  :group 'quickurl)
+
+(defcustom quickurl-list-mode-hook nil
+  "*Hooks for `quickurl-list-mode'."
+  :type  'hook
+  :group 'quickurl)
+
+;; Constants.
+
+;;;###autoload
+(defconst quickurl-reread-hook-postfix
+    "
+;; Local Variables:
+;; eval: (progn (require 'quickurl) (add-hook 'local-write-file-hooks (lambda () (quickurl-read) nil)))
+;; End:
+"
+  "Example `quickurl-postfix' text that adds a local variable to the
+`quickurl-url-file' so that if you edit it by hand it will ensure that
+`quickurl-urls' is updated with the new URL list.
+
+To make use of this do something like:
+
+  (setq quickurl-postfix quickurl-reread-hook-postfix)
+
+in your ~/.emacs (after loading/requiring quickurl).")
+
+;; Non-customize variables.
+
+(defvar quickurl-urls nil
+  "URL alist for use with `quickurl' and `quickurl-ask'.")
+
+(defvar quickurl-list-mode-map nil
+  "Local keymap for a `quickurl-list-mode' buffer.")
+
+(defvar quickurl-list-buffer-name "*quickurl-list*"
+  "Name for the URL listinig buffer.")
+
+(defvar quickurl-list-last-buffer nil
+  "`current-buffer' when `quickurl-list' was called.")
+
+;; Functions for working with an URL entry.
+
+(defun quickurl-url-commented-p (url)
+  "Does the URL have a comment?"
+  (listp (cdr url)))
+
+(defun quickurl-make-url (keyword url &optional comment)
+  "Create an URL from KEYWORD, URL and (optionaly) COMMENT."
+  (if (and comment (not (zerop (length comment))))
+      (list keyword url comment)
+    (cons keyword url)))
+
+(defun quickurl-url-keyword (url)
+  "Return the keyword for the URL.
+
+Note that this function is a setfable place."
+  (car url))
+
+(defsetf quickurl-url-keyword (url) (store)
+  `(setf (car ,url) ,store))
+
+(defun quickurl-url-url (url)
+  "Return the actual URL of the URL.
+
+Note that this function is a setfable place."
+  (if (quickurl-url-commented-p url)
+      (cadr url)
+    (cdr url)))
+
+(defsetf quickurl-url-url (url) (store)
+  `
+  (if (quickurl-url-commented-p ,url)
+      (setf (cadr ,url) ,store)
+    (setf (cdr ,url) ,store)))
+
+(defun quickurl-url-comment (url)
+  "Get the comment from an URL.
+
+If the URL has no comment an empty string is returned. Also note that this
+function is a setfable place."
+  (if (quickurl-url-commented-p url)
+      (nth 2 url)
+    ""))
+
+(defsetf quickurl-url-comment (url) (store)
+  `
+  (if (quickurl-url-commented-p ,url)
+      (if (zerop (length ,store))
+          (setf (cdr ,url) (cadr ,url))
+        (setf (nth 2 ,url) ,store))
+    (unless (zerop (length ,store))
+      (setf (cdr ,url) (list (cdr ,url) ,store)))))
+
+(defun quickurl-url-description (url)
+  "Return a description for the URL.
+
+If the URL has a comment then this is returned, otherwise the keyword is
+returned."
+  (let ((desc (quickurl-url-comment url)))
+    (if (zerop (length desc))
+        (quickurl-url-keyword url)
+      desc)))
+
+;; Main code:
+
+(defun* quickurl-read (&optional (buffer (current-buffer)))
+  "`read' the URL list from BUFFER into `quickurl-urls'.
+
+Note that this function moves point to `point-min' before doing the `read'
+It also restores point after the `read'."
+  (save-excursion
+    (setf (point) (point-min))
+    (setq quickurl-urls (funcall quickurl-sort-function (read buffer)))))
+                       
+(defun quickurl-load-urls ()
+  "Load the contents of `quickurl-url-file' into `quickurl-urls'."
+  (when (file-exists-p quickurl-url-file)
+    (with-temp-buffer
+      (insert-file-contents quickurl-url-file)
+      (quickurl-read))))
+
+(defun quickurl-save-urls ()
+  "Save the contents of `quickurl-urls' to `quickurl-url-file'."
+  (with-temp-buffer
+    (let ((standard-output (current-buffer)))
+      (princ quickurl-prefix)
+      (pp quickurl-urls)
+      (princ quickurl-postfix)
+      (write-region (point-min) (point-max) quickurl-url-file nil 0))))
+  
+(defun quickurl-find-url (lookup)
+  "Return URL associated with key LOOKUP.
+
+The lookup is done by looking in the alist `quickurl-urls' and the `cons'
+for the URL is returned. The actual method used to look into the alist
+depends on the setting of the variable `quickurl-assoc-function'."
+  (funcall quickurl-assoc-function lookup quickurl-urls))
+
+(defun quickurl-insert (url &optional silent)
+  "Insert URL, formatted using `quickurl-format-function'.
+
+Also display a `message' saying what the URL was unless SILENT is non-nil."
+  (insert (funcall quickurl-format-function (quickurl-url-url url)))
+  (unless silent
+    (message "Found %s" (quickurl-url-url url))))
+
+;;;###autoload
+(defun* quickurl (&optional (lookup (funcall quickurl-grab-lookup-function)))
+  "Insert an URL based on LOOKUP.
+
+If not supplied LOOKUP is taken to be the word at point in the current
+buffer, this default action can be modifed via
+`quickurl-grab-lookup-function'."
+  (interactive)
+  (when lookup
+    (quickurl-load-urls)
+    (let ((url (quickurl-find-url lookup)))
+      (if (null url)
+          (error "No URL associated with \"%s\"" lookup)
+        (when (looking-at "\\w")
+          (skip-syntax-forward "\\w"))
+        (insert " ")
+        (quickurl-insert url)))))
+
+;;;###autoload
+(defun quickurl-ask (lookup)
+  "Insert an URL, with `completing-read' prompt, based on LOOKUP."
+  (interactive
+   (list
+    (progn
+      (quickurl-load-urls)
+      (let ((completion-ignore-case quickurl-completion-ignore-case))
+        (completing-read "Lookup: " quickurl-urls nil t)))))
+  (let ((url (quickurl-find-url lookup)))
+    (when url
+      (quickurl-insert url))))
+   
+(defun quickurl-grab-url ()
+  "Attempt to grab a word/url pair from point in the current buffer.
+
+Point should be somewhere on the URL and the word is taken to be the thing
+that is returned from calling `quickurl-grab-lookup-function' once a
+`backward-word' has been issued at the start of the URL.
+
+It is assumed that the URL is either \"unguarded\" or is wrapped inside an
+<URL:...> wrapper."
+  (let ((url (thing-at-point 'url)))
+    (when url
+      (save-excursion
+        (beginning-of-thing 'url)
+        ;; `beginning-of-thing' doesn't take you to the start of a marked-up
+        ;; URL, only to the start of the URL within the "markup". So, we
+        ;; need to do a little more work to get to where we want to be.
+        (when (thing-at-point-looking-at thing-at-point-markedup-url-regexp)
+          (search-backward "<URL:"))
+        (backward-word 1)
+        (let ((word (funcall quickurl-grab-lookup-function)))
+          (when word
+            (quickurl-make-url
+             ;; The grab function may return the word with properties. I don't
+             ;; want the properties. I couldn't find a method of stripping
+             ;; them from a "string" so this will have to do. If you know of
+             ;; a better method of doing this I'd love to know.
+             (with-temp-buffer
+               (insert word)
+               (buffer-substring-no-properties (point-min) (point-max)))
+             url)))))))
+
+;;;###autoload
+(defun quickurl-add-url (word url comment)
+  "Allow the user to interactively add a new URL associated with WORD.
+
+See `quickurl-grab-url' for details on how the default word/url combination
+is decided."
+  (interactive (let ((word-url (quickurl-grab-url)))
+                 (list (read-string "Word: "    (quickurl-url-keyword word-url))
+                       (read-string "URL: "     (quickurl-url-url word-url))
+                       (read-string "Comment: " (quickurl-url-comment word-url)))))
+  (if (zerop (length word))
+      (error "You must specify a WORD for lookup")  
+    (quickurl-load-urls)
+    (let* ((current-url (quickurl-find-url word))
+           (add-it      (if current-url
+                            (if (interactive-p)
+                                (y-or-n-p (format "\"%s\" exists, replace URL? " word))
+                              t)
+                          t)))
+      (when add-it
+        (if current-url
+            (progn
+              (setf (quickurl-url-url current-url) url)
+              (setf (quickurl-url-comment current-url) comment))
+          (push (quickurl-make-url word url comment) quickurl-urls))
+        (setq quickurl-urls (funcall quickurl-sort-function quickurl-urls))
+        (quickurl-save-urls)
+        (when (get-buffer quickurl-list-buffer-name)
+          (quickurl-list-populate-buffer))
+        (when (interactive-p)
+          (message "Added %s" url))))))
+
+;;;###autoload
+(defun* quickurl-browse-url (&optional (lookup (funcall quickurl-grab-lookup-function)))
+  "Browse the URL associated with LOOKUP.
+
+If not supplied LOOKUP is taken to be the word at point in the
+current buffer, this default action can be modifed via
+`quickurl-grab-lookup-function'."
+  (interactive)
+  (when lookup
+    (quickurl-load-urls)
+    (let ((url (quickurl-find-url lookup)))
+      (if url
+          (browse-url (quickurl-url-url url))
+        (error "No URL associated with \"%s\"" lookup)))))
+
+;;;###autoload
+(defun quickurl-browse-url-ask (lookup)
+  "Browse the URL, with `completing-read' prompt, associated with LOOKUP."
+  (interactive (list
+                (progn
+                  (quickurl-load-urls)
+                  (completing-read "Browse: " quickurl-urls nil t))))
+  (let ((url (quickurl-find-url lookup)))
+    (when url
+      (browse-url (quickurl-url-url url)))))
+
+;;;###autoload
+(defun quickurl-edit-urls ()
+  "Pull `quickurl-url-file' into a buffer for hand editing."
+  (interactive)
+  (find-file quickurl-url-file))
+
+;; quickurl-list mode.
+
+(unless quickurl-list-mode-map
+  (let ((map (make-sparse-keymap)))
+    (suppress-keymap map t)
+    (define-key map "a"           #'quickurl-list-add-url)
+    (define-key map [(control m)] #'quickurl-list-insert-url)
+    (define-key map "u"           #'quickurl-list-insert-naked-url)
+    (define-key map " "           #'quickurl-list-insert-with-lookup)
+    (define-key map "l"           #'quickurl-list-insert-lookup)
+    (define-key map "d"           #'quickurl-list-insert-with-desc)
+    (define-key map [(control g)] #'quickurl-list-quit)
+    (define-key map "q"           #'quickurl-list-quit)
+    (define-key map [mouse-2]     #'quickurl-list-mouse-select)
+    (define-key map "?"           #'describe-mode)
+    (setq quickurl-list-mode-map map)))
+
+(put 'quickurl-list-mode 'mode-class 'special)
+
+;;;###autoload
+(defun quickurl-list-mode ()
+  "A mode for browsing the quickurl URL list.
+
+The key bindings for `quickurl-list-mode' are:
+
+\\{quickurl-list-mode-map}"
+  (interactive)
+  (kill-all-local-variables)
+  (use-local-map quickurl-list-mode-map)
+  (setq major-mode 'quickurl-list-mode
+        mode-name  "quickurl list")
+  (run-hooks 'quickurl-list-mode-hook)
+  (setq buffer-read-only t
+        truncate-lines   t))
+
+;;;###autoload
+(defun quickurl-list ()
+  "Display `quickurl-list' as a formatted list using `quickurl-list-mode'."
+  (interactive)
+  (quickurl-load-urls)
+  (unless (string= (buffer-name) quickurl-list-buffer-name)
+    (setq quickurl-list-last-buffer (current-buffer)))
+  (pop-to-buffer quickurl-list-buffer-name)
+  (quickurl-list-populate-buffer)
+  (quickurl-list-mode))
+
+(defun quickurl-list-populate-buffer ()
+  "Populate the `quickurl-list' buffer."
+  (with-current-buffer (get-buffer quickurl-list-buffer-name)
+    (let ((buffer-read-only nil)
+          (fmt (format "%%-%ds %%s\n"
+                       (apply #'max (or (loop for url in quickurl-urls
+                                              collect (length (quickurl-url-description url)))
+                                        (list 20))))))
+      (setf (buffer-string) "")
+      (loop for url in quickurl-urls
+            do (let ((start (point)))
+                 (insert (format fmt (quickurl-url-description url)
+                                 (quickurl-url-url url)))
+                 (put-text-property start (1- (point))
+                                    'mouse-face 'highlight)))
+      (setf (point) (point-min)))))
+
+(defun quickurl-list-add-url (word url comment)
+  "Wrapper for `quickurl-add-url' that doesn't guess the parameters."
+  (interactive "sWord: \nsURL: \nsComment: ")
+  (quickurl-add-url word url comment))
+
+(defun quickurl-list-quit ()
+  "Kill the buffer named `quickurl-list-buffer-name'."
+  (interactive)
+  (kill-buffer quickurl-list-buffer-name)
+  (switch-to-buffer quickurl-list-last-buffer)
+  (delete-other-windows))
+
+(defun quickurl-list-mouse-select (event)
+  "Select the URL under the mouse click."
+  (interactive "e")
+  (setf (point) (posn-point (event-end event)))
+  (quickurl-list-insert-url))
+
+(defun quickurl-list-insert (type)
+  "Insert the URL under cursor into `quickurl-list-last-buffer'.
+TYPE dictates what will be inserted, options are:
+  `url'         - Insert the URL as <URL:url>
+  `naked-url'   - Insert the URL with no formatting
+  `with-lookup' - Insert \"lookup <URL:url>\"
+  `with-desc'   - Insert \"description <URL:url>\"
+  `lookup'      - Insert the lookup for that URL"
+  (let ((url (nth (save-excursion
+                    (beginning-of-line)
+                    (count-lines (point-min) (point)))
+                  quickurl-urls)))
+    (if url
+        (with-current-buffer quickurl-list-last-buffer
+          (insert
+           (case type
+             ('url         (format "<URL:%s>" (quickurl-url-url url)))
+             ('naked-url   (quickurl-url-url url))
+             ('with-lookup (format "%s <URL:%s>"
+                                   (quickurl-url-keyword url)
+                                   (quickurl-url-url url)))
+             ('with-desc   (format "%S <URL:%s>"
+                                   (quickurl-url-description url)
+                                   (quickurl-url-url url)))
+             ('lookup      (quickurl-url-keyword url)))))
+      (error "No URL details on that line"))
+    url))
+
+(defmacro quickurl-list-make-inserter (type)
+  "Macro to make a key-response function for use in `quickurl-list-mode-map'."
+  `(defun ,(intern (format "quickurl-list-insert-%S" type)) ()
+    ,(format "Insert the result of calling `quickurl-list-insert' with `%s'." type)
+    (interactive)
+    (when (quickurl-list-insert ',type)
+      (quickurl-list-quit))))
+
+(quickurl-list-make-inserter url)
+(quickurl-list-make-inserter naked-url)
+(quickurl-list-make-inserter with-lookup)
+(quickurl-list-make-inserter with-desc)
+(quickurl-list-make-inserter lookup)
+  
+(provide 'quickurl)
+
+;;; quickurl.el ends here
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lisp/net/rcompile.el	Mon Mar 20 13:12:14 2000 +0000
@@ -0,0 +1,179 @@
+;;; rcompile.el --- run a compilation on a remote machine
+
+;; Copyright (C) 1993, 1994 Free Software Foundation, Inc.
+
+;; Author: Albert    <alon@milcse.rtsg.mot.com>
+;; Maintainer: FSF
+;; Created: 1993 Oct 6
+;; Keywords: tools, processes
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; This package is for running a remote compilation and using emacs to parse
+;; the error messages. It works by rsh'ing the compilation to a remote host
+;; and parsing the output. If the file visited at the time remote-compile was
+;; called was loaded remotely (ange-ftp), the host and user name are obtained
+;; by the calling ange-ftp-ftp-name on the current directory. In this case the
+;; next-error command will also ange-ftp the files over. This is achieved
+;; automatically because the compilation-parse-errors function uses
+;; default-directory to build its file names. If however the file visited was
+;; loaded locally, remote-compile prompts for a host and user and assumes the
+;; files mounted locally (otherwise, how was the visited file loaded).
+
+;; See the user defined variables section for more info.
+
+;; I was contemplating redefining "compile" to "remote-compile" automatically
+;; if the file visited was ange-ftp'ed but decided against it for now. If you
+;; feel this is a good idea, let me know and I'll consider it again.
+
+;; Installation:
+
+;; To use rcompile, you also need to give yourself permission to connect to
+;; the remote host.  You do this by putting lines like:
+
+;; monopoly alon
+;; vme33
+;;
+;; in a file named .rhosts in the home directory (of the remote machine).
+;; Be careful what you put in this file. A line like:
+;;
+;; +
+;;
+;; Will allow anyone access to your account without a password. I suggest you
+;; read the rhosts(5) manual page before you edit this file (if you are not
+;; familiar with it already) 
+
+;;; Code:
+
+(provide 'rcompile)
+(require 'compile)
+;;; The following should not be needed.
+;;; (eval-when-compile (require 'ange-ftp))
+
+;;;; user defined variables
+
+(defgroup remote-compile nil
+  "Run a compilation on a remote machine"
+  :group 'processes
+  :group 'tools)
+
+
+(defcustom remote-compile-host nil
+  "*Host for remote compilations."
+  :type '(choice string (const nil))
+  :group 'remote-compile)
+
+(defcustom remote-compile-user nil
+  "User for remote compilations.
+nil means use the value returned by \\[user-login-name]."
+  :type '(choice string (const nil))
+  :group 'remote-compile)
+
+(defcustom remote-compile-run-before nil
+  "*Command to run before compilation.
+This can be used for setting up environment variables,
+since rsh does not invoke the shell as a login shell and files like .login
+\(tcsh\) and .bash_profile \(bash\) are not run.
+nil means run no commands."
+  :type '(choice string (const nil))
+  :group 'remote-compile)
+
+(defcustom remote-compile-prompt-for-host nil
+  "*Non-nil means prompt for host if not available from filename."
+  :type 'boolean
+  :group 'remote-compile)
+
+(defcustom remote-compile-prompt-for-user nil
+  "*Non-nil means prompt for user if not available from filename."
+  :type 'boolean
+  :group 'remote-compile)
+
+;;;; internal variables
+
+;; History of remote compile hosts and users
+(defvar remote-compile-host-history nil)
+(defvar remote-compile-user-history nil)
+
+
+;;;; entry point
+
+;;;###autoload
+(defun remote-compile (host user command)
+  "Compile the the current buffer's directory on HOST.  Log in as USER.
+See \\[compile]."
+  (interactive
+   (let ((parsed (or (and (featurep 'ange-ftp)
+                          (ange-ftp-ftp-name default-directory))))
+         host user command prompt)
+     (if parsed
+         (setq host (nth 0 parsed)
+               user (nth 1 parsed))
+       (setq prompt (if (stringp remote-compile-host)
+                        (format "Compile on host (default %s): "
+                                remote-compile-host)
+                      "Compile on host: ")
+             host (if (or remote-compile-prompt-for-host
+                          (null remote-compile-host))
+                      (read-from-minibuffer prompt
+                                            "" nil nil
+                                            'remote-compile-host-history)
+                    remote-compile-host)
+             user (if remote-compile-prompt-for-user
+                      (read-from-minibuffer (format
+                                             "Compile by user (default %s)"
+                                             (or remote-compile-user
+                                                 (user-login-name)))
+                                            "" nil nil
+                                            'remote-compile-user-history)
+                    remote-compile-user)))
+     (setq command (read-from-minibuffer "Compile command: "
+                                         compile-command nil nil
+                                         '(compile-history . 1)))
+     (list (if (string= host "") remote-compile-host host)
+           (if (string= user "") remote-compile-user user)
+           command)))
+  (setq compile-command command)
+  (cond (user
+         (setq remote-compile-user user))
+        ((null remote-compile-user)
+         (setq remote-compile-user (user-login-name))))
+  (let* ((parsed (and (featurep 'ange-ftp)
+                      (ange-ftp-ftp-name default-directory)))
+         (compile-command
+          (format "%s %s -l %s \"(%scd %s; %s)\""
+		  remote-shell-program
+                  host
+                  remote-compile-user
+                  (if remote-compile-run-before
+                      (concat remote-compile-run-before "; ")
+                    "")
+                  (if parsed (nth 2 parsed) default-directory)
+                  compile-command)))
+    (setq remote-compile-host host)
+    (save-some-buffers nil nil)
+    (compile-internal compile-command "No more errors")
+    ;; Set comint-file-name-prefix in the compilation buffer so
+    ;; compilation-parse-errors will find referenced files by ange-ftp.
+    (save-excursion
+      (set-buffer compilation-last-buffer)
+      (make-variable-buffer-local 'comint-file-name-prefix)
+      (setq comint-file-name-prefix (concat "/" host ":")))))
+
+;;; rcompile.el ends here
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lisp/net/rlogin.el	Mon Mar 20 13:12:14 2000 +0000
@@ -0,0 +1,373 @@
+;;; rlogin.el --- remote login interface
+
+;; Copyright (C) 1992, 93, 94, 95, 97, 1998 Free Software Foundation, Inc.
+
+;; Author: Noah Friedman
+;; Maintainer: Noah Friedman <friedman@splode.com>
+;; Keywords: unix, comm
+
+;; $Id: rlogin.el,v 1.45 2000/01/31 18:07:17 fx Exp $
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; Support for remote logins using `rlogin'.
+;; This program is layered on top of shell.el; the code here only accounts
+;; for the variations needed to handle a remote process, e.g. directory
+;; tracking and the sending of some special characters.
+
+;; If you wish for rlogin mode to prompt you in the minibuffer for
+;; passwords when a password prompt appears, just enter m-x send-invisible
+;; and type in your line, or add `comint-watch-for-password-prompt' to
+;; `comint-output-filter-functions'.
+
+;;; Code:
+
+(require 'comint)
+(require 'shell)
+
+(defgroup rlogin nil
+  "Remote login interface"
+  :group 'processes
+  :group 'unix)
+
+(defcustom rlogin-program "rlogin"
+  "*Name of program to invoke rlogin"
+  :type 'string
+  :group 'rlogin)
+
+(defcustom rlogin-explicit-args nil
+  "*List of arguments to pass to rlogin on the command line."
+  :type '(repeat (string :tag "Argument"))
+  :group 'rlogin)
+
+(defcustom rlogin-mode-hook nil
+  "*Hooks to run after setting current buffer to rlogin-mode."
+  :type 'hook
+  :group 'rlogin)
+
+(defcustom rlogin-process-connection-type
+  (save-match-data
+    ;; Solaris 2.x `rlogin' will spew a bunch of ioctl error messages if
+    ;; stdin isn't a tty.
+    (cond ((and (boundp 'system-configuration)
+                (stringp system-configuration)
+                (string-match "-solaris2" system-configuration))
+           t)
+          (t nil)))
+  "*If non-`nil', use a pty for the local rlogin process.
+If `nil', use a pipe (if pipes are supported on the local system).
+
+Generally it is better not to waste ptys on systems which have a static
+number of them.  On the other hand, some implementations of `rlogin' assume
+a pty is being used, and errors will result from using a pipe instead."
+  :type '(choice (const :tag "pipes" nil)
+		 (other :tag "ptys" t))
+  :group 'rlogin)
+
+(defcustom rlogin-directory-tracking-mode 'local
+  "*Control whether and how to do directory tracking in an rlogin buffer.
+
+nil means don't do directory tracking.
+
+t means do so using an ftp remote file name.
+
+Any other value means do directory tracking using local file names.
+This works only if the remote machine and the local one
+share the same directories (through NFS).  This is the default.
+
+This variable becomes local to a buffer when set in any fashion for it.
+
+It is better to use the function of the same name to change the behavior of
+directory tracking in an rlogin session once it has begun, rather than
+simply setting this variable, since the function does the necessary
+re-synching of directories."
+  :type '(choice (const :tag "off" nil)
+		 (const :tag "ftp" t)
+		 (other :tag "local" local))
+  :group 'rlogin)
+
+(make-variable-buffer-local 'rlogin-directory-tracking-mode)
+
+(defcustom rlogin-host nil
+  "*The name of the remote host.  This variable is buffer-local."
+  :type '(choice (const nil) string)
+  :group 'rlogin)
+
+(defcustom rlogin-remote-user nil
+  "*The username used on the remote host.
+This variable is buffer-local and defaults to your local user name.
+If rlogin is invoked with the `-l' option to specify the remote username,
+this variable is set from that."
+  :type '(choice (const nil) string)
+  :group 'rlogin)
+
+;; Initialize rlogin mode map.
+(defvar rlogin-mode-map '())
+(cond
+ ((null rlogin-mode-map)
+  (setq rlogin-mode-map (if (consp shell-mode-map)
+                            (cons 'keymap shell-mode-map)
+                          (copy-keymap shell-mode-map)))
+  (define-key rlogin-mode-map "\C-c\C-c" 'rlogin-send-Ctrl-C)
+  (define-key rlogin-mode-map "\C-c\C-d" 'rlogin-send-Ctrl-D)
+  (define-key rlogin-mode-map "\C-c\C-z" 'rlogin-send-Ctrl-Z)
+  (define-key rlogin-mode-map "\C-c\C-\\" 'rlogin-send-Ctrl-backslash)
+  (define-key rlogin-mode-map "\C-d" 'rlogin-delchar-or-send-Ctrl-D)
+  (define-key rlogin-mode-map "\C-i" 'rlogin-tab-or-complete)))
+
+
+;;;###autoload (add-hook 'same-window-regexps "^\\*rlogin-.*\\*\\(\\|<[0-9]+>\\)")
+
+(defvar rlogin-history nil)
+
+;;;###autoload
+(defun rlogin (input-args &optional buffer)
+  "Open a network login connection via `rlogin' with args INPUT-ARGS.
+INPUT-ARGS should start with a host name; it may also contain
+other arguments for `rlogin'.
+
+Input is sent line-at-a-time to the remote connection.
+
+Communication with the remote host is recorded in a buffer `*rlogin-HOST*'
+\(or `*rlogin-USER@HOST*' if the remote username differs\).
+If a prefix argument is given and the buffer `*rlogin-HOST*' already exists,
+a new buffer with a different connection will be made.
+
+When called from a program, if the optional second argument BUFFER is
+a string or buffer, it specifies the buffer to use.
+
+The variable `rlogin-program' contains the name of the actual program to
+run.  It can be a relative or absolute path.
+
+The variable `rlogin-explicit-args' is a list of arguments to give to
+the rlogin when starting.  They are added after any arguments given in
+INPUT-ARGS.
+
+If the default value of `rlogin-directory-tracking-mode' is t, then the
+default directory in that buffer is set to a remote (FTP) file name to
+access your home directory on the remote machine.  Occasionally this causes
+an error, if you cannot access the home directory on that machine.  This
+error is harmless as long as you don't try to use that default directory.
+
+If `rlogin-directory-tracking-mode' is neither t nor nil, then the default
+directory is initially set up to your (local) home directory.
+This is useful if the remote machine and your local machine
+share the same files via NFS.  This is the default.
+
+If you wish to change directory tracking styles during a session, use the
+function `rlogin-directory-tracking-mode' rather than simply setting the
+variable."
+  (interactive (list
+		(read-from-minibuffer "rlogin arguments (hostname first): "
+				      nil nil nil 'rlogin-history)
+		current-prefix-arg))
+
+  (let* ((process-connection-type rlogin-process-connection-type)
+         (args (if rlogin-explicit-args
+                   (append (rlogin-parse-words input-args)
+                           rlogin-explicit-args)
+                 (rlogin-parse-words input-args)))
+	 (host (car args))
+	 (user (or (car (cdr (member "-l" args)))
+                   (user-login-name)))
+         (buffer-name (if (string= user (user-login-name))
+                          (format "*rlogin-%s*" host)
+                        (format "*rlogin-%s@%s*" user host)))
+	 proc)
+
+    (cond ((null buffer))
+	  ((stringp buffer)
+	   (setq buffer-name buffer))
+          ((bufferp buffer)
+           (setq buffer-name (buffer-name buffer)))
+          ((numberp buffer)
+           (setq buffer-name (format "%s<%d>" buffer-name buffer)))
+          (t
+           (setq buffer-name (generate-new-buffer-name buffer-name))))
+
+    (setq buffer (get-buffer-create buffer-name))
+    (pop-to-buffer buffer-name)
+
+    (cond
+     ((comint-check-proc buffer-name))
+     (t
+      (comint-exec buffer buffer-name rlogin-program nil args)
+      (setq proc (get-buffer-process buffer))
+      ;; Set process-mark to point-max in case there is text in the
+      ;; buffer from a previous exited process.
+      (set-marker (process-mark proc) (point-max))
+
+      ;; comint-output-filter-functions is treated like a hook: it is
+      ;; processed via run-hooks or run-hooks-with-args in later versions
+      ;; of emacs.
+      ;; comint-output-filter-functions should already have a
+      ;; permanent-local property, at least in emacs 19.27 or later.
+      (cond
+       ((fboundp 'make-local-hook)
+        (make-local-hook 'comint-output-filter-functions)
+        (add-hook 'comint-output-filter-functions 'rlogin-carriage-filter
+                  nil t))
+       (t
+        (make-local-variable 'comint-output-filter-functions)
+        (add-hook 'comint-output-filter-functions 'rlogin-carriage-filter)))
+
+      (rlogin-mode)
+
+      (make-local-variable 'rlogin-host)
+      (setq rlogin-host host)
+      (make-local-variable 'rlogin-remote-user)
+      (setq rlogin-remote-user user)
+
+      (condition-case ()
+          (cond ((eq rlogin-directory-tracking-mode t)
+                 ;; Do this here, rather than calling the tracking mode
+                 ;; function, to avoid a gratuitous resync check; the default
+                 ;; should be the user's home directory, be it local or remote.
+                 (setq comint-file-name-prefix
+                       (concat "/" rlogin-remote-user "@" rlogin-host ":"))
+                 (cd-absolute comint-file-name-prefix))
+                ((null rlogin-directory-tracking-mode))
+                (t
+                 (cd-absolute (concat comint-file-name-prefix "~/"))))
+        (error nil))))))
+
+(put 'rlogin-mode 'mode-class 'special)
+
+(defun rlogin-mode ()
+  "Set major-mode for rlogin sessions.
+If `rlogin-mode-hook' is set, run it."
+  (interactive)
+  (kill-all-local-variables)
+  (shell-mode)
+  (setq major-mode 'rlogin-mode)
+  (setq mode-name "rlogin")
+  (use-local-map rlogin-mode-map)
+  (setq shell-dirtrackp rlogin-directory-tracking-mode)
+  (make-local-variable 'comint-file-name-prefix)
+  (run-hooks 'rlogin-mode-hook))
+
+(defun rlogin-directory-tracking-mode (&optional prefix)
+  "Do remote or local directory tracking, or disable entirely.
+
+If called with no prefix argument or a unspecified prefix argument (just
+``\\[universal-argument]'' with no number) do remote directory tracking via
+ange-ftp.  If called as a function, give it no argument.
+
+If called with a negative prefix argument, disable directory tracking
+entirely.
+
+If called with a positive, numeric prefix argument, e.g.
+``\\[universal-argument] 1 M-x rlogin-directory-tracking-mode\'',
+then do directory tracking but assume the remote filesystem is the same as
+the local system.  This only works in general if the remote machine and the
+local one share the same directories (through NFS)."
+  (interactive "P")
+  (cond
+   ((or (null prefix)
+        (consp prefix))
+    (setq rlogin-directory-tracking-mode t)
+    (setq shell-dirtrackp t)
+    (setq comint-file-name-prefix
+          (concat "/" rlogin-remote-user "@" rlogin-host ":")))
+   ((< prefix 0)
+    (setq rlogin-directory-tracking-mode nil)
+    (setq shell-dirtrackp nil))
+   (t
+    (setq rlogin-directory-tracking-mode 'local)
+    (setq comint-file-name-prefix "")
+    (setq shell-dirtrackp t)))
+  (cond
+   (shell-dirtrackp
+    (let* ((proc (get-buffer-process (current-buffer)))
+           (proc-mark (process-mark proc))
+           (current-input (buffer-substring proc-mark (point-max)))
+           (orig-point (point))
+           (offset (and (>= orig-point proc-mark)
+                        (- (point-max) orig-point))))
+      (unwind-protect
+          (progn
+            (delete-region proc-mark (point-max))
+            (goto-char (point-max))
+            (shell-resync-dirs))
+        (goto-char proc-mark)
+        (insert current-input)
+        (if offset
+            (goto-char (- (point-max) offset))
+          (goto-char orig-point)))))))
+
+
+;; Parse a line into its constituent parts (words separated by
+;; whitespace).  Return a list of the words.
+(defun rlogin-parse-words (line)
+  (let ((list nil)
+	(posn 0)
+        (match-data (match-data)))
+    (while (string-match "[^ \t\n]+" line posn)
+      (setq list (cons (substring line (match-beginning 0) (match-end 0))
+                       list))
+      (setq posn (match-end 0)))
+    (set-match-data (match-data))
+    (nreverse list)))
+
+(defun rlogin-carriage-filter (string)
+  (let* ((point-marker (point-marker))
+         (end (process-mark (get-buffer-process (current-buffer))))
+         (beg (or (and (boundp 'comint-last-output-start)
+                       comint-last-output-start)
+                  (- end (length string)))))
+    (goto-char beg)
+    (while (search-forward "\C-m" end t)
+      (delete-char -1))
+    (goto-char point-marker)))
+
+(defun rlogin-send-Ctrl-C ()
+  (interactive)
+  (process-send-string nil "\C-c"))
+
+(defun rlogin-send-Ctrl-D ()
+  (interactive)
+  (process-send-string nil "\C-d"))
+
+(defun rlogin-send-Ctrl-Z ()
+  (interactive)
+  (process-send-string nil "\C-z"))
+
+(defun rlogin-send-Ctrl-backslash ()
+  (interactive)
+  (process-send-string nil "\C-\\"))
+
+(defun rlogin-delchar-or-send-Ctrl-D (arg)
+  "\
+Delete ARG characters forward, or send a C-d to process if at end of buffer."
+  (interactive "p")
+  (if (eobp)
+      (rlogin-send-Ctrl-D)
+    (delete-char arg)))
+
+(defun rlogin-tab-or-complete ()
+  "Complete file name if doing directory tracking, or just insert TAB."
+  (interactive)
+  (if rlogin-directory-tracking-mode
+      (comint-dynamic-complete)
+    (insert "\C-i")))
+
+(provide 'rlogin)
+
+;;; rlogin.el ends here
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lisp/net/snmp-mode.el	Mon Mar 20 13:12:14 2000 +0000
@@ -0,0 +1,716 @@
+;;; snmp-mode.el --- SNMP & SNMPv2 MIB major mode.
+
+;; Copyright (C) 1995,1998  Free Software Foundation, Inc.
+
+;; Author: Paul D. Smith <psmith@BayNetworks.com>
+;; Keywords: data
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;; INTRODUCTION
+;; ------------
+;; This package provides a major mode for editing SNMP MIBs.  It
+;; provides all the modern Emacs 19 bells and whistles: default
+;; fontification via font-lock, imenu search functions, etc.
+;;
+;; SNMP mode also uses tempo, a textual boilerplate insertion package
+;; distributed with Emacs, to add in boilerplate SNMP MIB structures.
+;; See tempo.el for more details about tempo.
+;;
+;; If you want to change or add new tempo templates, use the tempo tag
+;; list `snmp-tempo-tags' (or `snmpv2-tempo-tags'): this list is
+;; automatically installed when snmp-mode (or snmpv2-mode) is entered.
+;;
+;; The SNMPv2 mode in this version has been enhanced thanks to popular
+;; demand.
+;;
+;; I'm very interested in new tempo macros for both v1 and v2, and any
+;; other suggestions for enhancements (different syntax table items, new
+;; keybindings, etc.)
+;;
+;;
+;; USAGE
+;; -----
+;; Mostly, use it as you would any other mode.  There's a very
+;; simplistic auto-indent feature; hopefully it'll help more than get in
+;; your way.  For the most part it tries to indent to the same level as
+;; the previous line.  It will try to recognize some very simple tokens
+;; on the previous line that tell it to use extra indent or outdent.
+;;
+;; Templates
+;; ---------
+;; To use the Tempo templates, type the Tempo tag (or a unique prefix)
+;; and use C-c C-i (C-c TAB) to complete it; if you don't have
+;; tempo-interactive set to nil it will ask you to fill in values.
+;; Fields with predefined values (SYNTAX, STATUS, etc.) will do
+;; completing-reads on a list of valid values; use the normal SPC or TAB
+;; to complete.
+;;
+;; Currently the following templates are available:
+;;
+;;  objectType -- Defines an OBJECT-TYPE macro.
+;;
+;;  tableType  -- Defines both a Table and Entry OBJECT-TYPE, and a
+;;                SEQUENCE for the ASN.1 Entry definition.
+;;
+;; Once the template is done, you can use C-cC-f and C-cC-b to move back
+;; and forth between the Tempo sequence points to fill in the rest of
+;; the information.
+;;
+;; Font Lock
+;; ------------
+;;
+;; If you want font-lock in your MIB buffers, add this:
+;;
+;;  (add-hook 'snmp-common-mode-hook 'turn-on-font-lock)
+;;
+;; Enabling global-font-lock-mode is also sufficient.
+;;
+
+;;;----------------------------------------------------------------------------
+;;
+;;                          Customize these:
+;;
+;;;----------------------------------------------------------------------------
+
+(defgroup snmp nil
+  "Mode for editing SNMP MIB files."
+  :group 'data
+  :version "20.4")
+
+(defcustom snmp-special-indent t
+  "*If non-nil, use a simple heuristic to try to guess the right indentation.
+If nil, then no special indentation is attempted."
+  :type 'boolean
+  :group 'snmp)
+
+(defcustom snmp-indent-level 4
+  "*Indentation level for SNMP MIBs."
+  :type 'integer
+  :group 'snmp)
+
+(defcustom snmp-tab-always-indent nil
+  "*Non-nil means TAB should always reindent the current line.
+A value of nil means reindent if point is within the initial line indentation;
+otherwise insert a TAB."
+  :type 'boolean
+  :group 'snmp)
+
+(defcustom snmp-completion-ignore-case t
+  "*Non-nil means that case differences are ignored during completion.
+A value of nil means that case is significant.
+This is used during Tempo template completion."
+  :type 'boolean
+  :group 'snmp)
+
+(defcustom snmp-common-mode-hook nil
+  "*Hook(s) evaluated when a buffer enters either SNMP or SNMPv2 mode."
+  :type 'hook
+  :group 'snmp)
+
+(defcustom snmp-mode-hook nil
+  "*Hook(s) evaluated when a buffer enters SNMP mode."
+  :type 'hook
+  :group 'snmp)
+
+(defcustom snmpv2-mode-hook nil
+  "*Hook(s) evaluated when a buffer enters SNMPv2 mode."
+  :type 'hook
+  :group 'snmp)
+
+(defvar snmp-tempo-tags nil
+  "*Tempo tags for SNMP mode.")
+
+(defvar snmpv2-tempo-tags nil
+  "*Tempo tags for SNMPv2 mode.")
+
+
+;; Enable fontification for SNMP MIBs
+;;
+
+;; These are pretty basic fontifications.  Note we assume these macros
+;; are first on a line (except whitespace), to speed up fontification.
+;;
+(defvar snmp-font-lock-keywords-1
+  (list
+   ;; OBJECT-TYPE, TRAP-TYPE, and OBJECT-IDENTIFIER macros
+   '("^[ \t]*\\([a-z][-a-zA-Z0-9]+\\)[ \t]+\\(\\(MODULE-\\(COMPLIANCE\\|IDENTITY\\)\\|OBJECT-\\(COMPLIANCE\\|GROUP\\|IDENTITY\\|TYPE\\)\\|TRAP-\\(GROUP\\|TYPE\\)\\)\\|\\(OBJECT\\)[ \t]+\\(IDENTIFIER\\)[ \t]*::=\\)"
+     (1 font-lock-variable-name-face) (3 font-lock-keyword-face nil t)
+     (7 font-lock-keyword-face nil t) (8 font-lock-keyword-face nil t))
+
+   ;; DEFINITIONS clause
+   '("^[ \t]*\\([A-Z][-a-zA-Z0-9]+\\)[ \t]+\\(DEFINITIONS\\)[ \t]*::="
+     (1 font-lock-function-name-face) (2 font-lock-keyword-face))
+   )
+  "Basic SNMP MIB mode expression highlighting.")
+
+(defvar snmp-font-lock-keywords-2
+  (append
+   '(("ACCESS\\|BEGIN\\|DE\\(FVAL\\|SCRIPTION\\)\\|END\\|FROM\\|I\\(MPORTS\\|NDEX\\)\\|S\\(TATUS\\|YNTAX\\)"
+      (0 font-lock-keyword-face)))
+   snmp-font-lock-keywords-1)
+  "Medium SNMP MIB mode expression highlighting.")
+
+(defvar snmp-font-lock-keywords-3
+  (append
+   '(("\\([^\n]+\\)[ \t]+::=[ \t]+\\(SEQUENCE\\)[ \t]+{"
+      (1 font-lock-reference-face) (2 font-lock-keyword-face))
+     ("::=[ \t]*{[ \t]*\\([a-z0-9].*[ \t]+\\)?\\([0-9]+\\)[ \t]*}"
+      (1 font-lock-reference-face nil t) (2 font-lock-variable-name-face)))
+   snmp-font-lock-keywords-2)
+  "Gaudy SNMP MIB mode expression highlighting.")
+
+(defvar snmp-font-lock-keywords snmp-font-lock-keywords-1
+  "Default SNMP MIB mode expression highlighting.")
+
+
+;; These lists are used for the completion capabilities in the tempo
+;; templates.
+;;
+
+(defvar snmp-mode-syntax-list nil
+  "Predefined types for SYNTAX clauses.")
+
+(defvar snmp-rfc1155-types
+  '(("INTEGER") ("OCTET STRING") ("OBJECT IDENTIFIER") ("NULL") ("IpAddress")
+    ("NetworkAddress") ("Counter") ("Gauge") ("TimeTicks") ("Opaque"))
+  "Types from RFC 1155 v1 SMI.")
+
+(defvar snmp-rfc1213-types
+  '(("DisplayString"))
+  "Types from RFC 1213 MIB-II.")
+
+(defvar snmp-rfc1902-types
+  '(("INTEGER") ("OCTET STRING") ("OBJECT IDENTIFIER") ("Integer32")
+    ("IpAddress") ("Counter32") ("Gauge32") ("Unsigned32") ("TimeTicks")
+    ("Opaque") ("Counter64"))
+  "Types from RFC 1902 v2 SMI.")
+
+(defvar snmp-rfc1903-types
+  '(("DisplayString") ("PhysAddress") ("MacAddress") ("TruthValue")
+    ("TestAndIncr") ("AutonomousType") ("InstancePointer")
+    ("VariablePointer") ("RowPointer") ("RowStatus") ("TimeStamp")
+    ("TimeInterval") ("DateAndTime") ("StorageType") ("TDomain")
+    ("TAddress"))
+  "Types from RFC 1903 Textual Conventions.")
+
+
+(defvar snmp-mode-access-list nil
+  "Predefined values for ACCESS clauses.")
+
+(defvar snmp-rfc1155-access
+  '(("read-only") ("read-write") ("write-only") ("not-accessible"))
+  "ACCESS values from RFC 1155 v1 SMI.")
+
+(defvar snmp-rfc1902-access
+  '(("read-only") ("read-write") ("read-create") ("not-accessible")
+    ("accessible-for-notify"))
+  "ACCESS values from RFC 1155 v1 SMI.")
+
+
+(defvar snmp-mode-status-list nil
+  "Predefined values for STATUS clauses.")
+
+(defvar snmp-rfc1212-status
+  '(("mandatory") ("obsolete") ("deprecated"))
+  "STATUS values from RFC 1212 v1 SMI.")
+
+(defvar snmp-rfc1902-status
+  '(("current") ("obsolete") ("deprecated"))
+  "STATUS values from RFC 1902 v2 SMI.")
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;----------------------------------------------------------------------------
+;;
+;;                  Nothing to customize below here.
+;;
+;;;----------------------------------------------------------------------------
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+
+;; Need this stuff when compiling for imenu macros, etc.
+;;
+(eval-when-compile
+  (require 'cl)
+  (require 'imenu))
+
+
+;; Create abbrev table for SNMP MIB mode
+;;
+(defvar snmp-mode-abbrev-table nil
+  "Abbrev table in use in SNMP mode.")
+(define-abbrev-table 'snmp-mode-abbrev-table ())
+
+
+;; Create abbrev table for SNMPv2 mode
+;;
+(defvar snmpv2-mode-abbrev-table nil
+  "Abbrev table in use in SNMPv2 mode.")
+(define-abbrev-table 'snmpv2-mode-abbrev-table ())
+
+
+;; Set up our keymap
+;;
+(defvar snmp-mode-map (make-sparse-keymap)
+  "Keymap used in SNMP mode.")
+
+(define-key snmp-mode-map "\t"           'snmp-indent-command)
+(define-key snmp-mode-map "\177"         'backward-delete-char-untabify)
+
+(define-key snmp-mode-map "\C-c\C-i"     'tempo-complete-tag)
+(define-key snmp-mode-map "\C-c\C-f"     'tempo-forward-mark)
+(define-key snmp-mode-map "\C-c\C-b"     'tempo-backward-mark)
+
+
+;; Set up our syntax table
+;;
+(defvar snmp-mode-syntax-table nil
+  "Syntax table used for buffers in SNMP mode.")
+
+(if snmp-mode-syntax-table
+    ()
+  (setq snmp-mode-syntax-table (make-syntax-table))
+  (modify-syntax-entry ?\\  "\\"     snmp-mode-syntax-table)
+  (modify-syntax-entry ?-   "_ 1234" snmp-mode-syntax-table)
+  (modify-syntax-entry ?\n  ">"      snmp-mode-syntax-table)
+  (modify-syntax-entry ?\^m ">"      snmp-mode-syntax-table)
+  (modify-syntax-entry ?_   "."      snmp-mode-syntax-table)
+  (modify-syntax-entry ?:   "."      snmp-mode-syntax-table)
+  (modify-syntax-entry ?=   "."      snmp-mode-syntax-table))
+
+;; Set up the stuff that's common between snmp-mode and snmpv2-mode
+;;
+(defun snmp-common-mode (name mode abbrev font-keywords imenu-index tempo-tags)
+  (kill-all-local-variables)
+
+  ;; Become the current major mode
+  (setq mode-name name)
+  (setq major-mode mode)
+
+  ;; Activate keymap, syntax table, and abbrev table
+  (use-local-map snmp-mode-map)
+  (set-syntax-table snmp-mode-syntax-table)
+  (setq local-abbrev-table abbrev)
+
+  ;; Set up paragraphs (?)
+  (make-local-variable 'paragraph-start)
+  (setq paragraph-start (concat "$\\|" page-delimiter))
+  (make-local-variable 'paragraph-separate)
+  (setq paragraph-separate paragraph-start)
+  (make-local-variable 'paragraph-ignore-fill-prefix)
+  (setq paragraph-ignore-fill-prefix t)
+
+  ;; Set up comments
+  (make-local-variable 'comment-start)
+  (setq comment-start "-- ")
+  (make-local-variable 'comment-start-skip)
+  (setq comment-start-skip "--+[ \t]*")
+  (make-local-variable 'comment-column)
+  (setq comment-column 40)
+  (make-local-variable 'parse-sexp-ignore-comments)
+  (setq parse-sexp-ignore-comments t)
+
+  ;; Set up indentation
+  (make-local-variable 'indent-line-function)
+  (setq indent-line-function (if snmp-special-indent
+                                 'snmp-indent-line
+                               'indent-to-left-margin))
+
+  ;; Font Lock
+  (make-local-variable 'font-lock-defaults)
+  (setq font-lock-defaults (cons font-keywords '(nil nil ((?- . "w 1234")))))
+
+  ;; Imenu
+  (make-local-variable 'imenu-create-index-function)
+  (setq imenu-create-index-function imenu-index)
+
+  ;; Tempo
+  (tempo-use-tag-list tempo-tags)
+  (make-local-variable 'tempo-match-finder)
+  (setq tempo-match-finder "\\b\\(.+\\)\\=")
+  (make-local-variable 'tempo-interactive)
+  (setq tempo-interactive t)
+
+  ;; Miscellaneous customization
+  (make-local-variable 'require-final-newline)
+  (setq require-final-newline t))
+
+
+;; SNMPv1 MIB Editing Mode.
+;;
+;;;###autoload
+(defun snmp-mode ()
+  "Major mode for editing SNMP MIBs.
+Expression and list commands understand all C brackets.
+Tab indents for C code.
+Comments start with -- and end with newline or another --.
+Delete converts tabs to spaces as it moves back.
+\\{snmp-mode-map}
+Turning on snmp-mode runs the hooks in `snmp-common-mode-hook', then
+`snmp-mode-hook'."
+  (interactive)
+
+  (snmp-common-mode "SNMP" 'snmp-mode
+                   snmp-mode-abbrev-table
+                   '(snmp-font-lock-keywords
+                     snmp-font-lock-keywords-1
+                     snmp-font-lock-keywords-2
+                     snmp-font-lock-keywords-3)
+                   'snmp-mode-imenu-create-index
+                   'snmp-tempo-tags)
+
+  ;; Completion lists
+  (make-local-variable 'snmp-mode-syntax-list)
+  (setq snmp-mode-syntax-list (append snmp-rfc1155-types
+                                     snmp-rfc1213-types
+                                     snmp-mode-syntax-list))
+  (make-local-variable 'snmp-mode-access-list)
+  (setq snmp-mode-access-list snmp-rfc1155-access)
+  (make-local-variable 'snmp-mode-status-list)
+  (setq snmp-mode-status-list snmp-rfc1212-status)
+
+  ;; Run hooks
+  (run-hooks 'snmp-common-mode-hook)
+  (run-hooks 'snmp-mode-hook))
+
+
+;;;###autoload
+(defun snmpv2-mode ()
+  "Major mode for editing SNMPv2 MIBs.
+Expression and list commands understand all C brackets.
+Tab indents for C code.
+Comments start with -- and end with newline or another --.
+Delete converts tabs to spaces as it moves back.
+\\{snmp-mode-map}
+Turning on snmp-mode runs the hooks in `snmp-common-mode-hook',
+then `snmpv2-mode-hook'."
+  (interactive)
+
+  (snmp-common-mode "SNMPv2" 'snmpv2-mode
+                   snmpv2-mode-abbrev-table
+                   '(snmp-font-lock-keywords
+                     snmp-font-lock-keywords-1
+                     snmp-font-lock-keywords-2
+                     snmp-font-lock-keywords-3)
+                   'snmp-mode-imenu-create-index
+                   'snmpv2-tempo-tags)
+
+  ;; Completion lists
+  (make-local-variable 'snmp-mode-syntax-list)
+  (setq snmp-mode-syntax-list (append snmp-rfc1902-types
+                                     snmp-rfc1903-types
+                                     snmp-mode-syntax-list))
+  (make-local-variable 'snmp-mode-access-list)
+  (setq snmp-mode-access-list snmp-rfc1902-access)
+  (make-local-variable 'snmp-mode-status-list)
+  (setq snmp-mode-status-list snmp-rfc1902-status)
+
+  ;; Run hooks
+  (run-hooks 'snmp-common-mode-hook)
+  (run-hooks 'snmpv2-mode-hook))
+
+
+;;;----------------------------------------------------------------------------
+;;
+;;                           Indentation Setup
+;;
+;;;----------------------------------------------------------------------------
+
+(defvar snmp-macro-open
+  "[a-zA-Z][-a-zA-Z0-9]*[ \t]*\\(OBJECT\\|TRAP\\)-\\(TYPE\\|GROUP\\)\
+\\|DESCRIPTION\\|IMPORTS\\|MODULE\\(-IDENTITY\\|-COMPLIANCE\\)\
+\\|.*::=[ \t]*\\(BEGIN\\|TEXTUAL-CONVENTION\\)[ \t]*$")
+
+(defvar snmp-macro-close
+  "::=[ \t]*{\\|\\(END\\|.*[;\"]\\)[ \t]*$")
+
+(defun snmp-calculate-indent ()
+  "Calculate the current line indentation in SNMP MIB code.
+
+We use a very simple scheme: if the previous non-empty line was a \"macro
+open\" string, add `snmp-indent-level' to it.  If it was a \"macro close\"
+string, subtract `snmp-indent-level'.  Otherwise, use the same indentation
+as the previous non-empty line.  Note comments are considered empty
+lines for the purposes of this function."
+  (let ((empty (concat "\\([ \t]*\\)\\(" comment-start-skip "\\|$\\)"))
+        (case-fold-search nil)) ; keywords must be in uppercase
+    (save-excursion
+      (while (and (>= (forward-line -1) 0)
+                  (looking-at empty)))
+      (skip-chars-forward " \t")
+      (+ (current-column)
+         ;; Are we looking at a macro open string?  If so, add more.
+         (cond ((looking-at snmp-macro-open)
+                snmp-indent-level)
+               ;; macro close string?  If so, remove some.
+               ((looking-at snmp-macro-close)
+                (- snmp-indent-level))
+               ;; Neither; just stay here.
+               (t 0))))))
+
+(defun snmp-indent-line ()
+  "Indent current line as SNMP MIB code."
+  (let ((indent (snmp-calculate-indent))
+        (pos (- (point-max) (point)))
+        shift-amt beg end)
+    (beginning-of-line)
+    (setq beg (point))
+    (skip-chars-forward " \t")
+    (setq shift-amt (- indent (current-column)))
+    (if (zerop shift-amt)
+        nil
+      (delete-region beg (point))
+      (indent-to indent))
+    ;; If initial point was within line's indentation,
+    ;; position after the indentation.  Else stay at same point in text.
+    (if (> (- (point-max) pos) (point))
+        (goto-char (- (point-max) pos)))))
+
+(defun snmp-indent-command ()
+  "Indent current line as SNMP MIB code, or sometimes insert a TAB.
+If `snmp-tab-always-indent' is t, always reindent the current line when
+this command is run.
+If `snmp-tab-always-indent' is nil, reindent the current line if point is
+in the initial indentation.  Otherwise, insert a TAB."
+  (interactive)
+  (if (and (not snmp-tab-always-indent)
+           (save-excursion
+             (skip-chars-backward " \t")
+             (not (bolp))))
+      (insert-tab)
+    (snmp-indent-line)))
+
+
+;;;----------------------------------------------------------------------------
+;;
+;;                              Imenu Setup
+;;
+;;;----------------------------------------------------------------------------
+
+(defvar snmp-clause-regexp
+  "^[ \t]*\\([a-zA-Z][-a-zA-Z0-9]*\\)[ \t\n]*\
+\\(TRAP-TYPE\\|::=\\|OBJECT\\(-TYPE[ \t\n]+SYNTAX\\|[ \t\n]+IDENTIFIER[ \t\n]*::=\\)\\)")
+
+(defun snmp-mode-imenu-create-index ()
+  (let ((index-alist '())
+	(index-oid-alist '())
+	(index-tc-alist '())
+	(index-table-alist '())
+	(index-trap-alist '())
+        (case-fold-search nil) ; keywords must be uppercase
+	prev-pos token marker end)
+    (goto-char (point-min))
+    (imenu-progress-message prev-pos 0)
+    ;; Search for a useful MIB item (that's not in a comment)
+    (save-match-data
+      (while (re-search-forward snmp-clause-regexp nil t)
+        (imenu-progress-message prev-pos)
+        (setq
+         end (match-end 0)
+         token (cons (buffer-substring (match-beginning 1) (match-end 1))
+                     (set-marker (make-marker) (match-beginning 1))))
+        (goto-char (match-beginning 2))
+        (cond ((looking-at "OBJECT-TYPE[ \t\n]+SYNTAX")
+               (push token index-alist))
+              ((looking-at "OBJECT[ \t\n]+IDENTIFIER[ \t\n]*::=")
+               (push token index-oid-alist))
+              ((looking-at "::=[ \t\n]*SEQUENCE[ \t\n]*{")
+               (push token index-table-alist))
+              ((looking-at "TRAP-TYPE")
+               (push token index-trap-alist))
+              ((looking-at "::=")
+               (push token index-tc-alist)))
+        (goto-char end)))
+    ;; Create the menu
+    (imenu-progress-message prev-pos 100)
+    (setq index-alist (nreverse index-alist))
+    (and index-tc-alist
+ 	 (push (cons "Textual Conventions" (nreverse index-tc-alist))
+  	       index-alist))
+    (and index-trap-alist
+	 (push (cons "Traps" (nreverse index-trap-alist))
+               index-alist))
+    (and index-table-alist
+ 	 (push (cons "Tables" (nreverse index-table-alist))
+  	       index-alist))
+    (and index-oid-alist
+ 	 (push (cons "Object IDs" (nreverse index-oid-alist))
+  	       index-alist))
+    index-alist))
+
+
+;;;----------------------------------------------------------------------------
+;;
+;;                              Tempo Setup
+;;
+;;;----------------------------------------------------------------------------
+
+(require 'tempo)
+
+;; Perform a completing-read with info given
+;;
+(defun snmp-completing-read (prompt table &optional pred require init hist)
+  "Read from the minibuffer, with completion.
+Like `completing-read', but the variable `snmp-completion-ignore-case'
+controls whether case is significant."
+  (let ((completion-ignore-case snmp-completion-ignore-case))
+    (completing-read prompt table pred require init hist)))
+
+;; OBJECT-TYPE macro template
+;;
+(tempo-define-template "snmp-object-type"
+  '(> (P "Object Label: ") " OBJECT-TYPE" n>
+    "SYNTAX  "
+    (if tempo-interactive
+        (snmp-completing-read "Syntax: " snmp-mode-syntax-list nil nil)
+      p) n>
+    "ACCESS  "
+    (if tempo-interactive
+        (snmp-completing-read "Access: " snmp-mode-access-list nil t)
+      p) n>
+    "STATUS  "
+    (if tempo-interactive
+        (snmp-completing-read "Status: " snmp-mode-status-list nil t)
+      p) n>
+    "DESCRIPTION" n> "\"" p "\"" n>
+    (P "Default Value: " defval t)
+    (if (string= "" (tempo-lookup-named 'defval))
+        nil
+      '(l "DEFVAL { " (s defval) " }" n>))
+    "::= { " (p "OID: ") " }" n)
+  "objectType"
+  "Insert an OBJECT-TYPE macro."
+  'snmp-tempo-tags)
+
+;; Table macro template
+;;
+(tempo-define-template "snmp-table-type"
+  ;; First the table OBJECT-TYPE
+  '(> (P "Table Name: " table)
+    (P "Entry Name: " entry t)
+    (let* ((entry (tempo-lookup-named 'entry))
+           (seq (copy-sequence entry)))
+      (aset entry 0 (downcase (aref entry 0)))
+      (aset seq 0 (upcase (aref seq 0)))
+      (tempo-save-named 'obj-entry entry)
+      (tempo-save-named 'seq-entry seq)
+      nil)
+    " OBJECT-TYPE" n>
+    "SYNTAX  SEQUENCE OF "
+    (s seq-entry) n>
+    "ACCESS  not-accessible" n>
+    "STATUS  mandatory" n>
+    "DESCRIPTION" n> "\"" p "\"" n>
+    "::= { " (p "OID: ") " }" n n>
+   ;; Next the row OBJECT-TYPE
+    (s obj-entry) " OBJECT-TYPE" n>
+    "SYNTAX  " (s seq-entry) n>
+    "ACCESS  not-accessible" n>
+    "STATUS  mandatory" n>
+    "DESCRIPTION" n> "\"" p "\"" n>
+    "INDEX   { " (p "Index List: ") " }" n>
+    "::= {" (s table) " 1 }" n n>
+   ;; Finally the SEQUENCE type
+    (s seq-entry) " ::= SEQUENCE {" n> p n> "}" n)
+  "tableType"
+  "Insert an SNMP table."
+  'snmp-tempo-tags)
+
+
+;; v2 SMI OBJECT-TYPE macro template
+;;
+(tempo-define-template "snmpv2-object-type"
+  '(> (P "Object Label: ") " OBJECT-TYPE" n>
+    "SYNTAX      "
+    (if tempo-interactive
+        (snmp-completing-read "Syntax: " snmp-mode-syntax-list nil nil)
+      p) n>
+    "MAX-ACCESS  "
+    (if tempo-interactive
+        (snmp-completing-read "Max Access: " snmp-mode-access-list nil t)
+      p) n>
+    "STATUS      "
+    (if tempo-interactive
+        (snmp-completing-read "Status: " snmp-mode-status-list nil t)
+      p) n>
+    "DESCRIPTION" n> "\"" p "\"" n>
+    (P "Default Value: " defval t)
+    (if (string= "" (tempo-lookup-named 'defval))
+        nil
+      '(l "DEFVAL { " (s defval) " }" n>))
+    "::= { " (p "OID: ") " }" n)
+  "objectType"
+  "Insert an v2 SMI OBJECT-TYPE macro."
+  'snmpv2-tempo-tags)
+
+;; v2 SMI Table macro template
+;;
+(tempo-define-template "snmpv2-table-type"
+  ;; First the table OBJECT-TYPE
+  '(> (P "Table Name: " table)
+    (P "Entry Name: " entry t)
+    (let* ((entry (tempo-lookup-named 'entry))
+           (seq (copy-sequence entry)))
+      (aset entry 0 (downcase (aref entry 0)))
+      (aset seq 0 (upcase (aref seq 0)))
+      (tempo-save-named 'obj-entry entry)
+      (tempo-save-named 'seq-entry seq)
+      nil)
+    " OBJECT-TYPE" n>
+    "SYNTAX      SEQUENCE OF "
+    (s seq-entry) n>
+    "MAX-ACCESS  not-accessible" n>
+    "STATUS      current" n>
+    "DESCRIPTION" n> "\"" p "\"" n>
+    "::= { " (p "OID: ") " }" n n>
+   ;; Next the row OBJECT-TYPE
+    (s obj-entry) " OBJECT-TYPE" n>
+    "SYNTAX      " (s seq-entry) n>
+    "MAX-ACCESS  not-accessible" n>
+    "STATUS      current" n>
+    "DESCRIPTION" n> "\"" p "\"" n>
+    "INDEX { " (p "Index List: ") " }" n>
+    "::= { " (s table) " 1 }" n n>
+   ;; Finally the SEQUENCE type
+    (s seq-entry) " ::= SEQUENCE {" n> p n> "}" n)
+  "tableType"
+  "Insert an v2 SMI SNMP table."
+  'snmpv2-tempo-tags)
+
+;; v2 SMI TEXTUAL-CONVENTION macro template
+;;
+(tempo-define-template "snmpv2-textual-convention"
+  '(> (P "Texual Convention Type: ") " ::= TEXTUAL-CONVENTION" n>
+    "STATUS  "
+    (if tempo-interactive
+        (snmp-completing-read "Status: " snmp-mode-status-list nil t)
+      p) n>
+    "DESCRIPTION" n> "\"" p "\"" n>
+    "SYNTAX  "
+    (if tempo-interactive
+        (snmp-completing-read "Syntax: " snmp-mode-syntax-list nil nil)
+      p) n> )
+  "textualConvention"
+  "Insert an v2 SMI TEXTUAL-CONVENTION macro."
+  'snmpv2-tempo-tags)
+
+
+(provide 'snmp-mode)
+
+;; snmp-mode.el ends here
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lisp/net/telnet.el	Mon Mar 20 13:12:14 2000 +0000
@@ -0,0 +1,261 @@
+;;; telnet.el --- run a telnet session from within an Emacs buffer
+
+;; Copyright (C) 1985, 1988, 1992, 1994 Free Software Foundation, Inc.
+
+;; Author: William F. Schelter
+;; Maintainer: FSF
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; This mode is intended to be used for telnet or rsh to a remote host;
+;; `telnet' and `rsh' are the two entry points.  Multiple telnet or rsh
+;; sessions are supported.
+;;
+;; Normally, input is sent to the remote telnet/rsh line-by-line, as you
+;; type RET or LFD.  C-c C-c sends a C-c to the remote immediately; 
+;; C-c C-z sends C-z immediately.  C-c C-q followed by any character
+;; sends that character immediately.
+;;
+;; All RET characters are filtered out of the output coming back from the
+;; remote system.  The mode tries to do other useful translations based
+;; on what it sees coming back from the other system before the password
+;; query.  It knows about UNIX, ITS, TOPS-20 and Explorer systems.
+;;
+;; You can use the global telnet-host-properties to associate a telnet
+;; program and login name with each host you regularly telnet to.
+
+;;; Code:
+
+;; to do fix software types for lispm:
+;; to eval current expression.  Also to try to send escape keys correctly.
+;; essentially we'll want the rubout-handler off.
+
+;; filter is simplistic but should be okay for typical shell usage.
+;; needs hacking if it is going to deal with asynchronous output in a sane
+;; manner
+
+(require 'comint)
+
+(defvar telnet-host-properties ()
+  "Specify which telnet program to use for particular hosts.
+Each element has the form (HOSTNAME PROGRAM [LOGIN-NAME])
+HOSTNAME says which machine the element applies to.
+PROGRAM says which program to run, to talk to that machine.
+LOGIN-NAME, which is optional, says what to log in as on that machine.")
+
+(defvar telnet-new-line "\r")
+(defvar telnet-mode-map nil)
+(defvar telnet-prompt-pattern "^[^#$%>\n]*[#$%>] *")
+(defvar telnet-replace-c-g nil)
+(make-variable-buffer-local
+ (defvar telnet-remote-echoes t
+   "True if the telnet process will echo input."))
+(make-variable-buffer-local
+ (defvar telnet-interrupt-string "\C-c" "String sent by C-c."))
+
+(defvar telnet-count 0
+  "Number of output strings from telnet process while looking for password.")
+(make-variable-buffer-local 'telnet-count)
+
+(defvar telnet-program "telnet"
+  "Program to run to open a telnet connection.")
+
+(defvar telnet-initial-count -50
+  "Initial value of `telnet-count'.  Should be set to the negative of the
+number of terminal writes telnet will make setting up the host connection.")
+
+(defvar telnet-maximum-count 4
+  "Maximum value `telnet-count' can have.
+After this many passes, we stop looking for initial setup data.
+Should be set to the number of terminal writes telnet will make
+rejecting one login and prompting again for a username and password.")
+
+(defun telnet-interrupt-subjob ()
+  (interactive)
+  "Interrupt the program running through telnet on the remote host."
+  (send-string nil telnet-interrupt-string))
+
+(defun telnet-c-z ()
+  (interactive)
+  (send-string nil "\C-z"))
+
+(defun send-process-next-char ()
+  (interactive)
+  (send-string nil
+	       (char-to-string
+		(let ((inhibit-quit t))
+		  (prog1 (read-char)
+		    (setq quit-flag nil))))))
+
+; initialization on first load.
+(if telnet-mode-map
+    nil
+  (setq telnet-mode-map (nconc (make-sparse-keymap) comint-mode-map))
+  (define-key telnet-mode-map "\C-m" 'telnet-send-input)
+;  (define-key telnet-mode-map "\C-j" 'telnet-send-input)
+  (define-key telnet-mode-map "\C-c\C-q" 'send-process-next-char)
+  (define-key telnet-mode-map "\C-c\C-c" 'telnet-interrupt-subjob) 
+  (define-key telnet-mode-map "\C-c\C-z" 'telnet-c-z))
+
+;;maybe should have a flag for when have found type
+(defun telnet-check-software-type-initialize (string)
+  "Tries to put correct initializations in.  Needs work."
+  (let ((case-fold-search t))
+    (cond ((string-match "unix" string)
+	 (setq telnet-prompt-pattern comint-prompt-regexp)
+	 (setq telnet-new-line "\n"))
+	((string-match "tops-20" string) ;;maybe add telnet-replace-c-g
+	 (setq telnet-prompt-pattern  "[@>]*"))
+	((string-match "its" string)
+	 (setq telnet-prompt-pattern  "^[^*>\n]*[*>] *"))
+	((string-match "explorer" string)  ;;explorer telnet needs work
+	 (setq telnet-replace-c-g ?\n))))
+  (setq comint-prompt-regexp telnet-prompt-pattern))
+
+(defun telnet-initial-filter (proc string)
+  ;For reading up to and including password; also will get machine type.
+  (save-current-buffer
+    (set-buffer (process-buffer proc))
+    (let ((case-fold-search t))
+      (cond ((string-match "No such host" string)
+	     (kill-buffer (process-buffer proc))
+	     (error "No such host"))
+	    ((string-match "passw" string)
+	     (telnet-filter proc string)
+	     (setq telnet-count 0)
+	     (send-string proc (concat (comint-read-noecho "Password: " t)
+				       telnet-new-line))
+	     (clear-this-command-keys))
+	    (t (telnet-check-software-type-initialize string)
+	       (telnet-filter proc string)
+	       (cond ((> telnet-count telnet-maximum-count)
+		      (set-process-filter proc 'telnet-filter))
+		     (t (setq telnet-count (1+ telnet-count)))))))))
+
+;; Identical to comint-simple-send, except that it sends telnet-new-line
+;; instead of "\n".
+(defun telnet-simple-send (proc string)
+  (comint-send-string proc string)
+  (comint-send-string proc telnet-new-line))
+
+(defun telnet-filter (proc string)
+  (save-excursion
+    (set-buffer (process-buffer proc))
+    (let* ((last-insertion (marker-position (process-mark proc)))
+	   (delta (- (point) last-insertion))
+	   (ie (and comint-last-input-end
+		    (marker-position comint-last-input-end)))
+	   (w (get-buffer-window (current-buffer)))
+	   (ws (and w (window-start w))))
+      (goto-char last-insertion)
+      (insert-before-markers string)
+      (set-marker comint-last-output-start last-insertion)
+      (set-marker (process-mark proc) (point))
+      (if ws (set-window-start w ws t))
+      (if ie (set-marker comint-last-input-end ie))
+      (while (progn (skip-chars-backward "^\C-m" last-insertion)
+		    (> (point) last-insertion))
+	(delete-region (1- (point)) (point)))
+      (goto-char (process-mark proc))
+      (and telnet-replace-c-g
+	   (subst-char-in-region last-insertion (point) ?\C-g
+				 telnet-replace-c-g t))
+      ;; If point is after the insertion place, move it
+      ;; along with the text.
+      (if (> delta 0)
+	  (goto-char (+ (process-mark proc) delta))))))
+
+(defun telnet-send-input ()
+  (interactive)
+;  (comint-send-input telnet-new-line telnet-remote-echoes)
+  (comint-send-input)
+  (if telnet-remote-echoes
+      (delete-region comint-last-input-start
+		     comint-last-input-end)))
+
+;;;###autoload (add-hook 'same-window-regexps "\\*telnet-.*\\*\\(\\|<[0-9]+>\\)")
+
+;;;###autoload
+(defun telnet (host)
+  "Open a network login connection to host named HOST (a string).
+Communication with HOST is recorded in a buffer `*PROGRAM-HOST*'
+where PROGRAM is the telnet program being used.  This program
+is controlled by the contents of the global variable `telnet-host-properties',
+falling back on the value of the global variable `telnet-program'.
+Normally input is edited in Emacs and sent a line at a time."
+  (interactive "sOpen connection to host: ")
+  (let* ((comint-delimiter-argument-list '(?\  ?\t))
+	 (properties (cdr (assoc host telnet-host-properties)))
+	 (telnet-program (if properties (car properties) telnet-program))
+         (name (concat telnet-program "-" (comint-arguments host 0 nil) ))
+	 (buffer (get-buffer (concat "*" name "*")))
+	 (telnet-options (if (cdr properties) (cons "-l" (cdr properties))))
+	 process)
+    (if (and buffer (get-buffer-process buffer))
+	(pop-to-buffer (concat "*" name "*"))
+      (pop-to-buffer 
+       (apply 'make-comint name telnet-program nil telnet-options))
+      (setq process (get-buffer-process (current-buffer)))
+      (set-process-filter process 'telnet-initial-filter)
+      ;; Don't send the `open' cmd till telnet is ready for it.
+      (accept-process-output process)
+      (erase-buffer)
+      (send-string process (concat "open " host "\n"))
+      (telnet-mode)
+      (setq comint-input-sender 'telnet-simple-send)
+      (setq telnet-count telnet-initial-count))))
+
+(put 'telnet-mode 'mode-class 'special)
+
+(defun telnet-mode ()
+  "This mode is for using telnet (or rsh) from a buffer to another host.
+It has most of the same commands as comint-mode.
+There is a variable ``telnet-interrupt-string'' which is the character
+sent to try to stop execution of a job on the remote host.
+Data is sent to the remote host when RET is typed.
+
+\\{telnet-mode-map}
+"
+  (interactive)
+  (comint-mode)
+  (setq major-mode 'telnet-mode
+	mode-name "Telnet"
+	comint-prompt-regexp telnet-prompt-pattern)
+  (use-local-map telnet-mode-map)
+  (run-hooks 'telnet-mode-hook))
+
+;;;###autoload (add-hook 'same-window-regexps "\\*rsh-[^-]*\\*\\(\\|<[0-9]*>\\)")
+
+;;;###autoload
+(defun rsh (host)
+  "Open a network login connection to host named HOST (a string).
+Communication with HOST is recorded in a buffer `*rsh-HOST*'.
+Normally input is edited in Emacs and sent a line at a time."
+  (interactive "sOpen rsh connection to host: ")
+  (require 'shell)
+  (let ((name (concat "rsh-" host )))
+    (pop-to-buffer (make-comint name remote-shell-program nil host))
+    (set-process-filter (get-process name) 'telnet-initial-filter)
+    (telnet-mode)
+    (setq telnet-count -16)))
+
+(provide 'telnet)
+
+;;; telnet.el ends here
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lisp/net/webjump.el	Mon Mar 20 13:12:14 2000 +0000
@@ -0,0 +1,403 @@
+;;; webjump.el --- programmable Web hotlist
+     
+;; Copyright (C) 1996, 1997 Free Software Foundation, Inc.
+
+;; Author:    Neil W. Van Dyke <nwv@acm.org>
+;; Created:   09-Aug-1996
+;; Keywords:  comm www
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;; Commentary:
+
+;; WebJump provides a sort of ``programmable hotlist'' of Web sites that can
+;; quickly be invoked in your Web browser.  Each Web site in the hotlist has a
+;; name, and you select the desired site name via a completing string prompt in
+;; the minibuffer.  The URL for each Web site is defined as a static string or
+;; a built-in or custom function, allowing interactive prompting for
+;; site-specific queries and options.
+
+;; Note that WebJump was originally intended to complement your conventional
+;; browser-based hotlist, not replace it.  (Though there's no reason you
+;; couldn't use WebJump for your entire hotlist if you were so inclined.)
+
+;; The `webjump-sites' variable, which defines the hotlist, defaults to some
+;; example sites.  You'll probably want to override it with your own favorite
+;; sites.  The documentation for the variable describes the syntax.
+
+;; You may wish to add something like the following to your `.emacs' file:
+;;
+;;   (require 'webjump)
+;;   (global-set-key "\C-cj" 'webjump)
+;;   (setq webjump-sites
+;;         (append '(
+;;                   ("My Home Page" . "www.someisp.net/users/joebobjr/")
+;;                   ("Pop's Site"   . "www.joebob-and-son.com/")
+;;                   )
+;;                 webjump-sample-sites))
+;;
+;; The above loads this package, binds `C-c j' to invoke WebJump, and adds your
+;; personal favorite sites to the hotlist.
+
+;; The `webjump-sample-sites' variable mostly contains some site entries that
+;; are expected to be generally relevant to many users, but excluding
+;; those that the GNU project would not want to recommend.
+
+;; The `browse-url' package is used to submit URLs to the browser, so any
+;; browser-specific configuration should be done there.
+
+;;; Code:
+
+;;-------------------------------------------------------- Package Dependencies
+
+(require 'browse-url)
+
+;;------------------------------------------------------------------- Constants
+
+(defvar webjump-sample-sites
+  '(
+
+    ;; FSF, not including Emacs-specific.
+    ("GNU Project FTP Archive" .
+     [mirrors "ftp://ftp.gnu.org/pub/gnu/"
+              ;; ASIA:
+              "ftp://ftp.cs.titech.ac.jp"
+              "ftp://tron.um.u-tokyo.ac.jp/pub/GNU/prep"
+              "ftp://cair-archive.kaist.ac.kr/pub/gnu"
+              "ftp://ftp.nectec.or.th/pub/mirrors/gnu"
+              ;; AUSTRALIA:
+              "ftp://archie.au/gnu"
+              "ftp://archie.oz/gnu"
+              "ftp://archie.oz.au/gnu"
+              ;; AFRICA:
+              "ftp://ftp.sun.ac.za/pub/gnu"
+              ;; MIDDLE-EAST:
+              "ftp://ftp.technion.ac.il/pub/unsupported/gnu"
+              ;; EUROPE:
+              "ftp://irisa.irisa.fr/pub/gnu"
+              "ftp://ftp.univ-lyon1.fr/pub/gnu"
+              "ftp://ftp.mcc.ac.uk"
+              "ftp://unix.hensa.ac.uk/mirrors/uunet/systems/gnu"
+              "ftp://src.doc.ic.ac.uk/gnu"
+              "ftp://ftp.ieunet.ie/pub/gnu"
+              "ftp://ftp.eunet.ch"
+              "ftp://nic.switch.ch/mirror/gnu"
+              "ftp://ftp.informatik.rwth-aachen.de/pub/gnu"
+              "ftp://ftp.informatik.tu-muenchen.de"
+              "ftp://ftp.win.tue.nl/pub/gnu"
+              "ftp://ftp.nl.net"
+              "ftp://ftp.etsimo.uniovi.es/pub/gnu"
+              "ftp://ftp.funet.fi/pub/gnu"
+              "ftp://ftp.denet.dk"
+              "ftp://ftp.stacken.kth.se"
+              "ftp://isy.liu.se"
+              "ftp://ftp.luth.se/pub/unix/gnu"
+              "ftp://ftp.sunet.se/pub/gnu"
+              "ftp://archive.eu.net"
+              ;; SOUTH AMERICA: 
+              "ftp://ftp.inf.utfsm.cl/pub/gnu"
+              "ftp://ftp.unicamp.br/pub/gnu"
+              ;; WESTERN CANADA:
+              "ftp://ftp.cs.ubc.ca/mirror2/gnu"
+              ;; USA:
+              "ftp://wuarchive.wustl.edu/systems/gnu"
+              "ftp://labrea.stanford.edu"
+              "ftp://ftp.digex.net/pub/gnu"
+              "ftp://ftp.kpc.com/pub/mirror/gnu"
+              "ftp://f.ms.uky.edu/pub3/gnu"
+              "ftp://jaguar.utah.edu/gnustuff"
+              "ftp://ftp.hawaii.edu/mirrors/gnu"
+              "ftp://uiarchive.cso.uiuc.edu/pub/gnu"
+              "ftp://ftp.cs.columbia.edu/archives/gnu/prep"
+              "ftp://gatekeeper.dec.com/pub/GNU"
+              "ftp://ftp.uu.net/systems/gnu"])
+    ("GNU Project Home Page" . "www.gnu.org")
+
+    ;; Emacs.
+    ("Emacs Lisp Archive" .
+     "ftp://ftp.emacs.org/pub/")
+
+    ;; Internet search engines.
+    ("AltaVista" . 
+     [simple-query
+      "www.altavista.digital.com"
+      "www.altavista.digital.com/cgi-bin/query?pg=aq&what=web&fmt=.&q="
+      "&r=&d0=&d1="])
+    ("Archie" .
+     [simple-query "hoohoo.ncsa.uiuc.edu/cgi-bin/AA.pl"
+		   "hoohoo.ncsa.uiuc.edu/cgi-bin/AA.pl?query=" ""])
+    ("Lycos" .
+     [simple-query "www.lycos.com"
+                   "www.lycos.com/cgi-bin/pursuit?cat=lycos&query=" ""])
+    ("Yahoo" . 
+     [simple-query "www.yahoo.com" "search.yahoo.com/bin/search?p=" ""])
+
+    ;; Misc. general interest.
+    ("Interactive Weather Information Network" . webjump-to-iwin)
+    ("Usenet FAQs" . 
+     [simple-query "www.cis.ohio-state.edu/hypertext/faq/usenet/FAQ-List.html"
+		   "www.cis.ohio-state.edu/htbin/search-usenet-faqs/form?find="
+		   ""])
+    ("RTFM Usenet FAQs by Group" .
+     "ftp://rtfm.mit.edu/pub/usenet-by-group/")
+    ("RTFM Usenet FAQs by Hierachy" .
+     "ftp://rtfm.mit.edu/pub/usenet-by-hierarchy/")
+    ("X Consortium Archive" . "ftp.x.org")
+    ("Yahoo: Reference" . "www.yahoo.com/Reference/")
+
+    ;; Computer social issues, privacy, professionalism.
+    ("Association for Computing Machinery" . "www.acm.org")
+    ("Computer Professionals for Social Responsibility" . "www.cpsr.org/dox/")
+    ("Electronic Frontier Foundation" . "www.eff.org")
+    ("IEEE Computer Society" . "www.computer.org")
+    ("Risks Digest" . webjump-to-risks)
+
+    ;; Fun.
+    ("Bastard Operator from Hell" . "www.replay.com/bofh/")
+
+    )
+  "Sample hotlist for WebJump.  See the documentation for the `webjump'
+function and the `webjump-sites' variable.")
+
+(defvar webjump-state-to-postal-alist
+  '(("Alabama" . "al") ("Alaska" . "ak") ("Arizona" . "az") ("Arkansas" . "ar")
+    ("California" . "ca") ("Colorado" . "co") ("Connecticut" . "ct")
+    ("Delaware" . "de") ("Florida" . "fl") ("Georgia" . "ga") ("Hawaii" . "hi")
+    ("Idaho" . "id") ("Illinois" . "il") ("Indiana" . "in") ("Iowa" . "ia")
+    ("Kansas" . "ks") ("Kentucky" . "ky") ("Louisiana" . "la") ("Maine" . "me")
+    ("Maryland" . "md") ("Massachusetts" . "ma") ("Michigan" . "mi")
+    ("Minnesota" . "mn") ("Mississippi" . "ms") ("Missouri" . "mo")
+    ("Montana" . "mt") ("Nebraska" . "ne") ("Nevada" . "nv")
+    ("New Hampshire" . "nh") ("New Jersey" . "nj") ("New Mexico" . "nm")
+    ("New York" . "ny") ("North Carolina" . "nc") ("North Dakota" . "nd")
+    ("Ohio" . "oh") ("Oklahoma" . "ok") ("Oregon" . "or")
+    ("Pennsylvania" . "pa") ("Rhode Island" . "ri") ("South Carolina" . "sc")
+    ("South Dakota" . "sd") ("Tennessee" . "tn") ("Texas" . "tx")
+    ("Utah" . "ut") ("Vermont" . "vt") ("Virginia" . "va")
+    ("Washington" . "wa") ("West Virginia" . "wv") ("Wisconsin" . "wi")
+    ("Wyoming" . "wy")))
+
+;;------------------------------------------------------------ Option Variables
+
+(defvar webjump-sites
+  webjump-sample-sites
+  "*Hotlist for WebJump.
+
+The hotlist is represented as an association list, with the CAR of each cell
+being the name of the Web site, and the CDR being the definition for the URL of
+that site.  The URL definition can be a string (the URL), a vector (specifying
+a special \"builtin\" which returns a URL), a symbol (name of a function which
+returns a URL), or a list (which when `eval'ed yields a URL).
+
+If the URL definition is a vector, then a \"builtin\" is used.  A builtin has a
+Lisp-like syntax, with the name as the first element of the vector, and any
+arguments as the following elements.  The three current builtins are `name',
+which returns the name of the site as the URL, `simple-query', which
+returns a URL that is a function of a query entered by the user, and `mirrors',
+which allows the user to select from among multiple mirror sites for the same
+content.
+
+The first argument to the `simple-query' builtin is a static URL to use if the
+user enters a blank query.  The second and third arguments are the prefix and
+suffix, respectively, to add to the encoded query the user enters.  This
+builtin covers Web sites that have single-string searches with the query
+embedded in the URL.
+
+The arguments to the `mirrors' builtin are URLs of mirror sites.
+
+If the symbol of a function is given, then the function will be called with the
+Web site name (the one you specified in the CAR of the alist cell) as a
+parameter.  This might come in handy for various kludges.
+
+For convenience, if the `http://', `ftp://', or `file://' prefix is missing
+from a URL, WebJump will make a guess at what you wanted and prepend it before
+submitting the URL.")
+
+;;------------------------------------------------------- Sample Site Functions
+
+(defun webjump-to-iwin (name)
+  (let ((prefix "http://iwin.nws.noaa.gov/")
+        (state (webjump-read-choice name "state"
+                                    (append '(("Puerto Rico" . "pr"))
+                                            webjump-state-to-postal-alist))))
+    (if state
+        (concat prefix "iwin/" state "/"
+                (webjump-read-choice name "option"
+                                     '(("Hourly Report" . "hourly")
+                                       ("State Forecast" . "state")
+                                       ("Local Forecast" . "local")
+                                       ("Zone Forecast" . "zone")
+                                       ("Short-Term Forecast" . "shortterm")
+                                       ("Weather Summary" . "summary")
+                                       ("Public Information" . "public")
+                                       ("Climatic Data" . "climate")
+                                       ("Aviation Products" . "aviation")
+                                       ("Hydro Products" . "hydro")
+                                       ("Special Weather" . "special")
+                                       ("Watches and Warnings" . "warnings"))
+                                     "zone")
+                ".html")
+      prefix)))
+
+(defun webjump-to-risks (name)
+  (let (issue volume)
+    (if (and (setq volume (webjump-read-number (concat name " volume")))
+	     (setq issue  (webjump-read-number (concat name " issue"))))
+	(format "catless.ncl.ac.uk/Risks/%d.%02d.html" volume issue)
+      "catless.ncl.ac.uk/Risks/")))
+
+;;-------------------------------------------------------------- Core Functions
+
+;;;###autoload
+(defun webjump ()
+  "Jumps to a Web site from a programmable hotlist.
+
+See the documentation for the `webjump-sites' variable for how to customize the
+hotlist.
+
+Please submit bug reports and other feedback to the author, Neil W. Van Dyke
+<nwv@acm.org>."
+  (interactive)
+  (let* ((completion-ignore-case t)
+	 (item (assoc-ignore-case
+		(completing-read "WebJump to site: " webjump-sites nil t)
+		webjump-sites))
+	 (name (car item))
+	 (expr (cdr item)))
+    (browse-url (webjump-url-fix
+		 (cond ((not expr) "")
+		       ((stringp expr) expr)
+		       ((vectorp expr) (webjump-builtin expr name))
+		       ((listp expr) (eval expr))
+		       ((symbolp expr)
+			(if (fboundp expr)
+			    (funcall expr name)
+			  (error "WebJump URL function \"%s\" undefined." 
+				 expr)))
+		       (t (error "WebJump URL expression for \"%s\" invalid."
+				 name)))))))
+
+(defun webjump-builtin (expr name)
+  (if (< (length expr) 1)
+      (error "WebJump URL builtin for \"%s\" empty." name))
+  (let ((builtin (aref expr 0)))
+    (cond
+     ((eq builtin 'mirrors)
+      (if (= (length expr) 1)
+          (error
+           "WebJump URL builtin \"mirrors\" for \"%s\" needs at least 1 arg."))
+      (webjump-choose-mirror name (cdr (append expr nil))))
+     ((eq builtin 'name)
+      name)
+     ((eq builtin 'simple-query)
+      (webjump-builtin-check-args expr name 3)
+      (webjump-do-simple-query name (aref expr 1) (aref expr 2) (aref expr 3)))
+     (t (error "WebJump URL builtin \"%s\" for \"%s\" invalid."
+	       builtin name)))))
+
+(defun webjump-builtin-check-args (expr name count)
+  (or (= (length expr) (1+ count))
+      (error "WebJump URL builtin \"%s\" for \"%s\" needs %d args."
+	     (aref expr 0) name count)))
+
+(defun webjump-choose-mirror (name urls)
+  (webjump-read-url-choice (concat name " mirror")
+                           urls
+                           (webjump-mirror-default urls)))
+
+(defun webjump-do-simple-query (name noquery-url query-prefix query-suffix)
+  (let ((query (webjump-read-string (concat name " query"))))
+    (if query
+	(concat query-prefix (webjump-url-encode query) query-suffix)
+      noquery-url)))
+
+(defun webjump-mirror-default (urls)
+  ;; Note: This should be modified to apply some simple kludges/heuristics to
+  ;; pick a site which is likely "close".  As a tie-breaker among candidates
+  ;; judged equally desirable, randomness might be used.
+  (car urls))
+
+(defun webjump-read-choice (name what choices &optional default)
+  (let* ((completion-ignore-case t)
+         (choice (completing-read (concat name " " what ": ") choices nil t)))
+    (if (webjump-null-or-blank-string-p choice)
+        default
+      (cdr (assoc choice choices)))))
+
+(defun webjump-read-number (prompt)
+  ;; Note: I should make this more robust someday.
+  (let ((input (webjump-read-string prompt)))
+    (if input (string-to-number input))))
+  
+(defun webjump-read-string (prompt)
+  (let ((input (read-string (concat prompt ": "))))
+    (if (webjump-null-or-blank-string-p input) nil input)))
+  
+(defun webjump-read-url-choice (what urls &optional default)
+  ;; Note: Convert this to use `webjump-read-choice' someday.
+  (let* ((completions (mapcar (function (lambda (n) (cons n n)))
+                              urls))
+	 (input (completing-read (concat what
+                                         ;;(if default " (RET for default)" "")
+                                         ": ")
+                                 completions
+                                 nil
+                                 t)))
+    (if (webjump-null-or-blank-string-p input)
+        default
+      (car (assoc input completions)))))
+
+(defun webjump-null-or-blank-string-p (str)
+  (or (null str) (string-match "^[ \t]*$" str)))
+
+(defun webjump-url-encode (str)
+  (mapconcat '(lambda (c)
+		(cond ((= c 32) "+")
+		      ((or (and (>= c ?a) (<= c ?z))
+			   (and (>= c ?A) (<= c ?Z))
+			   (and (>= c ?0) (<= c ?9)))
+		       (char-to-string c))
+		      (t (upcase (format "%%%02x" c)))))
+	     str
+	     ""))
+
+(defun webjump-url-fix (url)
+  (if (webjump-null-or-blank-string-p url)
+      ""
+    (webjump-url-fix-trailing-slash
+     (cond
+      ((string-match "^[a-zA-Z]+:" url) url)
+      ((string-match "^/" url) (concat "file://" url))
+      ((string-match "^\\([^\\./]+\\)" url)
+       (concat (if (string= (downcase (match-string 1 url)) "ftp")
+		   "ftp"
+		 "http")
+	       "://"
+	       url))
+      (t url)))))
+
+(defun webjump-url-fix-trailing-slash (url)
+  (if (string-match "^[a-zA-Z]+://[^/]+$" url)
+      (concat url "/")
+    url))
+
+;;-----------------------------------------------------------------------------
+
+(provide 'webjump)
+
+;; webjump.el ends here
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/lisp/net/zone-mode.el	Mon Mar 20 13:12:14 2000 +0000
@@ -0,0 +1,117 @@
+;;; zone-mode.el -- major mode for editing DNS zone files.
+
+;; Copyright (C) 1998 Free Software Foundation, Inc.
+
+;; Author: John Heidemann <johnh@isi.edu>
+;; Keywords: DNS, languages
+
+;; This file is part of GNU Emacs.
+
+;; GNU Emacs is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2, or (at your option)
+;; any later version.
+
+;; GNU Emacs is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with GNU Emacs; see the file COPYING.  If not, write to the
+;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
+;; Boston, MA 02111-1307, USA.
+
+;;;
+;;; See the comments in ``define-derived-mode zone-mode''
+;;; (the last function in this file)
+;;; for what this mode is and how to use it automatically.
+;;;
+
+;;;
+;;; Credits:
+;;; Zone-mode was written by John Heidemann <johnh@isi.edu>,
+;;; with bug fixes from Simon Leinen <simon@limmat.switch.ch>.
+;;;
+
+;;; Code:
+
+(defun zone-mode-update-serial ()
+  "Update the serial number in a zone."
+  (interactive)
+  (save-excursion
+    (goto-char (point-min))
+    (while (re-search-forward "\\b\\([0-9]+\\)\\([0-9][0-9]\\)\\([ \t]+;[ \t]+[Ss]erial\\)" (point-max) t)
+      (let* ((old-date (match-string 1))
+	     (old-seq (match-string 2))
+	     (old-seq-num (string-to-number (match-string 2)))
+	     (old-flag (match-string 3))
+	     (cur-date (format-time-string "%Y%m%d"))
+	     (new-seq
+	      (cond
+	       ((not (string= old-date cur-date))
+		"00") ;; reset sequeence number
+	       ((>= old-seq-num 99)
+		(error "Serial number's sequenece cannot increment beyond 99."))
+	       (t
+		(format "%02d" (1+ old-seq-num)))))
+	     (old-serial (concat old-date old-seq))
+	     (new-serial (concat cur-date new-seq)))
+	(if (string-lessp new-serial old-serial)
+	    (error (format "Serial numbers want to move backwards from %s to %s!" old-serial new-serial))
+	  (replace-match (concat cur-date new-seq old-flag) t t))))))
+  
+;;;###autoload
+(defun zone-mode-update-serial-hook ()
+  "Update the serial number in a zone if the file was modified"
+  (interactive)
+  (if (buffer-modified-p (current-buffer))
+      (zone-mode-update-serial))
+  nil ;; so we can run from write-file-hooks
+  )
+
+(defvar zone-mode-syntax-table nil
+  "Zone-mode's syntax table.")
+
+(defun zone-mode-load-time-setup ()
+  "init zone-mode stuff"
+  (setq zone-mode-syntax-table (make-syntax-table))
+  (modify-syntax-entry ?\; "<" zone-mode-syntax-table)
+  (modify-syntax-entry ?\n ">" zone-mode-syntax-table))
+
+;;;###autoload
+(define-derived-mode zone-mode fundamental-mode "zone"
+  "A mode for editing DNS zone files.
+
+Zone-mode does two things:
+
+	- automatically update the serial number for a zone
+		when saving the file
+
+	- fontification"
+
+  (make-local-hook 'write-file-hooks)
+  (add-hook 'write-file-hooks 'zone-mode-update-serial-hook)
+
+  (if (null zone-mode-syntax-table)
+      (zone-mode-load-time-setup)) ;; should have been run at load-time
+
+  ;; font-lock support:
+  (set-syntax-table zone-mode-syntax-table)
+  (make-local-variable 'comment-start)
+  (setq comment-start ";")
+  (make-local-variable 'comment-start-skip)
+  ;; Look within the line for a ; following an even number of backslashes
+  ;; after either a non-backslash or the line beginning.
+  (setq comment-start-skip "\\(\\(^\\|[^\\\\\n]\\)\\(\\\\\\\\\\)*\\);+[ \t]*")
+  (make-local-variable 'comment-column)
+  (setq comment-column 40)
+  (make-local-variable 'font-lock-defaults)
+  (setq font-lock-defaults
+	'(nil nil nil nil beginning-of-line)))
+
+(zone-mode-load-time-setup)
+
+(provide 'zone-mode)
+
+;;; zone-mode.el ends here