comparison lisp/ffap.el @ 88155:d7ddb3e565de

sync with trunk

88154:8ce476d3ba36

;;; ffap.el --- find file (or url) at point
;;
;; Copyright (C) 1995, 96, 97, 2000  Free Software Foundation, Inc.
;;
;; Author: Michelangelo Grigni <[e-mail]>
;; Created: 29 Mar 1993
;; Keywords: files, hypermedia, matching, mouse, convenience
;; X-URL: ftp://ftp.mathcs.emory.edu/pub/mic/emacs/

;; This file is part of GNU Emacs.

;; 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:
;;
;; Command find-file-at-point replaces find-file.  With a prefix, it

;;
;; (ffap-bindings)                      ; do default key bindings
;;
;; ffap-bindings makes the following global key bindings:
;;
;; C-x C-f       find-file-at-point (abbreviated as ffap)
;; C-x d         dired-at-point
;; C-x 4 f       ffap-other-window
;; C-x 5 f       ffap-other-frame
;; S-mouse-3     ffap-at-mouse
;; C-S-mouse-3   ffap-menu
;;
;; ffap-bindings also adds hooks to make the following local bindings
;; in vm, gnus, and rmail:

;; option variables.  In particular, if ffap is slow, try these:
;;
;; (setq ffap-alist nil)                ; faster, dumber prompting
;; (setq ffap-machine-p-known 'accept)  ; no pinging
;; (setq ffap-url-regexp nil)           ; disable URL features in ffap
;;
;; ffap uses `browse-url' (if found, else `w3-fetch') to fetch URL's.
;; For a hairier `ffap-url-fetcher', try ffap-url.el (same ftp site).
;; Also, you can add `ffap-menu-rescan' to various hooks to fontify
;; the file and URL references within a buffer.

;; which also has some old examples and commentary from ffap 1.5.


;;; Todo list:
;; * use kpsewhich
;; * let "/path/file#key" jump to key (tag or regexp) in /path/file
;; * find file of symbol if TAGS is loaded (like above)
;; * break long menus into multiple panes (like imenu?)
;; * notice node in "(dired)Virtual Dired" (quotes, parentheses, whitespace)
;; * notice "machine.dom blah blah blah path/file" (how?)
;; * as w3 becomes standard, rewrite to rely more on its functions
;; * regexp options for ffap-string-at-point, like font-lock (MCOOK)
;; * v19: could replace `ffap-locate-file' with a quieter `locate-library'
;; * handle "$(VAR)" in Makefiles
;; * use the font-lock machinery

Otherwise return nil (or the optional DEFAULT value)."
  ;; Bug: (ffap-soft-value "nil" 5) --> 5
  (let ((sym (intern-soft name)))
    (if (and sym (boundp sym)) (symbol-value sym) default)))

(defcustom ffap-ftp-regexp
  ;; This used to test for ange-ftp or efs being present, but it should be
  ;; harmless (and simpler) to give it this value unconditionally.
  "\\`/[^/:]+:"
  "*Paths matching this regexp are treated as remote ftp paths by ffap.
If nil, ffap neither recognizes nor generates such paths."
  :type '(choice (const :tag "Disable" nil)
		 (const :tag "Standard" "\\`/[^/:]+:")
		 regexp)
  :group 'ffap)

(defcustom ffap-url-unwrap-local t
  "*If non-nil, convert `file:' url to local path before prompting."
  :type 'boolean
  :group 'ffap)

(defcustom ffap-url-unwrap-remote t
  "*If non-nil, convert `ftp:' url to remote path before prompting.
This is ignored if `ffap-ftp-regexp' is nil."
  :type 'boolean
  :group 'ffap)

(defcustom ffap-ftp-default-user "anonymous"
  "*User name in ftp paths generated by `ffap-host-to-path'.
Note this name may be omitted if it equals the default
\(either `efs-default-user' or `ange-ftp-default-user'\)."
  :type 'string
  :group 'ffap)

(defcustom ffap-rfs-regexp
  ;; Remote file access built into file system?  HP rfa or Andrew afs:
  "\\`/\\(afs\\|net\\)/."
  ;; afs only: (and (file-exists-p "/afs") "\\`/afs/.")
  "*Matching paths are treated as remote.  nil to disable."
  :type 'regexp
  :group 'ffap)

(defvar ffap-url-regexp
  ;; Could just use `url-nonrelative-link' of w3, if loaded.

;; those features interesting but not clear winners (a matter of
;; personal taste) I try to leave options to enable them.  Read
;; through this section for features that you like, put an appropriate
;; enabler in your .emacs file.

(defcustom ffap-dired-wildcards nil
  ;; Suggestion from RHOGEE, 07 Jul 1994.  Disabled, dired is still
  ;; available by "C-x C-d <pattern>", and valid filenames may
  ;; sometimes contain wildcard characters.
  "*A regexp matching filename wildcard characters, or nil.
If `find-file-at-point' gets a filename matching this pattern,
it passes it on to `dired' instead of `find-file'."
  :type '(choice (const :tag "Disable" nil)
		 (const :tag "Enable" "[*?][^/]*\\'")
		 ;; regexp -- probably not useful
		 )
  :group 'ffap)

(defcustom ffap-newfile-prompt nil
  ;; Suggestion from RHOGEE, 11 Jul 1994.  Disabled, I think this is
  ;; better handled by `find-file-not-found-hooks'.

(defcustom ffap-file-finder 'find-file
  "*The command called by `find-file-at-point' to find a file."
  :type 'function
  :group 'ffap)
(put 'ffap-file-finder 'risky-local-variable t)

(defcustom ffap-url-fetcher
  (if (fboundp 'browse-url)
      'browse-url			; rely on browse-url-browser-function
    'w3-fetch)

	      (t (signal (car error) (cdr error))))))))))))


;;; Possibly Remote Resources:

(defun ffap-replace-path-component (fullname name)
  "In remote FULLNAME, replace path with NAME.  May return nil."
  ;; Use ange-ftp or efs if loaded, but do not load them otherwise.
  (let (found)
    (mapcar
     (function (lambda (sym) (and (fboundp sym) (setq found sym))))

       efs-replace-path-component
       ange-ftp-replace-path-component
       ange-ftp-replace-name-component
       ))
    (and found
	 (fset 'ffap-replace-path-component found)
	 (funcall found fullname name))))
;; (ffap-replace-path-component "/[e-mail]:/whatever" "/new")

(defun ffap-file-suffix (file)
  "Return trailing `.foo' suffix of FILE, or nil if none."
  (let ((pos (string-match "\\.[^./]*\\'" file)))
    (and pos (substring file pos nil))))

      ret))))

