/[emacs]/emacs/lisp/ffap.el
ViewVC logotype

Diff of /emacs/lisp/ffap.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.31 by rost, Tue May 7 19:32:33 2002 UTC revision 1.31.2.1 by miles, Fri Apr 4 06:20:05 2003 UTC
# Line 1  Line 1 
1  ;;; ffap.el --- find file (or url) at point  ;; ffap.el --- find file (or url) at point
2  ;;  ;;
3  ;; Copyright (C) 1995, 96, 97, 2000  Free Software Foundation, Inc.  ;; Copyright (C) 1995, 96, 97, 2000  Free Software Foundation, Inc.
4  ;;  ;;
# Line 42  Line 42 
42  ;; ffap-bindings makes the following global key bindings:  ;; ffap-bindings makes the following global key bindings:
43  ;;  ;;
44  ;; C-x C-f       find-file-at-point (abbreviated as ffap)  ;; C-x C-f       find-file-at-point (abbreviated as ffap)
45    ;; C-x d         dired-at-point
46  ;; C-x 4 f       ffap-other-window  ;; C-x 4 f       ffap-other-window
47  ;; C-x 5 f       ffap-other-frame  ;; C-x 5 f       ffap-other-frame
48  ;; S-mouse-3     ffap-at-mouse  ;; S-mouse-3     ffap-at-mouse
# Line 68  Line 69 
69  ;; ffap uses `browse-url' (if found, else `w3-fetch') to fetch URL's.  ;; ffap uses `browse-url' (if found, else `w3-fetch') to fetch URL's.
70  ;; For a hairier `ffap-url-fetcher', try ffap-url.el (same ftp site).  ;; For a hairier `ffap-url-fetcher', try ffap-url.el (same ftp site).
71  ;; Also, you can add `ffap-menu-rescan' to various hooks to fontify  ;; Also, you can add `ffap-menu-rescan' to various hooks to fontify
72  ;; the file and URL references within a buffer.    ;; the file and URL references within a buffer.
73    
74    
75  ;;; Change Log:  ;;; Change Log:
# Line 79  Line 80 
80    
81  ;;; Todo list:  ;;; Todo list:
82  ;; * use kpsewhich  ;; * use kpsewhich
83  ;; * let "/path/file#key" jump to key (tag or regexp) in /path/file  ;; * let "/dir/file#key" jump to key (tag or regexp) in /dir/file
84  ;; * find file of symbol if TAGS is loaded (like above)  ;; * find file of symbol if TAGS is loaded (like above)
85  ;; * break long menus into multiple panes (like imenu?)  ;; * break long menus into multiple panes (like imenu?)
86  ;; * notice node in "(dired)Virtual Dired" (quotes, parentheses, whitespace)  ;; * notice node in "(dired)Virtual Dired" (quotes, parentheses, whitespace)
87  ;; * notice "machine.dom blah blah blah path/file" (how?)  ;; * notice "machine.dom blah blah blah dir/file" (how?)
88  ;; * as w3 becomes standard, rewrite to rely more on its functions  ;; * as w3 becomes standard, rewrite to rely more on its functions
89  ;; * regexp options for ffap-string-at-point, like font-lock (MCOOK)  ;; * regexp options for ffap-string-at-point, like font-lock (MCOOK)
90  ;; * v19: could replace `ffap-locate-file' with a quieter `locate-library'  ;; * v19: could replace `ffap-locate-file' with a quieter `locate-library'
# Line 123  Otherwise return nil (or the optional DE Line 124  Otherwise return nil (or the optional DE
124    ;; This used to test for ange-ftp or efs being present, but it should be    ;; This used to test for ange-ftp or efs being present, but it should be
125    ;; harmless (and simpler) to give it this value unconditionally.    ;; harmless (and simpler) to give it this value unconditionally.
126    "\\`/[^/:]+:"    "\\`/[^/:]+:"
127    "*Paths matching this regexp are treated as remote ftp paths by ffap.    "*File names matching this regexp are treated as remote ffap.
128  If nil, ffap neither recognizes nor generates such paths."  If nil, ffap neither recognizes nor generates such names."
129    :type '(choice (const :tag "Disable" nil)    :type '(choice (const :tag "Disable" nil)
130                   (const :tag "Standard" "\\`/[^/:]+:")                   (const :tag "Standard" "\\`/[^/:]+:")
131                   regexp)                   regexp)
132    :group 'ffap)    :group 'ffap)
133    
134  (defcustom ffap-url-unwrap-local t  (defcustom ffap-url-unwrap-local t
135    "*If non-nil, convert `file:' url to local path before prompting."    "*If non-nil, convert `file:' URL to local file name before prompting."
136    :type 'boolean    :type 'boolean
137    :group 'ffap)    :group 'ffap)
138    
139  (defcustom ffap-url-unwrap-remote t  (defcustom ffap-url-unwrap-remote t
140    "*If non-nil, convert `ftp:' url to remote path before prompting.    "*If non-nil, convert `ftp:' URL to remote file name before prompting.
141  This is ignored if `ffap-ftp-regexp' is nil."  This is ignored if `ffap-ftp-regexp' is nil."
142    :type 'boolean    :type 'boolean
143    :group 'ffap)    :group 'ffap)
144    
145  (defcustom ffap-ftp-default-user "anonymous"  (defcustom ffap-ftp-default-user "anonymous"
146    "*User name in ftp paths generated by `ffap-host-to-path'.    "*User name in ftp file names generated by `ffap-host-to-path'.
147  Note this name may be omitted if it equals the default  Note this name may be omitted if it equals the default
148  \(either `efs-default-user' or `ange-ftp-default-user'\)."  \(either `efs-default-user' or `ange-ftp-default-user'\)."
149    :type 'string    :type 'string
# Line 152  Note this name may be omitted if it equa Line 153  Note this name may be omitted if it equa
153    ;; Remote file access built into file system?  HP rfa or Andrew afs:    ;; Remote file access built into file system?  HP rfa or Andrew afs:
154    "\\`/\\(afs\\|net\\)/."    "\\`/\\(afs\\|net\\)/."
155    ;; afs only: (and (file-exists-p "/afs") "\\`/afs/.")    ;; afs only: (and (file-exists-p "/afs") "\\`/afs/.")
156    "*Matching paths are treated as remote.  nil to disable."    "*Matching file names are treated as remote.  Use nil to disable."
157    :type 'regexp    :type 'regexp
158    :group 'ffap)    :group 'ffap)
159    
# Line 433  Returned values: Line 434  Returned values:
434    
435  ;;; Possibly Remote Resources:  ;;; Possibly Remote Resources:
436    
437  (defun ffap-replace-path-component (fullname name)  (defun ffap-replace-file-component (fullname name)
438    "In remote FULLNAME, replace path with NAME.  May return nil."    "In remote FULLNAME, replace path with NAME.  May return nil."
439    ;; Use ange-ftp or efs if loaded, but do not load them otherwise.    ;; Use ange-ftp or efs if loaded, but do not load them otherwise.
440    (let (found)    (let (found)
# Line 445  Returned values: Line 446  Returned values:
446         ange-ftp-replace-name-component         ange-ftp-replace-name-component
447         ))         ))
448      (and found      (and found
449           (fset 'ffap-replace-path-component found)           (fset 'ffap-replace-file-component found)
450           (funcall found fullname name))))           (funcall found fullname name))))
451  ;; (ffap-replace-path-component "/who@foo.com:/whatever" "/new")  ;; (ffap-replace-file-component "/who@foo.com:/whatever" "/new")
452    
453  (defun ffap-file-suffix (file)  (defun ffap-file-suffix (file)
454    "Return trailing `.foo' suffix of FILE, or nil if none."    "Return trailing `.foo' suffix of FILE, or nil if none."
# Line 484  The optional NOMODIFY argument suppresse Line 485  The optional NOMODIFY argument suppresse
485  (defun ffap-file-remote-p (filename)  (defun ffap-file-remote-p (filename)
486    "If FILENAME looks remote, return it (maybe slightly improved)."    "If FILENAME looks remote, return it (maybe slightly improved)."
487    ;; (ffap-file-remote-p "/user@foo.bar.com:/pub")    ;; (ffap-file-remote-p "/user@foo.bar.com:/pub")
488    ;; (ffap-file-remote-p "/cssun.mathcs.emory.edu://path")    ;; (ffap-file-remote-p "/cssun.mathcs.emory.edu://dir")
489    ;; (ffap-file-remote-p "/ffap.el:80")    ;; (ffap-file-remote-p "/ffap.el:80")
490    (or (and ffap-ftp-regexp    (or (and ffap-ftp-regexp
491             (string-match ffap-ftp-regexp filename)             (string-match ffap-ftp-regexp filename)
492             ;; Convert "/host.com://path" to "/host:/path", to handle a dieing             ;; Convert "/host.com://dir" to "/host:/dir", to handle a dieing
493             ;; practice of advertising ftp paths as "host.dom://path".             ;; practice of advertising ftp files as "host.dom://filename".
494             (if (string-match "//" filename)             (if (string-match "//" filename)
495                 ;; (replace-match "/" nil nil filename)                 ;; (replace-match "/" nil nil filename)
496                 (concat (substring filename 0 (1+ (match-beginning 0)))                 (concat (substring filename 0 (1+ (match-beginning 0)))
# Line 504  The optional NOMODIFY argument suppresse Line 505  The optional NOMODIFY argument suppresse
505    (let ((mach (ffap-string-at-point 'machine)))    (let ((mach (ffap-string-at-point 'machine)))
506      (and (ffap-machine-p mach) mach)))      (and (ffap-machine-p mach) mach)))
507    
508  (defsubst ffap-host-to-path (host)  (defsubst ffap-host-to-filename (host)
509    "Convert HOST to something like \"/USER@HOST:\" or \"/HOST:\".    "Convert HOST to something like \"/USER@HOST:\" or \"/HOST:\".
510  Looks at `ffap-ftp-default-user', returns \"\" for \"localhost\"."  Looks at `ffap-ftp-default-user', returns \"\" for \"localhost\"."
511    (if (equal host "localhost")    (if (equal host "localhost")
# Line 517  Looks at `ffap-ftp-default-user', return Line 518  Looks at `ffap-ftp-default-user', return
518        (concat "/" user (and user "@") host ":"))))        (concat "/" user (and user "@") host ":"))))
519    
520  (defun ffap-fixup-machine (mach)  (defun ffap-fixup-machine (mach)
521    ;; Convert a hostname into an url, an ftp path, or nil.    ;; Convert a hostname into an url, an ftp file name, or nil.
522    (cond    (cond
523     ((not (and ffap-url-regexp (stringp mach))) nil)     ((not (and ffap-url-regexp (stringp mach))) nil)
524     ;; gopher.well.com     ;; gopher.well.com
# Line 527  Looks at `ffap-ftp-default-user', return Line 528  Looks at `ffap-ftp-default-user', return
528     ((and (string-match "\\`w\\(ww\\|eb\\)[-.]" mach))     ((and (string-match "\\`w\\(ww\\|eb\\)[-.]" mach))
529      (concat "http://" mach "/"))      (concat "http://" mach "/"))
530     ;; More cases?  Maybe "telnet:" for archie?     ;; More cases?  Maybe "telnet:" for archie?
531     (ffap-ftp-regexp (ffap-host-to-path mach))     (ffap-ftp-regexp (ffap-host-to-filename mach))
532     ))     ))
533    
534  (defvar ffap-newsgroup-regexp "^[a-z]+\\.[-+a-z_0-9.]+$"  (defvar ffap-newsgroup-regexp "^[a-z]+\\.[-+a-z_0-9.]+$"
# Line 579  Looks at `ffap-ftp-default-user', return Line 580  Looks at `ffap-ftp-default-user', return
580    "Return URL as a remote file, or nil.  Ignores `ffap-url-regexp'."    "Return URL as a remote file, or nil.  Ignores `ffap-url-regexp'."
581    (and (string-match "\\`\\(ftp\\|file\\)://\\([^:/]+\\):?\\(/.*\\)" url)    (and (string-match "\\`\\(ftp\\|file\\)://\\([^:/]+\\):?\\(/.*\\)" url)
582         (concat         (concat
583          (ffap-host-to-path (substring url (match-beginning 2) (match-end 2)))          (ffap-host-to-filename (substring url (match-beginning 2) (match-end 2)))
584          (substring url (match-beginning 3) (match-end 3)))))          (substring url (match-beginning 3) (match-end 3)))))
585  ;; Test: (ffap-url-unwrap-remote "ftp://foo.com/bar.boz")  ;; Test: (ffap-url-unwrap-remote "ftp://foo.com/bar.boz")
586    
# Line 595  Looks at `ffap-ftp-default-user', return Line 596  Looks at `ffap-ftp-default-user', return
596     (url)))     (url)))
597    
598    
599  ;;; Path Handling:  ;;; File Name Handling:
600  ;;  ;;
601  ;; The upcoming ffap-alist actions need various utilities to prepare  ;; The upcoming ffap-alist actions need various utilities to prepare
602  ;; and search paths of directories.  Too many features here.  ;; and search directories.  Too many features here.
603    
604  ;; (defun ffap-last (l) (while (cdr l) (setq l (cdr l))) l)  ;; (defun ffap-last (l) (while (cdr l) (setq l (cdr l))) l)
605  ;; (defun ffap-splice (func inlist)  ;; (defun ffap-splice (func inlist)
# Line 900  If t, `ffap-tex-init' will initialize th Line 901  If t, `ffap-tex-init' will initialize th
901      (member (ffap-string-around) '("||" "|\n")))      (member (ffap-string-around) '("||" "|\n")))
902     (concat     (concat
903      ;; lispdir.el may not be loaded yet:      ;; lispdir.el may not be loaded yet:
904      (ffap-host-to-path      (ffap-host-to-filename
905       (ffap-soft-value "elisp-archive-host"       (ffap-soft-value "elisp-archive-host"
906                        "archive.cis.ohio-state.edu"))                        "archive.cis.ohio-state.edu"))
907      (file-name-as-directory      (file-name-as-directory
# Line 909  If t, `ffap-tex-init' will initialize th Line 910  If t, `ffap-tex-init' will initialize th
910      (substring name 2))))      (substring name 2))))
911    
912  (defvar ffap-rfc-path  (defvar ffap-rfc-path
913    (concat (ffap-host-to-path "ds.internic.net") "/rfc/rfc%s.txt"))    (concat (ffap-host-to-filename "ds.internic.net") "/rfc/rfc%s.txt"))
914    
915  (defun ffap-rfc (name)  (defun ffap-rfc (name)
916    (format ffap-rfc-path    (format ffap-rfc-path
# Line 1076  The two subexpressions are the KEY and V Line 1077  The two subexpressions are the KEY and V
1077     ;; Icky regexp avoids: default: 123: foo::bar cs:pub     ;; Icky regexp avoids: default: 123: foo::bar cs:pub
1078     ;; It does match on: mic@cs: cs:/pub mathcs.emory.edu: (point at end)     ;; It does match on: mic@cs: cs:/pub mathcs.emory.edu: (point at end)
1079     "\\`\\([^:@]+@[^:@]+:\\|[^@.:]+\\.[^@:]+:\\|[^:]+:[~/]\\)\\([^:]\\|\\'\\)")     "\\`\\([^:@]+@[^:@]+:\\|[^@.:]+\\.[^@:]+:\\|[^:]+:[~/]\\)\\([^:]\\|\\'\\)")
1080    "Strings matching this are coerced to ftp paths by ffap.    "Strings matching this are coerced to ftp file names by ffap.
1081  That is, ffap just prepends \"/\".  Set to nil to disable.")  That is, ffap just prepends \"/\".  Set to nil to disable.")
1082    
1083  (defun ffap-file-at-point nil  (defun ffap-file-at-point nil
# Line 1086  If the filename is not obvious, it also Line 1087  If the filename is not obvious, it also
1087  which may actually result in an url rather than a filename."  which may actually result in an url rather than a filename."
1088    ;; Note: this function does not need to look for url's, just    ;; Note: this function does not need to look for url's, just
1089    ;; filenames.  On the other hand, it is responsible for converting    ;; filenames.  On the other hand, it is responsible for converting
1090    ;; a pseudo-url "site.com://path" to an ftp path    ;; a pseudo-url "site.com://dir" to an ftp file name
1091    (let* ((case-fold-search t)           ; url prefixes are case-insensitive    (let* ((case-fold-search t)           ; url prefixes are case-insensitive
1092           (data (match-data))           (data (match-data))
1093           (string (ffap-string-at-point)) ; uses mode alist           (string (ffap-string-at-point)) ; uses mode alist
# Line 1114  which may actually result in an url rath Line 1115  which may actually result in an url rath
1115           ;; Accept remote names without actual checking (too slow):           ;; Accept remote names without actual checking (too slow):
1116           ((if abs           ((if abs
1117                (ffap-file-remote-p name)                (ffap-file-remote-p name)
1118              ;; Try adding a leading "/" (common omission in ftp paths):              ;; Try adding a leading "/" (common omission in ftp file names):
1119              (and              (and
1120               ffap-ftp-sans-slash-regexp               ffap-ftp-sans-slash-regexp
1121               (string-match ffap-ftp-sans-slash-regexp name)               (string-match ffap-ftp-sans-slash-regexp name)
# Line 1143  which may actually result in an url rath Line 1144  which may actually result in an url rath
1144              try))              try))
1145           ;; Alist failed?  Try to guess an active remote connection           ;; Alist failed?  Try to guess an active remote connection
1146           ;; from buffer variables, and try once more, both as an           ;; from buffer variables, and try once more, both as an
1147           ;; absolute and relative path on that remote host.           ;; absolute and relative file name on that remote host.
1148           ((let* (ffap-rfs-regexp        ; suppress           ((let* (ffap-rfs-regexp        ; suppress
1149                   (remote-dir                   (remote-dir
1150                    (cond                    (cond
# Line 1161  which may actually result in an url rath Line 1162  which may actually result in an url rath
1162                   (or                   (or
1163                    (and (string-match "\\`\\(/?~?ftp\\)/" name)                    (and (string-match "\\`\\(/?~?ftp\\)/" name)
1164                         (ffap-file-exists-string                         (ffap-file-exists-string
1165                          (ffap-replace-path-component                          (ffap-replace-file-component
1166                           remote-dir (substring name (match-end 1)))))                           remote-dir (substring name (match-end 1)))))
1167                    (ffap-file-exists-string                    (ffap-file-exists-string
1168                     (ffap-replace-path-component remote-dir name))))))                     (ffap-replace-file-component remote-dir name))))))
1169           )           )
1170        (set-match-data data))))        (set-match-data data))))
1171    
# Line 1239  which may actually result in an url rath Line 1240  which may actually result in an url rath
1240    ;; Note: t and non-nil mean somewhat different reasons.    ;; Note: t and non-nil mean somewhat different reasons.
1241    (if (eq minibuffer-completion-table 'ffap-read-file-or-url-internal)    (if (eq minibuffer-completion-table 'ffap-read-file-or-url-internal)
1242        (not (ffap-url-p (buffer-string))) ; t        (not (ffap-url-p (buffer-string))) ; t
1243      (memq minibuffer-completion-table      (and minibuffer-completing-file-name '(t)))) ;list
           '(read-file-name-internal read-directory-name-internal)) ; list  
     ))  
1244    
1245  (and  (and
1246   (featurep 'complete)   (featurep 'complete)
# Line 1659  ffap most of the time." Line 1658  ffap most of the time."
1658        (if (file-directory-p filename)        (if (file-directory-p filename)
1659            (dired (expand-file-name filename))            (dired (expand-file-name filename))
1660          (dired (concat (expand-file-name filename) "*"))))          (dired (concat (expand-file-name filename) "*"))))
1661       ((y-or-n-p "Directory does not exist, create it? ")       ((and (file-writable-p (file-name-directory filename))
1662               (y-or-n-p "Directory does not exist, create it? "))
1663        (make-directory filename)        (make-directory filename)
1664        (dired filename))        (dired filename))
1665       ((error "No such file or directory `%s'" filename)))))       ((error "No such file or directory `%s'" filename)))))

Legend:
Removed from v.1.31  
changed lines
  Added in v.1.31.2.1

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26