]> code.delx.au - gnu-emacs/blobdiff - lisp/ffap.el
(ffap-replace-file-component): Use `mapc' rather than `mapcar'.
[gnu-emacs] / lisp / ffap.el
index ab9d223256f12def5efdd45d563dcde0d21f1656..8c338bd947ab755fbf79b9241112b9f674d20bd5 100644 (file)
@@ -1,9 +1,10 @@
 ;;; ffap.el --- find file (or url) at point
 
-;; Copyright (C) 1995, 96, 97, 2000, 2004  Free Software Foundation, Inc.
+;; Copyright (C) 1995, 1996, 1997, 2000, 2001, 2002, 2003, 2004,
+;;   2005, 2006, 2007 Free Software Foundation, Inc.
 
 ;; Author: Michelangelo Grigni <mic@mathcs.emory.edu>
-;; Maintainer: Rajesh Vaidheeswarran  <rv@gnu.org>
+;; Maintainer: FSF
 ;; Created: 29 Mar 1993
 ;; Keywords: files, hypermedia, matching, mouse, convenience
 ;; X-URL: ftp://ftp.mathcs.emory.edu/pub/mic/emacs/
@@ -12,7 +13,7 @@
 
 ;; 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)
+;; the Free Software Foundation; either version 3, or (at your option)
 ;; any later version.
 
 ;; GNU Emacs is distributed in the hope that it will be useful,
@@ -22,8 +23,8 @@
 
 ;; 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.
+;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+;; Boston, MA 02110-1301, USA.
 
 \f
 ;;; Commentary:
@@ -217,10 +218,13 @@ Sensible values are nil, \"news\", or \"mailto\"."
   "*A regexp matching filename wildcard characters, or nil.
 
 If `find-file-at-point' gets a filename matching this pattern,
-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'.
+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'."
@@ -230,6 +234,11 @@ it passes it on to `dired'."
                 )
   :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'.
@@ -278,9 +287,9 @@ For a fancy alternative, get `ffap-url.el'."
 \f
 ;;; Compatibility:
 ;;
-;; This version of ffap supports Emacs 20 only, see the ftp site
-;; for a more general version.  The following functions are necessary
-;; "leftovers" from the more general version.
+;; This version of ffap supports only the Emacs it is distributed in.
+;; See the ftp site for a more general version.  The following
+;; functions are necessary "leftovers" from the more general version.
 
 (defun ffap-mouse-event nil            ; current mouse event, or nil
   (and (listp last-nonmenu-event) last-nonmenu-event))
@@ -301,7 +310,7 @@ For a fancy alternative, get `ffap-url.el'."
   ;;
   ;; It pays to put a big fancy regexp here, since ffap-guesser is
   ;; much more time-consuming than regexp searching:
-  "[/:.~a-zA-Z]/\\|@[a-zA-Z][-a-zA-Z0-9]*\\."
+  "[/:.~[:alpha:]]/\\|@[[:alpha:]][-[:alnum:]]*\\."
   "*Regular expression governing movements of `ffap-next'."
   :type 'regexp
   :group 'ffap)