(defun ffap-file-remote-p (filename)
  "If FILENAME looks remote, return it (maybe slightly improved)."
  ;; (ffap-file-remote-p "/[e-mail]:/pub")
  ;; (ffap-file-remote-p "/cssun.mathcs.emory.edu://path")
  ;; (ffap-file-remote-p "/ffap.el:80")
  (or (and ffap-ftp-regexp
	   (string-match ffap-ftp-regexp filename)
	   ;; Convert "/host.com://path" to "/host:/path", to handle a dieing
	   ;; practice of advertising ftp paths as "host.dom://path".
	   (if (string-match "//" filename)
	       ;; (replace-match "/" nil nil filename)
	       (concat (substring filename 0 (1+ (match-beginning 0)))
		       (substring filename (match-end 0)))
	     filename))

(defun ffap-machine-at-point nil
  "Return machine name at point if it exists, or nil."
  (let ((mach (ffap-string-at-point 'machine)))
    (and (ffap-machine-p mach) mach)))

(defsubst ffap-host-to-path (host)
  "Convert HOST to something like \"/USER@HOST:\" or \"/HOST:\".
Looks at `ffap-ftp-default-user', returns \"\" for \"localhost\"."
  (if (equal host "localhost")
      ""
    (let ((user ffap-ftp-default-user))

	      (equal user (ffap-soft-value "efs-default-user")))
	  (setq user nil))
      (concat "/" user (and user "@") host ":"))))

(defun ffap-fixup-machine (mach)
  ;; Convert a hostname into an url, an ftp path, or nil.
  (cond
   ((not (and ffap-url-regexp (stringp mach))) nil)
   ;; gopher.well.com
   ((string-match "\\`gopher[-.]" mach)	; or "info"?
    (concat "gopher://" mach "/"))
   ;; www.ncsa.uiuc.edu
   ((and (string-match "\\`w\\(ww\\|eb\\)[-.]" mach))
    (concat "http://" mach "/"))
   ;; More cases?  Maybe "telnet:" for archie?
   (ffap-ftp-regexp (ffap-host-to-path mach))
   ))

(defvar ffap-newsgroup-regexp "^[a-z]+\\.[-+a-z_0-9.]+$"
  "Strings not matching this fail `ffap-newsgroup-p'.")
(defvar ffap-newsgroup-heads		; entirely inadequate

       (substring url (1+ (match-end 1)))))
(defsubst ffap-url-unwrap-remote (url)
  "Return URL as a remote file, or nil.  Ignores `ffap-url-regexp'."
  (and (string-match "\\`\\(ftp\\|file\\)://\\([^:/]+\\):?\\(/.*\\)" url)
       (concat
	(ffap-host-to-path (substring url (match-beginning 2) (match-end 2)))
	(substring url (match-beginning 3) (match-end 3)))))
;; Test: (ffap-url-unwrap-remote "ftp://foo.com/bar.boz")

(defun ffap-fixup-url (url)
  "Clean up URL and return it, maybe as a file name."

   ((fboundp 'url-normalize-url)	; may autoload url (part of w3)
    (url-normalize-url url))
   (url)))


;;; Path Handling:
;;
;; The upcoming ffap-alist actions need various utilities to prepare
;; and search paths of directories.  Too many features here.

;; (defun ffap-last (l) (while (cdr l) (setq l (cdr l))) l)
;; (defun ffap-splice (func inlist)
;;  "Equivalent to (apply 'nconc (mapcar FUNC INLIST)), but less consing."
;;  (let* ((head (cons 17 nil)) (last head))

	       (list dir))))
	  path)))

(defun ffap-locate-file (file &optional nosuffix path dir-ok)
  ;; The Emacs 20 version of locate-library could almost replace this,
  ;; except it does not let us overrride the suffix list.  The
  ;; compression-suffixes search moved to ffap-file-exists-string.
  "A generic path-searching function, mimics `load' by default.
Returns path to file that \(load FILE\) would load, or nil.
Optional NOSUFFIX, if nil or t, is like the fourth argument
for load: whether to try the suffixes (\".elc\" \".el\" \"\").

    ;; Inside an LCD entry like |~/misc/ffap.el.Z|,
    ;; or maybe the holy LCD-Datafile itself:
    (member (ffap-string-around) '("||" "|\n")))
   (concat
    ;; lispdir.el may not be loaded yet:
    (ffap-host-to-path
     (ffap-soft-value "elisp-archive-host"
		      "archive.cis.ohio-state.edu"))
    (file-name-as-directory
     (ffap-soft-value "elisp-archive-directory"
		      "/pub/gnu/emacs/elisp-archive/"))
    (substring name 2))))

(defvar ffap-rfc-path
  (concat (ffap-host-to-path "ds.internic.net") "/rfc/rfc%s.txt"))

(defun ffap-rfc (name)
  (format ffap-rfc-path
	  (substring name (match-beginning 1) (match-end 1))))

  '(
    ;; The default, used when the `major-mode' is not found.
    ;; Slightly controversial decisions:
    ;; * strip trailing "@" and ":"
    ;; * no commas (good for latex)
    (file "--:$+<>@-Z_a-z~" "<@" "@>;.,!?:")
    ;; An url, or maybe a email/news message-id:
    (url "--:=&?$+@-Z_a-z~#,%" "^A-Za-z0-9" ":;.,!?")
    ;; Find a string that does *not* contain a colon:
    (nocolon "--9$+<>@-Z_a-z~" "<@" "@>;.,!?")
    ;; A machine:
    (machine "-a-zA-Z0-9." "" ".")
    ;; Mathematica paths: allow backquotes

(defun ffap-string-at-point (&optional mode)
  "Return a string of characters from around point.
MODE (defaults to value of `major-mode') is a symbol used to look up string
syntax parameters in `ffap-string-at-point-mode-alist'.
If MODE is not found, we use `file' instead of MODE.
Sets `ffap-string-at-point' and `ffap-string-at-point-region'."
  (let* ((args
	  (cdr
	   (or (assq (or mode major-mode) ffap-string-at-point-mode-alist)
	       (assq 'file ffap-string-at-point-mode-alist))))
	 (pt (point))
	 (str
	  (buffer-substring
	   (save-excursion
	     (skip-chars-backward (car args))
	     (skip-chars-forward (nth 1 args) pt)
	     (setcar ffap-string-at-point-region (point)))
	   (save-excursion
	     (skip-chars-forward (car args))
	     (skip-chars-backward (nth 2 args) pt)
	     (setcar (cdr ffap-string-at-point-region) (point))))))
    (set-text-properties 0 (length str) nil str)
    (setq ffap-string-at-point str)))

(defun ffap-string-around nil
  ;; Sometimes useful to decide how to treat a string.

   ffap-ftp-regexp
   ;; Note: by now, we know it is not an url.
   ;; Icky regexp avoids: default: 123: foo::bar cs:pub
   ;; It does match on: mic@cs: cs:/pub mathcs.emory.edu: (point at end)
   "\\`\\([^:@]+@[^:@]+:\\|[^@.:]+\\.[^@:]+:\\|[^:]+:[~/]\\)\\([^:]\\|\\'\\)")
  "Strings matching this are coerced to ftp paths by ffap.
That is, ffap just prepends \"/\".  Set to nil to disable.")

(defun ffap-file-at-point nil
  "Return filename from around point if it exists, or nil.
Existence test is skipped for names that look remote.
If the filename is not obvious, it also tries `ffap-alist',
which may actually result in an url rather than a filename."
  ;; Note: this function does not need to look for url's, just
  ;; filenames.  On the other hand, it is responsible for converting
  ;; a pseudo-url "site.com://path" to an ftp path
  (let* ((case-fold-search t)		; url prefixes are case-insensitive
	 (data (match-data))
	 (string (ffap-string-at-point)) ; uses mode alist
	 (name
	  (or (condition-case nil

	      string))
	 (abs (file-name-absolute-p name))
	 (default-directory default-directory))
    (unwind-protect
	(cond
	 ;; Immediate rejects (/ and // are too common in C++):
         ((member name '("" "/" "//" ".")) nil)
         ;; Immediately test local filenames.  If default-directory is
         ;; remote, you probably already have a connection.
         ((and (not abs) (ffap-file-exists-string name)))
         ;; Try stripping off line numbers; good for compilation/grep output.
         ((and (not abs) (string-match ":[0-9]" name)
               (ffap-file-exists-string (substring name 0 (match-beginning 0)))))
	 ;; Immediately test local filenames.  If default-directory is
	 ;; remote, you probably already have a connection.
	 ((and (not abs) (ffap-file-exists-string name)))
	 ;; Accept remote names without actual checking (too slow):
	 ((if abs
	      (ffap-file-remote-p name)
	    ;; Try adding a leading "/" (common omission in ftp paths):
	    (and
	     ffap-ftp-sans-slash-regexp
	     (string-match ffap-ftp-sans-slash-regexp name)
	     (ffap-file-remote-p (concat "/" name)))))
	 ;; Ok, not remote, try the existence test even if it is absolute:

				  (ffap-file-remote-p try)
				  (ffap-file-exists-string try))))))
	    try))
	 ;; Alist failed?  Try to guess an active remote connection
	 ;; from buffer variables, and try once more, both as an
	 ;; absolute and relative path on that remote host.
	 ((let* (ffap-rfs-regexp	; suppress
		 (remote-dir
		  (cond
		   ((ffap-file-remote-p default-directory))
		   ((and (eq major-mode 'internal-ange-ftp-mode)

		   )))
	    (and remote-dir
		 (or
		  (and (string-match "\\`\\(/?~?ftp\\)/" name)
		       (ffap-file-exists-string
			(ffap-replace-path-component
			 remote-dir (substring name (match-end 1)))))
		  (ffap-file-exists-string
		   (ffap-replace-path-component remote-dir name))))))
	 )
      (set-match-data data))))

;;; Prompting (`ffap-read-file-or-url'):
;;

	     prompt
	     'ffap-read-file-or-url-internal
	     dir
	     nil
	     (if dir (cons guess (length dir)) guess)
	     (list 'file-name-history))))
    ;; Do file substitution like (interactive "F"), suggested by MCOOK.
    (or (ffap-url-p guess) (setq guess (substitute-in-file-name guess)))
    ;; Should not do it on url's, where $ is a common (VMS?) character.
    ;; Note: upcoming url.el package ought to handle this automatically.
    guess))

;; The rest of this page is just to work with package complete.el.
;; This code assumes that you load ffap.el after complete.el.
;;
;; We must inform complete about whether our completion function
;; will do filename style completion.  For earlier versions of
;; complete.el, this requires a defadvice.  For recent versions
;; there may be a special variable for this purpose.

(defun ffap-complete-as-file-p nil
  ;; Will `minibuffer-completion-table' complete the minibuffer
  ;; contents as a filename?  Assumes the minibuffer is current.
  ;; Note: t and non-nil mean somewhat different reasons.

(and
 (featurep 'complete)
 (if (boundp 'PC-completion-as-file-name-predicate)
     ;; modern version of complete.el, just set the variable:
     (setq PC-completion-as-file-name-predicate 'ffap-complete-as-file-p)
   (require 'advice)
   (defadvice PC-do-completion (around ffap-fix act)
     "Work with ffap."
     (let ((minibuffer-completion-table
	    (if (eq t (ffap-complete-as-file-p))
		'read-file-name-internal
	      minibuffer-completion-table)))
       ad-do-it))))


;;; Highlighting (`ffap-highlight'):
;;
;; Based on overlay highlighting in Emacs 19.28 isearch.el.

  "Find FILENAME, guessing a default from text around point.
If `ffap-url-regexp' is not nil, the FILENAME may also be an URL.
With a prefix, this command behaves exactly like `ffap-file-finder'.
If `ffap-require-prefix' is set, the prefix meaning is reversed.
See also the variables `ffap-dired-wildcards', `ffap-newfile-prompt',
and the functions `ffap-file-at-point' and `ffap-url-at-point'.

See <ftp://ftp.mathcs.emory.edu/pub/mic/emacs/> for latest version."
  (interactive)
  (if (and (interactive-p)
	   (if ffap-require-prefix (not current-prefix-arg)
	     current-prefix-arg))
      ;; Do exactly the ffap-file-finder command, even the prompting:

    (or filename (setq filename (ffap-prompter)))
    (cond
     ((ffap-url-p filename)
      (let (current-prefix-arg)		; w3 2.3.25 bug, reported by KPC
	(funcall ffap-url-fetcher filename)))
     ;; This junk more properly belongs in a modified ffap-file-finder:
     ((and ffap-dired-wildcards
	   (string-match ffap-dired-wildcards filename))
      (dired filename))
     ((or (not ffap-newfile-prompt)
	  (file-exists-p filename)
	  (y-or-n-p "File does not exist, create buffer? "))
      (funcall ffap-file-finder
	       ;; expand-file-name fixes "~/~/.emacs" bug sent by CHUCKR.

Applies `ffap-menu-text-plist' text properties at all matches."
  (interactive)
  (let ((ffap-next-regexp (or ffap-menu-regexp ffap-next-regexp))
	(range (- (point-max) (point-min)))
	(mod (buffer-modified-p))	; was buffer modified?
	buffer-read-only		; to set text-properties
	item
	;; Avoid repeated searches of the *mode-alist:
	(major-mode (if (assq major-mode ffap-string-at-point-mode-alist)
			major-mode
		      'file)))

	nil))				; no fallback, return nil
     ;; failure: return nil
     )))


;;; ffap-other-* commands:
;;
;; Requested by KPC.

;; There could be a real `ffap-noselect' function, but we would need
;; at least two new user variables, and there is no w3-fetch-noselect.
;; So instead, we just fake it with a slow save-window-excursion.

(defun ffap-other-window nil
  "Like `ffap', but put buffer in another window.
Only intended for interactive use."
  (interactive)
  (switch-to-buffer-other-window
   (save-window-excursion (call-interactively 'ffap) (current-buffer))))

(defun ffap-other-frame nil
  "Like `ffap', but put buffer in another frame.
Only intended for interactive use."
  (interactive)
  ;; Extra code works around dedicated windows (noted by JENS, 7/96):
  (let* ((win (selected-window)) (wdp (window-dedicated-p win)))
    (unwind-protect
	(progn
	  (set-window-dedicated-p win nil)
	  (switch-to-buffer-other-frame
	   (save-window-excursion
	     (call-interactively 'ffap)
	     (current-buffer))))
      (set-window-dedicated-p win wdp))))


;;; Bug Reporter:

(defun ffap-bug nil

  "Bind `ffap-gnus-next' and `ffap-gnus-menu' to M-l and M-m, resp."
  (set (make-local-variable 'ffap-foo-at-bar-prefix) "news") ; message-id's
  ;; Note "l", "L", "m", "M" are taken:
  (local-set-key "\M-l" 'ffap-gnus-next)
  (local-set-key "\M-m" 'ffap-gnus-menu))

(defun ffap-gnus-wrapper (form)		; used by both commands below
  (and (eq (current-buffer) (get-buffer gnus-summary-buffer))
       (gnus-summary-select-article))	; get article of current line
  ;; Preserve selected buffer, but do not do save-window-excursion,

  (if (and (interactive-p)
	   (if dired-at-point-require-prefix
	       (not current-prefix-arg)
	     current-prefix-arg))
      (let (current-prefix-arg)		; already interpreted
	(call-interactively 'dired))
    (or filename (setq filename (dired-at-point-prompter)))
    (cond
     ((ffap-url-p filename)
      (funcall ffap-url-fetcher filename))
     ((and ffap-dired-wildcards
	   (string-match ffap-dired-wildcards filename))
      (dired filename))
     ((file-exists-p filename)
      (if (file-directory-p filename)
	  (dired (expand-file-name filename))
	(dired (concat (expand-file-name filename) "*"))))
     ((y-or-n-p "Directory does not exist, create it? ")
      (make-directory filename)
      (dired filename))
     ((error "No such file or directory `%s'" filename)))))

(defun dired-at-point-prompter (&optional guess)
  ;; Does guess and prompt step for find-file-at-point.
  ;; Extra complication for the temporary highlighting.
  (unwind-protect
      (ffap-read-file-or-url
       (if ffap-url-regexp "Dired file or URL: " "Dired file: ")
       (prog1
	   (setq guess (or guess (ffap-guesser)))
	 (and guess (ffap-highlight))
	 ))
    (ffap-highlight t)))

;;; Offer default global bindings (`ffap-bindings'):

(defvar ffap-bindings
   '(
     (global-set-key [S-mouse-3] 'ffap-at-mouse)
     (global-set-key [C-S-mouse-3] 'ffap-menu)
     (global-set-key "\C-x\C-f" 'find-file-at-point)
     (global-set-key "\C-x4f"   'ffap-other-window)
     (global-set-key "\C-x5f"   'ffap-other-frame)
     (global-set-key "\C-xd"    'dired-at-point)
     (add-hook 'gnus-summary-mode-hook 'ffap-gnus-hook)
     (add-hook 'gnus-article-mode-hook 'ffap-gnus-hook)
     (add-hook 'vm-mode-hook 'ffap-ro-mode-hook)
     (add-hook 'rmail-mode-hook 'ffap-ro-mode-hook)
     ;; (setq dired-x-hands-off-my-keys t) ; the default

  "Evaluate the forms in variable `ffap-bindings'."
  (interactive)
  (eval (cons 'progn ffap-bindings)))


;;; ffap.el ends here

88155:d7ddb3e565de

;;; ffap.el --- find file (or url) at point

;; Copyright (C) 1995, 1996, 1997, 2000, 2002, 2003, 2004,
;;   2005 Free Software Foundation, Inc.

;; Author: Michelangelo Grigni <[e-mail]>
;; Maintainer: Rajesh Vaidheeswarran  <[e-mail]>
;; Created: 29 Mar 1993
;; Keywords: files, hypermedia, matching, mouse, convenience
;; X-URL: ftp://ftp.mathcs.emory.edu/pub/mic/emacs/

;; This file is part of GNU Emacs.

;; 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., 51 Franklin Street, Fifth Floor,
;; Boston, MA 02110-1301, USA.


;;; Commentary:
;;
;; Command find-file-at-point replaces find-file.  With a prefix, it

;;
;; (ffap-bindings)                      ; do default key bindings
;;
;; ffap-bindings makes the following global key bindings:
;;
;; C-x C-f		find-file-at-point (abbreviated as ffap)
;; C-x C-r		ffap-read-only
;; C-x C-v		ffap-alternate-file
;;
;; C-x d		dired-at-point
;; C-x C-d		ffap-list-directory
;;
;; C-x 4 f		ffap-other-window
;; C-x 4 r		ffap-read-only-other-window
;; C-x 4 d		ffap-dired-other-window
;;
;; C-x 5 f		ffap-other-frame
;; C-x 5 r		ffap-read-only-other-frame
;; C-x 5 d		ffap-dired-other-frame
;;
;; S-mouse-3     ffap-at-mouse
;; C-S-mouse-3   ffap-menu
;;
;; ffap-bindings also adds hooks to make the following local bindings
;; in vm, gnus, and rmail:

;; option variables.  In particular, if ffap is slow, try these:
;;
;; (setq ffap-alist nil)                ; faster, dumber prompting
;; (setq ffap-machine-p-known 'accept)  ; no pinging
;; (setq ffap-url-regexp nil)           ; disable URL features in ffap
;; (setq ffap-shell-prompt-regexp nil)  ; disable shell prompt stripping
;;
;; ffap uses `browse-url' (if found, else `w3-fetch') to fetch URL's.
;; For a hairier `ffap-url-fetcher', try ffap-url.el (same ftp site).
;; Also, you can add `ffap-menu-rescan' to various hooks to fontify
;; the file and URL references within a buffer.

;; which also has some old examples and commentary from ffap 1.5.


;;; Todo list:
;; * use kpsewhich
;; * let "/dir/file#key" jump to key (tag or regexp) in /dir/file
;; * find file of symbol if TAGS is loaded (like above)
;; * break long menus into multiple panes (like imenu?)
;; * notice node in "(dired)Virtual Dired" (quotes, parentheses, whitespace)
;; * notice "machine.dom blah blah blah dir/file" (how?)
;; * as w3 becomes standard, rewrite to rely more on its functions
;; * regexp options for ffap-string-at-point, like font-lock (MCOOK)
;; * v19: could replace `ffap-locate-file' with a quieter `locate-library'
;; * handle "$(VAR)" in Makefiles
;; * use the font-lock machinery

Otherwise return nil (or the optional DEFAULT value)."
  ;; Bug: (ffap-soft-value "nil" 5) --> 5
  (let ((sym (intern-soft name)))
    (if (and sym (boundp sym)) (symbol-value sym) default)))

(defcustom ffap-shell-prompt-regexp
  ;; This used to test for some shell prompts that don't have a space
  ;; after them. The common root shell prompt (#) is not listed since it
  ;; also doubles up as a valid URL character.
  "[$%><]*"
  "Paths matching this regexp are stripped off the shell prompt
If nil, ffap doesn't do shell prompt stripping."
  :type '(choice (const :tag "Disable" nil)
		  (const :tag "Standard" "[$%><]*")
		   regexp)
  :group 'ffap)

(defcustom ffap-ftp-regexp
  ;; This used to test for ange-ftp or efs being present, but it should be
  ;; harmless (and simpler) to give it this value unconditionally.
  "\\`/[^/:]+:"
  "*File names matching this regexp are treated as remote ffap.
If nil, ffap neither recognizes nor generates such names."
  :type '(choice (const :tag "Disable" nil)
		 (const :tag "Standard" "\\`/[^/:]+:")
		 regexp)
  :group 'ffap)

(defcustom ffap-url-unwrap-local t
  "*If non-nil, convert `file:' URL to local file name before prompting."
  :type 'boolean
  :group 'ffap)

(defcustom ffap-url-unwrap-remote t
  "*If non-nil, convert `ftp:' URL to remote file name before prompting.
This is ignored if `ffap-ftp-regexp' is nil."
  :type 'boolean
  :group 'ffap)

(defcustom ffap-ftp-default-user "anonymous"
  "*User name in ftp file names generated by `ffap-host-to-path'.
Note this name may be omitted if it equals the default
\(either `efs-default-user' or `ange-ftp-default-user'\)."
  :type 'string
  :group 'ffap)

(defcustom ffap-rfs-regexp
  ;; Remote file access built into file system?  HP rfa or Andrew afs:
  "\\`/\\(afs\\|net\\)/."
  ;; afs only: (and (file-exists-p "/afs") "\\`/afs/.")
  "*Matching file names are treated as remote.  Use nil to disable."
  :type 'regexp
  :group 'ffap)

(defvar ffap-url-regexp
  ;; Could just use `url-nonrelative-link' of w3, if loaded.

;; those features interesting but not clear winners (a matter of
;; personal taste) I try to leave options to enable them.  Read
;; through this section for features that you like, put an appropriate
;; enabler in your .emacs file.

(defcustom ffap-dired-wildcards "[*?][^/]*\\'"
  "*A regexp matching filename wildcard characters, or nil.

If `find-file-at-point' gets a filename matching this pattern,
and `ffap-pass-wildcards-to-dired' is nil, it passes it on to
`find-file' with non-nil WILDCARDS argument, which expands
wildcards and visits multiple files.  To visit a file whose name
contains wildcard characters you can suppress wildcard expansion
by setting `find-file-wildcards'.  If `find-file-at-point' gets a
filename matching this pattern and `ffap-pass-wildcards-to-dired'
is non-nil, it passes it on to `dired'.

If `dired-at-point' gets a filename matching this pattern,
it passes it on to `dired'."
  :type '(choice (const :tag "Disable" nil)
		 (const :tag "Enable" "[*?][^/]*\\'")
		 ;; regexp -- probably not useful
		 )
  :group 'ffap)

(defcustom ffap-pass-wildcards-to-dired nil
  "*If non-nil, pass filenames matching `ffap-dired-wildcards' to dired."
  :type 'boolean
  :group 'ffap)

(defcustom ffap-newfile-prompt nil
  ;; Suggestion from RHOGEE, 11 Jul 1994.  Disabled, I think this is
  ;; better handled by `find-file-not-found-hooks'.

(defcustom ffap-file-finder 'find-file
  "*The command called by `find-file-at-point' to find a file."
  :type 'function
  :group 'ffap)
(put 'ffap-file-finder 'risky-local-variable t)

(defcustom ffap-directory-finder 'dired
  "*The command called by `dired-at-point' to find a directory."
  :type 'function
  :group 'ffap)
(put 'ffap-directory-finder 'risky-local-variable t)

(defcustom ffap-url-fetcher
  (if (fboundp 'browse-url)
      'browse-url			; rely on browse-url-browser-function
    'w3-fetch)

	      (t (signal (car error) (cdr error))))))))))))


;;; Possibly Remote Resources:

(defun ffap-replace-file-component (fullname name)
  "In remote FULLNAME, replace path with NAME.  May return nil."
  ;; Use ange-ftp or efs if loaded, but do not load them otherwise.
  (let (found)
    (mapcar
     (function (lambda (sym) (and (fboundp sym) (setq found sym))))

       efs-replace-path-component
       ange-ftp-replace-path-component
       ange-ftp-replace-name-component
       ))
    (and found
	 (fset 'ffap-replace-file-component found)
	 (funcall found fullname name))))
;; (ffap-replace-file-component "/[e-mail]:/whatever" "/new")

(defun ffap-file-suffix (file)
  "Return trailing `.foo' suffix of FILE, or nil if none."
  (let ((pos (string-match "\\.[^./]*\\'" file)))
    (and pos (substring file pos nil))))

      ret))))

(defun ffap-file-remote-p (filename)
  "If FILENAME looks remote, return it (maybe slightly improved)."
  ;; (ffap-file-remote-p "/[e-mail]:/pub")
  ;; (ffap-file-remote-p "/cssun.mathcs.emory.edu://dir")
  ;; (ffap-file-remote-p "/ffap.el:80")
  (or (and ffap-ftp-regexp
	   (string-match ffap-ftp-regexp filename)
	   ;; Convert "/host.com://dir" to "/host:/dir", to handle a dieing
	   ;; practice of advertising ftp files as "host.dom://filename".
	   (if (string-match "//" filename)
	       ;; (replace-match "/" nil nil filename)
	       (concat (substring filename 0 (1+ (match-beginning 0)))
		       (substring filename (match-end 0)))
	     filename))

(defun ffap-machine-at-point nil
  "Return machine name at point if it exists, or nil."
  (let ((mach (ffap-string-at-point 'machine)))
    (and (ffap-machine-p mach) mach)))

(defsubst ffap-host-to-filename (host)
  "Convert HOST to something like \"/USER@HOST:\" or \"/HOST:\".
Looks at `ffap-ftp-default-user', returns \"\" for \"localhost\"."
  (if (equal host "localhost")
      ""
    (let ((user ffap-ftp-default-user))

	      (equal user (ffap-soft-value "efs-default-user")))
	  (setq user nil))
      (concat "/" user (and user "@") host ":"))))

(defun ffap-fixup-machine (mach)
  ;; Convert a hostname into an url, an ftp file name, or nil.
  (cond
   ((not (and ffap-url-regexp (stringp mach))) nil)
   ;; gopher.well.com
   ((string-match "\\`gopher[-.]" mach)	; or "info"?
    (concat "gopher://" mach "/"))
   ;; www.ncsa.uiuc.edu
   ((and (string-match "\\`w\\(ww\\|eb\\)[-.]" mach))
    (concat "http://" mach "/"))
   ;; More cases?  Maybe "telnet:" for archie?
   (ffap-ftp-regexp (ffap-host-to-filename mach))
   ))

(defvar ffap-newsgroup-regexp "^[a-z]+\\.[-+a-z_0-9.]+$"
  "Strings not matching this fail `ffap-newsgroup-p'.")
(defvar ffap-newsgroup-heads		; entirely inadequate

       (substring url (1+ (match-end 1)))))
(defsubst ffap-url-unwrap-remote (url)
  "Return URL as a remote file, or nil.  Ignores `ffap-url-regexp'."
  (and (string-match "\\`\\(ftp\\|file\\)://\\([^:/]+\\):?\\(/.*\\)" url)
       (concat
	(ffap-host-to-filename (substring url (match-beginning 2) (match-end 2)))
	(substring url (match-beginning 3) (match-end 3)))))
;; Test: (ffap-url-unwrap-remote "ftp://foo.com/bar.boz")

(defun ffap-fixup-url (url)
  "Clean up URL and return it, maybe as a file name."

   ((fboundp 'url-normalize-url)	; may autoload url (part of w3)
    (url-normalize-url url))
   (url)))


;;; File Name Handling:
;;
;; The upcoming ffap-alist actions need various utilities to prepare
;; and search directories.  Too many features here.

;; (defun ffap-last (l) (while (cdr l) (setq l (cdr l))) l)
;; (defun ffap-splice (func inlist)
;;  "Equivalent to (apply 'nconc (mapcar FUNC INLIST)), but less consing."
;;  (let* ((head (cons 17 nil)) (last head))

	       (list dir))))
	  path)))

(defun ffap-locate-file (file &optional nosuffix path dir-ok)
  ;; The Emacs 20 version of locate-library could almost replace this,
  ;; except it does not let us override the suffix list.  The
  ;; compression-suffixes search moved to ffap-file-exists-string.
  "A generic path-searching function, mimics `load' by default.
Returns path to file that \(load FILE\) would load, or nil.
Optional NOSUFFIX, if nil or t, is like the fourth argument
for load: whether to try the suffixes (\".elc\" \".el\" \"\").

    ;; Inside an LCD entry like |~/misc/ffap.el.Z|,
    ;; or maybe the holy LCD-Datafile itself:
    (member (ffap-string-around) '("||" "|\n")))
   (concat
    ;; lispdir.el may not be loaded yet:
    (ffap-host-to-filename
     (ffap-soft-value "elisp-archive-host"
		      "archive.cis.ohio-state.edu"))
    (file-name-as-directory
     (ffap-soft-value "elisp-archive-directory"
		      "/pub/gnu/emacs/elisp-archive/"))
    (substring name 2))))

(defvar ffap-rfc-path
  (concat (ffap-host-to-filename "ds.internic.net") "/rfc/rfc%s.txt"))

(defun ffap-rfc (name)
  (format ffap-rfc-path
	  (substring name (match-beginning 1) (match-end 1))))

  '(
    ;; The default, used when the `major-mode' is not found.
    ;; Slightly controversial decisions:
    ;; * strip trailing "@" and ":"
    ;; * no commas (good for latex)
    (file "--:$+<>@-Z_a-z~*?" "<@" "@>;.,!:")
    ;; An url, or maybe a email/news message-id:
    (url "--:=&?$+@-Z_a-z~#,%;*" "^A-Za-z0-9" ":;.,!?")
    ;; Find a string that does *not* contain a colon:
    (nocolon "--9$+<>@-Z_a-z~" "<@" "@>;.,!?")
    ;; A machine:
    (machine "-a-zA-Z0-9." "" ".")
    ;; Mathematica paths: allow backquotes

(defun ffap-string-at-point (&optional mode)
  "Return a string of characters from around point.
MODE (defaults to value of `major-mode') is a symbol used to look up string
syntax parameters in `ffap-string-at-point-mode-alist'.
If MODE is not found, we use `file' instead of MODE.
If the region is active, return a string from the region.
Sets `ffap-string-at-point' and `ffap-string-at-point-region'."
  (let* ((args
	  (cdr
	   (or (assq (or mode major-mode) ffap-string-at-point-mode-alist)
	       (assq 'file ffap-string-at-point-mode-alist))))
	 (pt (point))
	 (str
	  (if (and transient-mark-mode mark-active)
	      (buffer-substring
	       (setcar ffap-string-at-point-region (region-beginning))
	       (setcar (cdr ffap-string-at-point-region) (region-end)))
	    (buffer-substring
	     (save-excursion
	       (skip-chars-backward (car args))
	       (skip-chars-forward (nth 1 args) pt)
	       (setcar ffap-string-at-point-region (point)))
	     (save-excursion
	       (skip-chars-forward (car args))
	       (skip-chars-backward (nth 2 args) pt)
	       (setcar (cdr ffap-string-at-point-region) (point)))))))
    (set-text-properties 0 (length str) nil str)
    (setq ffap-string-at-point str)))

(defun ffap-string-around nil
  ;; Sometimes useful to decide how to treat a string.

   ffap-ftp-regexp
   ;; Note: by now, we know it is not an url.
   ;; Icky regexp avoids: default: 123: foo::bar cs:pub
   ;; It does match on: mic@cs: cs:/pub mathcs.emory.edu: (point at end)
   "\\`\\([^:@]+@[^:@]+:\\|[^@.:]+\\.[^@:]+:\\|[^:]+:[~/]\\)\\([^:]\\|\\'\\)")
  "Strings matching this are coerced to ftp file names by ffap.
That is, ffap just prepends \"/\".  Set to nil to disable.")

(defun ffap-file-at-point nil
  "Return filename from around point if it exists, or nil.
Existence test is skipped for names that look remote.
If the filename is not obvious, it also tries `ffap-alist',
which may actually result in an url rather than a filename."
  ;; Note: this function does not need to look for url's, just
  ;; filenames.  On the other hand, it is responsible for converting
  ;; a pseudo-url "site.com://dir" to an ftp file name
  (let* ((case-fold-search t)		; url prefixes are case-insensitive
	 (data (match-data))
	 (string (ffap-string-at-point)) ; uses mode alist
	 (name
	  (or (condition-case nil

	      string))
	 (abs (file-name-absolute-p name))
	 (default-directory default-directory))
    (unwind-protect
	(cond
	 ;; Immediate rejects (/ and // and /* are too common in C/C++):
         ((member name '("" "/" "//" "/*" ".")) nil)
         ;; Immediately test local filenames.  If default-directory is
         ;; remote, you probably already have a connection.
         ((and (not abs) (ffap-file-exists-string name)))
         ;; Try stripping off line numbers; good for compilation/grep output.
         ((and (not abs) (string-match ":[0-9]" name)
               (ffap-file-exists-string (substring name 0 (match-beginning 0)))))
         ;; Try stripping off prominent (non-root - #) shell prompts
	 ;; if the ffap-shell-prompt-regexp is non-nil.
         ((and ffap-shell-prompt-regexp
	       (not abs) (string-match ffap-shell-prompt-regexp name)
               (ffap-file-exists-string (substring name (match-end 0)))))
	 ;; Accept remote names without actual checking (too slow):
	 ((if abs
	      (ffap-file-remote-p name)
	    ;; Try adding a leading "/" (common omission in ftp file names):
	    (and
	     ffap-ftp-sans-slash-regexp
	     (string-match ffap-ftp-sans-slash-regexp name)
	     (ffap-file-remote-p (concat "/" name)))))
	 ;; Ok, not remote, try the existence test even if it is absolute:

				  (ffap-file-remote-p try)
				  (ffap-file-exists-string try))))))
	    try))
	 ;; Alist failed?  Try to guess an active remote connection
	 ;; from buffer variables, and try once more, both as an
	 ;; absolute and relative file name on that remote host.
	 ((let* (ffap-rfs-regexp	; suppress
		 (remote-dir
		  (cond
		   ((ffap-file-remote-p default-directory))
		   ((and (eq major-mode 'internal-ange-ftp-mode)

		   )))
	    (and remote-dir
		 (or
		  (and (string-match "\\`\\(/?~?ftp\\)/" name)
		       (ffap-file-exists-string
			(ffap-replace-file-component
			 remote-dir (substring name (match-end 1)))))
		  (ffap-file-exists-string
		   (ffap-replace-file-component remote-dir name))))))
	 ((and ffap-dired-wildcards
	       (string-match ffap-dired-wildcards name)
	       abs
	       (ffap-file-exists-string (file-name-directory
					 (directory-file-name name)))
	       name))
         ;; Try all parent directories by deleting the trailing directory
         ;; name until existing directory is found or name stops changing
         ((let ((dir name))
            (while (and dir
                        (not (ffap-file-exists-string dir))
                        (not (equal dir (setq dir (file-name-directory
                                                   (directory-file-name dir)))))))
            (ffap-file-exists-string dir)))
	 )
      (set-match-data data))))

;;; Prompting (`ffap-read-file-or-url'):
;;

	     prompt
	     'ffap-read-file-or-url-internal
	     dir
	     nil
	     (if dir (cons guess (length dir)) guess)
	     (list 'file-name-history)
	     (and buffer-file-name
		  (abbreviate-file-name buffer-file-name)))))
    ;; Do file substitution like (interactive "F"), suggested by MCOOK.
    (or (ffap-url-p guess) (setq guess (substitute-in-file-name guess)))
    ;; Should not do it on url's, where $ is a common (VMS?) character.
    ;; Note: upcoming url.el package ought to handle this automatically.
    guess))

;; The rest of this page is just to work with package complete.el.
;; This code assumes that you load ffap.el after complete.el.
;;
;; We must inform complete about whether our completion function
;; will do filename style completion.

(defun ffap-complete-as-file-p nil
  ;; Will `minibuffer-completion-table' complete the minibuffer
  ;; contents as a filename?  Assumes the minibuffer is current.
  ;; Note: t and non-nil mean somewhat different reasons.

(and
 (featurep 'complete)
 (if (boundp 'PC-completion-as-file-name-predicate)
     ;; modern version of complete.el, just set the variable:
     (setq PC-completion-as-file-name-predicate 'ffap-complete-as-file-p)))


;;; Highlighting (`ffap-highlight'):
;;
;; Based on overlay highlighting in Emacs 19.28 isearch.el.

  "Find FILENAME, guessing a default from text around point.
If `ffap-url-regexp' is not nil, the FILENAME may also be an URL.
With a prefix, this command behaves exactly like `ffap-file-finder'.
If `ffap-require-prefix' is set, the prefix meaning is reversed.
See also the variables `ffap-dired-wildcards', `ffap-newfile-prompt',
and the functions `ffap-file-at-point' and `ffap-url-at-point'."
  (interactive)
  (if (and (interactive-p)
	   (if ffap-require-prefix (not current-prefix-arg)
	     current-prefix-arg))
      ;; Do exactly the ffap-file-finder command, even the prompting:

    (or filename (setq filename (ffap-prompter)))
    (cond
     ((ffap-url-p filename)
      (let (current-prefix-arg)		; w3 2.3.25 bug, reported by KPC
	(funcall ffap-url-fetcher filename)))
     ((and ffap-pass-wildcards-to-dired
	   ffap-dired-wildcards
	   (string-match ffap-dired-wildcards filename))
      (funcall ffap-directory-finder filename))
     ((and ffap-dired-wildcards
	   (string-match ffap-dired-wildcards filename)
	   find-file-wildcards
	   ;; Check if it's find-file that supports wildcards arg
	   (memq ffap-file-finder '(find-file find-alternate-file)))
      (funcall ffap-file-finder (expand-file-name filename) t))
     ((or (not ffap-newfile-prompt)
	  (file-exists-p filename)
	  (y-or-n-p "File does not exist, create buffer? "))
      (funcall ffap-file-finder
	       ;; expand-file-name fixes "~/~/.emacs" bug sent by CHUCKR.

Applies `ffap-menu-text-plist' text properties at all matches."
  (interactive)
  (let ((ffap-next-regexp (or ffap-menu-regexp ffap-next-regexp))
	(range (- (point-max) (point-min)))
	(mod (buffer-modified-p))	; was buffer modified?
	;; inhibit-read-only works on read-only text properties
	;; as well as read-only buffers.
	(inhibit-read-only t)		; to set text-properties
	item
	;; Avoid repeated searches of the *mode-alist:
	(major-mode (if (assq major-mode ffap-string-at-point-mode-alist)
			major-mode
		      'file)))

	nil))				; no fallback, return nil
     ;; failure: return nil
     )))


;;; ffap-other-*, ffap-read-only-*, ffap-alternate-* commands:

;; There could be a real `ffap-noselect' function, but we would need
;; at least two new user variables, and there is no w3-fetch-noselect.
;; So instead, we just fake it with a slow save-window-excursion.

(defun ffap-other-window nil
  "Like `ffap', but put buffer in another window.
Only intended for interactive use."
  (interactive)
  (let (value)
    (switch-to-buffer-other-window
     (save-window-excursion
       (setq value (call-interactively 'ffap))
       (unless (or (bufferp value) (bufferp (car-safe value)))
	 (setq value (current-buffer)))
       (current-buffer)))
    value))

(defun ffap-other-frame nil
  "Like `ffap', but put buffer in another frame.
Only intended for interactive use."
  (interactive)
  ;; Extra code works around dedicated windows (noted by JENS, 7/96):
  (let* ((win (selected-window))
	 (wdp (window-dedicated-p win))
	 value)
    (unwind-protect
	(progn
	  (set-window-dedicated-p win nil)
	  (switch-to-buffer-other-frame
	   (save-window-excursion
	     (setq value (call-interactively 'ffap))
	     (unless (or (bufferp value) (bufferp (car-safe value)))
	       (setq value (current-buffer)))
	     (current-buffer))))
      (set-window-dedicated-p win wdp))
    value))

(defun ffap-read-only ()
  "Like `ffap', but mark buffer as read-only.
Only intended for interactive use."
  (interactive)
  (let ((value (call-interactively 'ffap)))
    (unless (or (bufferp value) (bufferp (car-safe value)))
      (setq value (current-buffer)))
    (mapc (lambda (b) (with-current-buffer b (toggle-read-only 1)))
	  (if (listp value) value (list value)))
    value))

(defun ffap-read-only-other-window ()
  "Like `ffap', but put buffer in another window and mark as read-only.
Only intended for interactive use."
  (interactive)
  (let ((value (ffap-other-window)))
    (mapc (lambda (b) (with-current-buffer b (toggle-read-only 1)))
	  (if (listp value) value (list value)))
    value))

(defun ffap-read-only-other-frame ()
  "Like `ffap', but put buffer in another frame and mark as read-only.
Only intended for interactive use."
  (interactive)
  (let ((value (ffap-other-frame)))
    (mapc (lambda (b) (with-current-buffer b (toggle-read-only 1)))
	  (if (listp value) value (list value)))
    value))

(defun ffap-alternate-file ()
  "Like `ffap' and `find-alternate-file'.
Only intended for interactive use."
  (interactive)
  (let ((ffap-file-finder 'find-alternate-file))
    (call-interactively 'ffap)))


;;; Bug Reporter:

(defun ffap-bug nil

  "Bind `ffap-gnus-next' and `ffap-gnus-menu' to M-l and M-m, resp."
  (set (make-local-variable 'ffap-foo-at-bar-prefix) "news") ; message-id's
  ;; Note "l", "L", "m", "M" are taken:
  (local-set-key "\M-l" 'ffap-gnus-next)
  (local-set-key "\M-m" 'ffap-gnus-menu))

(defvar gnus-summary-buffer)
(defvar gnus-article-buffer)

(defun ffap-gnus-wrapper (form)		; used by both commands below
  (and (eq (current-buffer) (get-buffer gnus-summary-buffer))
       (gnus-summary-select-article))	; get article of current line
  ;; Preserve selected buffer, but do not do save-window-excursion,

  (if (and (interactive-p)
	   (if dired-at-point-require-prefix
	       (not current-prefix-arg)
	     current-prefix-arg))
      (let (current-prefix-arg)		; already interpreted
	(call-interactively ffap-directory-finder))
    (or filename (setq filename (dired-at-point-prompter)))
    (cond
     ((ffap-url-p filename)
      (funcall ffap-url-fetcher filename))
     ((and ffap-dired-wildcards
	   (string-match ffap-dired-wildcards filename))
      (funcall ffap-directory-finder filename))
     ((file-exists-p filename)
      (if (file-directory-p filename)
	  (funcall ffap-directory-finder
		   (expand-file-name filename))
	(funcall ffap-directory-finder
		 (concat (expand-file-name filename) "*"))))
     ((and (file-writable-p
            (or (file-name-directory (directory-file-name filename))
                filename))
           (y-or-n-p "Directory does not exist, create it? "))
      (make-directory filename)
      (funcall ffap-directory-finder filename))
     ((error "No such file or directory `%s'" filename)))))

(defun dired-at-point-prompter (&optional guess)
  ;; Does guess and prompt step for find-file-at-point.
  ;; Extra complication for the temporary highlighting.
  (unwind-protect
      (ffap-read-file-or-url
       (if ffap-url-regexp "Dired file or URL: " "Dired file: ")
       (prog1
	   (setq guess (or guess
                           (let ((guess (ffap-guesser)))
                             (if (or (not guess)
                                     (ffap-url-p guess)
                                     (ffap-file-remote-p guess))
                                 guess
                               (setq guess (abbreviate-file-name
                                            (expand-file-name guess)))
                               (cond
                                ;; Interpret local directory as a directory.
                                ((file-directory-p guess)
                                 (file-name-as-directory guess))
                                ;; Get directory component from local files.
                                ((file-regular-p guess)
                                 (file-name-directory guess))
                                (guess))))
                           ))
	 (and guess (ffap-highlight))))
    (ffap-highlight t)))

;;; ffap-dired-other-*, ffap-list-directory commands:

(defun ffap-dired-other-window ()
  "Like `dired-at-point', but put buffer in another window.
Only intended for interactive use."
  (interactive)
  (let (value)
    (switch-to-buffer-other-window
     (save-window-excursion
       (setq value (call-interactively 'dired-at-point))
       (current-buffer)))
    value))

(defun ffap-dired-other-frame ()
  "Like `dired-at-point', but put buffer in another frame.
Only intended for interactive use."
  (interactive)
  ;; Extra code works around dedicated windows (noted by JENS, 7/96):
  (let* ((win (selected-window))
	 (wdp (window-dedicated-p win))
	 value)
    (unwind-protect
	(progn
	  (set-window-dedicated-p win nil)
	  (switch-to-buffer-other-frame
	   (save-window-excursion
	     (setq value (call-interactively 'dired-at-point))
	     (current-buffer))))
      (set-window-dedicated-p win wdp))
    value))

(defun ffap-list-directory ()
  "Like `dired-at-point' and `list-directory'.
Only intended for interactive use."
  (interactive)
  (let ((ffap-directory-finder 'list-directory))
    (call-interactively 'dired-at-point)))


;;; Offer default global bindings (`ffap-bindings'):

(defvar ffap-bindings
   '(
     (global-set-key [S-mouse-3] 'ffap-at-mouse)
     (global-set-key [C-S-mouse-3] 'ffap-menu)

     (global-set-key "\C-x\C-f" 'find-file-at-point)
     (global-set-key "\C-x\C-r" 'ffap-read-only)
     (global-set-key "\C-x\C-v" 'ffap-alternate-file)

     (global-set-key "\C-x4f"   'ffap-other-window)
     (global-set-key "\C-x5f"   'ffap-other-frame)
     (global-set-key "\C-x4r"   'ffap-read-only-other-window)
     (global-set-key "\C-x5r"   'ffap-read-only-other-frame)

     (global-set-key "\C-xd"    'dired-at-point)
     (global-set-key "\C-x4d"   'ffap-dired-other-window)
     (global-set-key "\C-x5d"   'ffap-dired-other-frame)
     (global-set-key "\C-x\C-d" 'ffap-list-directory)

     (add-hook 'gnus-summary-mode-hook 'ffap-gnus-hook)
     (add-hook 'gnus-article-mode-hook 'ffap-gnus-hook)
     (add-hook 'vm-mode-hook 'ffap-ro-mode-hook)
     (add-hook 'rmail-mode-hook 'ffap-ro-mode-hook)
     ;; (setq dired-x-hands-off-my-keys t) ; the default

  "Evaluate the forms in variable `ffap-bindings'."
  (interactive)
  (eval (cons 'progn ffap-bindings)))



;;; arch-tag: 9dd3e88a-5dec-4607-bd57-60ae9ede8ebc
;;; ffap.el ends here