@@ -417,7 +426,7 @@ Returned values:
   ;; (ffap-machine-p "mathcs" 5678 nil 'ping)
   ;; (ffap-machine-p "foo.bonk" nil nil 'ping)
   ;; (ffap-machine-p "foo.bonk.com" nil nil 'ping)
-  (if (or (string-match "[^-a-zA-Z0-9.]" host) ; Illegal chars (?)
+  (if (or (string-match "[^-[:alnum:].]" host) ; Illegal chars (?)
          (not (string-match "[^0-9]" host))) ; 1: a number? 2: quick reject
       nil
     (let* ((domain
@@ -473,7 +482,7 @@ Returned values:
   "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
+    (mapc
      (function (lambda (sym) (and (fboundp sym) (setq found sym))))
      '(
        efs-replace-path-component
@@ -566,7 +575,7 @@ Looks at `ffap-ftp-default-user', returns \"\" for \"localhost\"."
    (ffap-ftp-regexp (ffap-host-to-filename mach))
    ))
 
-(defvar ffap-newsgroup-regexp "^[a-z]+\\.[-+a-z_0-9.]+$"
+(defvar ffap-newsgroup-regexp "^[[:lower:]]+\\.[-+[:lower:]_0-9.]+$"
   "Strings not matching this fail `ffap-newsgroup-p'.")
 (defvar ffap-newsgroup-heads           ; entirely inadequate
   '("alt" "comp" "gnu" "misc" "news" "sci" "soc" "talk")
@@ -592,7 +601,7 @@ Looks at `ffap-ftp-default-user', returns \"\" for \"localhost\"."
             (setq heads nil))
         (error nil)))
      (or ret (not heads)
-        (let ((head (string-match "\\`\\([a-z]+\\)\\." string)))
+        (let ((head (string-match "\\`\\([[:lower:]]+\\)\\." string)))
           (and head (setq head (substring string 0 (match-end 1)))
                (member head heads)
                (setq ret string))))
@@ -721,7 +730,7 @@ kpathsea, a library used by some versions of TeX."
          path)))
 
 (defun ffap-locate-file (file &optional nosuffix path dir-ok)
-  ;; The Emacs 20 version of locate-library could almost replace this,
+  ;; The current 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.
@@ -771,7 +780,7 @@ This uses ffap-file-exists-string, which may try adding suffixes from
     ("" . ffap-completable)            ; completion, slow on some systems
     ("\\.info\\'" . ffap-info)         ; gzip.info
     ("\\`info/" . ffap-info-2)         ; info/emacs
-    ("\\`[-a-z]+\\'" . ffap-info-3)    ; (emacs)Top [only in the parentheses]
+    ("\\`[-[:lower:]]+\\'" . ffap-info-3) ; (emacs)Top [only in the parentheses]
     ("\\.elc?\\'" . ffap-el)           ; simple.el, simple.elc
     (emacs-lisp-mode . ffap-el-mode)   ; rmail, gnus, simple, custom
     ;; (lisp-interaction-mode . ffap-el-mode) ; maybe
@@ -945,7 +954,7 @@ If t, `ffap-tex-init' will initialize this when needed.")
     (substring name 2))))
 
 (defvar ffap-rfc-path
-  (concat (ffap-host-to-filename "ds.internic.net") "/rfc/rfc%s.txt"))
+  (concat (ffap-host-to-filename "ftp.rfc-editor.org") "/in-notes/rfc%s.txt"))
 
 (defun ffap-rfc (name)
   (format ffap-rfc-path
@@ -960,15 +969,15 @@ If t, `ffap-tex-init' will initialize this when needed.")
     ;; Slightly controversial decisions:
     ;; * strip trailing "@" and ":"
     ;; * no commas (good for latex)
-    (file "--:$+<>@-Z_a-z~*?" "<@" "@>;.,!:")
+    (file "--:$+<>@-Z_[:lower:]~*?" "<@" "@>;.,!:")
     ;; An url, or maybe a email/news message-id:
-    (url "--:=&?$+@-Z_a-z~#,%;" "^A-Za-z0-9" ":;.,!?")
+    (url "--:=&?$+@-Z_[:lower:]~#,%;*" "^[:alnum:]" ":;.,!?")
     ;; Find a string that does *not* contain a colon:
-    (nocolon "--9$+<>@-Z_a-z~" "<@" "@>;.,!?")
+    (nocolon "--9$+<>@-Z_[:lower:]~" "<@" "@>;.,!?")
     ;; A machine:
-    (machine "-a-zA-Z0-9." "" ".")
+    (machine "-[:alnum:]." "" ".")
     ;; Mathematica paths: allow backquotes
-    (math-mode ",-:$+<>@-Z_a-z~`" "<" "@>;.,!?`:")
+    (math-mode ",-:$+<>@-Z_[:lower:]~`" "<" "@>;.,!?`:")
     )
   "Alist of \(MODE CHARS BEG END\), where MODE is a symbol,
 possibly a major-mode name, or one of the symbol
@@ -1053,7 +1062,7 @@ Assumes the buffer has not changed."
     (let ((name (ffap-string-at-point 'url)))
       (cond
        ((string-match "^url:" name) (setq name (substring name 4)))
-       ((and (string-match "\\`[^:</>@]+@[^:</>@]+[a-zA-Z0-9]\\'" name)
+       ((and (string-match "\\`[^:</>@]+@[^:</>@]+[[:alnum:]]\\'" name)
             ;; "foo@bar": could be "mailto" or "news" (a Message-ID).
             ;; Without "<>" it must be "mailto".  Otherwise could be
             ;; either, so consult `ffap-foo-at-bar-prefix'.
@@ -1065,7 +1074,7 @@ Assumes the buffer has not changed."
                             "mailto")))
               (and prefix (setq name (concat prefix ":" name))))))
        ((ffap-newsgroup-p name) (setq name (concat "news:" name)))
-       ((and (string-match "\\`[a-z0-9]+\\'" name) ; <mic> <root> <nobody>
+       ((and (string-match "\\`[[:alnum:]]+\\'" name) ; <mic> <root> <nobody>
             (equal (ffap-string-around) "<>")
             ;; (ffap-user-p name):
             (not (string-match "~" (expand-file-name (concat "~" name))))
@@ -1138,7 +1147,8 @@ which may actually result in an url rather than a filename."
                (error nil))
              string))
         (abs (file-name-absolute-p name))
-        (default-directory default-directory))
+        (default-directory default-directory)
+         (oname name))
     (unwind-protect
        (cond
         ;; Immediate rejects (/ and // and /* are too common in C/C++):
@@ -1155,13 +1165,7 @@ which may actually result in an url rather than a filename."
               (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)))))
+        ((and abs (ffap-file-remote-p name)))
         ;; Ok, not remote, try the existence test even if it is absolute:
         ((and abs (ffap-file-exists-string name)))
         ;; If it contains a colon, get rid of it (and return if exists)
@@ -1184,6 +1188,14 @@ which may actually result in an url rather than a filename."
                                  (ffap-file-remote-p try)
                                  (ffap-file-exists-string try))))))
            try))
+         ;; Try adding a leading "/" (common omission in ftp file names).
+         ;; Note that this uses oname, which still has any colon part.
+         ;; This should have a lower priority than the alist stuff,
+         ;; else it matches things like "ffap.el:1234:56:Warning".
+         ((and (not abs)
+               ffap-ftp-sans-slash-regexp
+               (string-match ffap-ftp-sans-slash-regexp oname)
+               (ffap-file-remote-p (concat "/" oname))))
         ;; 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.
@@ -1246,7 +1258,8 @@ which may actually result in an url rather than a filename."
                    (abbreviate-file-name (expand-file-name guess))
                    ))
          (setq dir (file-name-directory guess))))
-    (let ((minibuffer-completing-file-name t))
+    (let ((minibuffer-completing-file-name t)
+         (completion-ignore-case read-file-name-completion-ignore-case))
       (setq guess
            (completing-read
             prompt
@@ -1312,6 +1325,12 @@ which may actually result in an url rather than a filename."
 (defvar ffap-highlight t
   "If non-nil, ffap highlights the current buffer substring.")
 
+(defface ffap
+  '((t :inherit highlight))
+  "Face used to highlight the current buffer substring."
+  :group 'ffap
+  :version "22.1")
+
 (defvar ffap-highlight-overlay nil
   "Overlay used by `ffap-highlight'.")
 
@@ -1335,8 +1354,7 @@ Uses the face `ffap' if it is defined, or else `highlight'."
    (t
     (setq ffap-highlight-overlay
          (apply 'make-overlay ffap-string-at-point-region))
-    (overlay-put ffap-highlight-overlay 'face
-                     (if (facep 'ffap) 'ffap 'highlight)))))
+    (overlay-put ffap-highlight-overlay 'face 'ffap))))
 
 \f
 ;;; Main Entrance (`find-file-at-point' == `ffap'):
@@ -1371,9 +1389,7 @@ 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."
+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)
@@ -1386,6 +1402,10 @@ See <ftp://ftp.mathcs.emory.edu/pub/mic/emacs/> for latest version."
      ((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
@@ -1508,7 +1528,9 @@ Applies `ffap-menu-text-plist' text properties at all matches."
   (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
+       ;; 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)
@@ -1699,6 +1721,9 @@ Only intended for interactive use."
   (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
@@ -1768,7 +1793,11 @@ ffap most of the time."
   ;; Extra complication for the temporary highlighting.
   (unwind-protect
       (ffap-read-file-or-url
-       (if ffap-url-regexp "Dired file or URL: " "Dired file: ")
+       (cond
+       ((eq ffap-directory-finder 'list-directory)
+        "List directory (brief): ")
+       (ffap-url-regexp "Dired file or URL: ")
+       (t "Dired file: "))
        (prog1
           (setq guess (or guess
                            (let ((guess (ffap-guesser)))