1;;; ffap.el --- find file (or url) at point 2 3;; Copyright (C) 1995, 1996, 1997, 2000, 2001, 2002, 2003, 2004, 4;; 2005, 2006, 2007 Free Software Foundation, Inc. 5 6;; Author: Michelangelo Grigni <mic@mathcs.emory.edu> 7;; Maintainer: FSF 8;; Created: 29 Mar 1993 9;; Keywords: files, hypermedia, matching, mouse, convenience 10;; X-URL: ftp://ftp.mathcs.emory.edu/pub/mic/emacs/ 11 12;; This file is part of GNU Emacs. 13 14;; GNU Emacs is free software; you can redistribute it and/or modify 15;; it under the terms of the GNU General Public License as published by 16;; the Free Software Foundation; either version 2, or (at your option) 17;; any later version. 18 19;; GNU Emacs is distributed in the hope that it will be useful, 20;; but WITHOUT ANY WARRANTY; without even the implied warranty of 21;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the 22;; GNU General Public License for more details. 23 24;; You should have received a copy of the GNU General Public License 25;; along with GNU Emacs; see the file COPYING. If not, write to the 26;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, 27;; Boston, MA 02110-1301, USA. 28 29 30;;; Commentary: 31;; 32;; Command find-file-at-point replaces find-file. With a prefix, it 33;; behaves exactly like find-file. Without a prefix, it first tries 34;; to guess a default file or URL from the text around the point 35;; (`ffap-require-prefix' swaps these behaviors). This is useful for 36;; following references in situations such as mail or news buffers, 37;; README's, MANIFEST's, and so on. Submit bugs or suggestions with 38;; M-x ffap-bug. 39;; 40;; For the default installation, add this line to your .emacs file: 41;; 42;; (ffap-bindings) ; do default key bindings 43;; 44;; ffap-bindings makes the following global key bindings: 45;; 46;; C-x C-f find-file-at-point (abbreviated as ffap) 47;; C-x C-r ffap-read-only 48;; C-x C-v ffap-alternate-file 49;; 50;; C-x d dired-at-point 51;; C-x C-d ffap-list-directory 52;; 53;; C-x 4 f ffap-other-window 54;; C-x 4 r ffap-read-only-other-window 55;; C-x 4 d ffap-dired-other-window 56;; 57;; C-x 5 f ffap-other-frame 58;; C-x 5 r ffap-read-only-other-frame 59;; C-x 5 d ffap-dired-other-frame 60;; 61;; S-mouse-3 ffap-at-mouse 62;; C-S-mouse-3 ffap-menu 63;; 64;; ffap-bindings also adds hooks to make the following local bindings 65;; in vm, gnus, and rmail: 66;; 67;; M-l ffap-next, or ffap-gnus-next in gnus (l == "link") 68;; M-m ffap-menu, or ffap-gnus-menu in gnus (m == "menu") 69;; 70;; If you do not like these bindings, modify the variable 71;; `ffap-bindings', or write your own. 72;; 73;; If you use ange-ftp, browse-url, complete, efs, or w3, it is best 74;; to load or autoload them before ffap. If you use ff-paths, load it 75;; afterwards. Try apropos {C-h a ffap RET} to get a list of the many 76;; option variables. In particular, if ffap is slow, try these: 77;; 78;; (setq ffap-alist nil) ; faster, dumber prompting 79;; (setq ffap-machine-p-known 'accept) ; no pinging 80;; (setq ffap-url-regexp nil) ; disable URL features in ffap 81;; (setq ffap-shell-prompt-regexp nil) ; disable shell prompt stripping 82;; 83;; ffap uses `browse-url' (if found, else `w3-fetch') to fetch URL's. 84;; For a hairier `ffap-url-fetcher', try ffap-url.el (same ftp site). 85;; Also, you can add `ffap-menu-rescan' to various hooks to fontify 86;; the file and URL references within a buffer. 87 88 89;;; Change Log: 90;; 91;; The History and Contributors moved to ffap.LOG (same ftp site), 92;; which also has some old examples and commentary from ffap 1.5. 93 94 95;;; Todo list: 96;; * use kpsewhich 97;; * let "/dir/file#key" jump to key (tag or regexp) in /dir/file 98;; * find file of symbol if TAGS is loaded (like above) 99;; * break long menus into multiple panes (like imenu?) 100;; * notice node in "(dired)Virtual Dired" (quotes, parentheses, whitespace) 101;; * notice "machine.dom blah blah blah dir/file" (how?) 102;; * as w3 becomes standard, rewrite to rely more on its functions 103;; * regexp options for ffap-string-at-point, like font-lock (MCOOK) 104;; * v19: could replace `ffap-locate-file' with a quieter `locate-library' 105;; * handle "$(VAR)" in Makefiles 106;; * use the font-lock machinery 107 108 109;;; Code: 110 111(provide 'ffap) 112 113;; Please do not delete this variable, it is checked in bug reports. 114(defconst ffap-version "1.9-fsf <97/06/25 13:21:41 mic>" 115 "The version of ffap: \"Major.Minor-Build <Timestamp>\"") 116 117 118(defgroup ffap nil 119 "Find file or URL at point." 120 :link '(url-link :tag "URL" "ftp://ftp.mathcs.emory.edu/pub/mic/emacs/") 121 :group 'matching 122 :group 'convenience) 123 124;; The code is organized in pages, separated by formfeed characters. 125;; See the next two pages for standard customization ideas. 126 127 128;;; User Variables: 129 130(defun ffap-soft-value (name &optional default) 131 "Return value of symbol with NAME, if it is interned. 132Otherwise return nil (or the optional DEFAULT value)." 133 ;; Bug: (ffap-soft-value "nil" 5) --> 5 134 (let ((sym (intern-soft name))) 135 (if (and sym (boundp sym)) (symbol-value sym) default))) 136 137(defcustom ffap-shell-prompt-regexp 138 ;; This used to test for some shell prompts that don't have a space 139 ;; after them. The common root shell prompt (#) is not listed since it 140 ;; also doubles up as a valid URL character. 141 "[$%><]*" 142 "Paths matching this regexp are stripped off the shell prompt 143If nil, ffap doesn't do shell prompt stripping." 144 :type '(choice (const :tag "Disable" nil) 145 (const :tag "Standard" "[$%><]*") 146 regexp) 147 :group 'ffap) 148 149(defcustom ffap-ftp-regexp 150 ;; This used to test for ange-ftp or efs being present, but it should be 151 ;; harmless (and simpler) to give it this value unconditionally. 152 "\\`/[^/:]+:" 153 "*File names matching this regexp are treated as remote ffap. 154If nil, ffap neither recognizes nor generates such names." 155 :type '(choice (const :tag "Disable" nil) 156 (const :tag "Standard" "\\`/[^/:]+:") 157 regexp) 158 :group 'ffap) 159 160(defcustom ffap-url-unwrap-local t 161 "*If non-nil, convert `file:' URL to local file name before prompting." 162 :type 'boolean 163 :group 'ffap) 164 165(defcustom ffap-url-unwrap-remote t 166 "*If non-nil, convert `ftp:' URL to remote file name before prompting. 167This is ignored if `ffap-ftp-regexp' is nil." 168 :type 'boolean 169 :group 'ffap) 170 171(defcustom ffap-ftp-default-user "anonymous" 172 "*User name in ftp file names generated by `ffap-host-to-path'. 173Note this name may be omitted if it equals the default 174\(either `efs-default-user' or `ange-ftp-default-user'\)." 175 :type 'string 176 :group 'ffap) 177 178(defcustom ffap-rfs-regexp 179 ;; Remote file access built into file system? HP rfa or Andrew afs: 180 "\\`/\\(afs\\|net\\)/." 181 ;; afs only: (and (file-exists-p "/afs") "\\`/afs/.") 182 "*Matching file names are treated as remote. Use nil to disable." 183 :type 'regexp 184 :group 'ffap) 185 186(defvar ffap-url-regexp 187 ;; Could just use `url-nonrelative-link' of w3, if loaded. 188 ;; This regexp is not exhaustive, it just matches common cases. 189 (concat 190 "\\`\\(" 191 "news\\(post\\)?:\\|mailto:\\|file:" ; no host ok 192 "\\|" 193 "\\(ftp\\|https?\\|telnet\\|gopher\\|www\\|wais\\)://" ; needs host 194 "\\)." ; require one more character 195 ) 196 "Regexp matching URL's. nil to disable URL features in ffap.") 197 198(defcustom ffap-foo-at-bar-prefix "mailto" 199 "*Presumed URL prefix type of strings like \"<foo.9z@bar>\". 200Sensible values are nil, \"news\", or \"mailto\"." 201 :type '(choice (const "mailto") 202 (const "news") 203 (const :tag "Disable" nil) 204 ;; string -- possible, but not really useful 205 ) 206 :group 'ffap) 207 208 209;;; Peanut Gallery (More User Variables): 210;; 211;; Users of ffap occasionally suggest new features. If I consider 212;; those features interesting but not clear winners (a matter of 213;; personal taste) I try to leave options to enable them. Read 214;; through this section for features that you like, put an appropriate 215;; enabler in your .emacs file. 216 217(defcustom ffap-dired-wildcards "[*?][^/]*\\'" 218 "*A regexp matching filename wildcard characters, or nil. 219 220If `find-file-at-point' gets a filename matching this pattern, 221and `ffap-pass-wildcards-to-dired' is nil, it passes it on to 222`find-file' with non-nil WILDCARDS argument, which expands 223wildcards and visits multiple files. To visit a file whose name 224contains wildcard characters you can suppress wildcard expansion 225by setting `find-file-wildcards'. If `find-file-at-point' gets a 226filename matching this pattern and `ffap-pass-wildcards-to-dired' 227is non-nil, it passes it on to `dired'. 228 229If `dired-at-point' gets a filename matching this pattern, 230it passes it on to `dired'." 231 :type '(choice (const :tag "Disable" nil) 232 (const :tag "Enable" "[*?][^/]*\\'") 233 ;; regexp -- probably not useful 234 ) 235 :group 'ffap) 236 237(defcustom ffap-pass-wildcards-to-dired nil 238 "*If non-nil, pass filenames matching `ffap-dired-wildcards' to dired." 239 :type 'boolean 240 :group 'ffap) 241 242(defcustom ffap-newfile-prompt nil 243 ;; Suggestion from RHOGEE, 11 Jul 1994. Disabled, I think this is 244 ;; better handled by `find-file-not-found-hooks'. 245 "*Whether `find-file-at-point' prompts about a nonexistent file." 246 :type 'boolean 247 :group 'ffap) 248 249(defcustom ffap-require-prefix nil 250 ;; Suggestion from RHOGEE, 20 Oct 1994. 251 "*If set, reverses the prefix argument to `find-file-at-point'. 252This is nil so neophytes notice ffap. Experts may prefer to disable 253ffap most of the time." 254 :type 'boolean 255 :group 'ffap) 256 257(defcustom ffap-file-finder 'find-file 258 "*The command called by `find-file-at-point' to find a file." 259 :type 'function 260 :group 'ffap) 261(put 'ffap-file-finder 'risky-local-variable t) 262 263(defcustom ffap-directory-finder 'dired 264 "*The command called by `dired-at-point' to find a directory." 265 :type 'function 266 :group 'ffap) 267(put 'ffap-directory-finder 'risky-local-variable t) 268 269(defcustom ffap-url-fetcher 270 (if (fboundp 'browse-url) 271 'browse-url ; rely on browse-url-browser-function 272 'w3-fetch) 273 ;; Remote control references: 274 ;; http://www.ncsa.uiuc.edu/SDG/Software/XMosaic/remote-control.html 275 ;; http://home.netscape.com/newsref/std/x-remote.html 276 "*A function of one argument, called by ffap to fetch an URL. 277Reasonable choices are `w3-fetch' or a `browse-url-*' function. 278For a fancy alternative, get `ffap-url.el'." 279 :type '(choice (const w3-fetch) 280 (const browse-url) ; in recent versions of browse-url 281 (const browse-url-netscape) 282 (const browse-url-mosaic) 283 function) 284 :group 'ffap) 285(put 'ffap-url-fetcher 'risky-local-variable t) 286 287 288;;; Compatibility: 289;; 290;; This version of ffap supports only the Emacs it is distributed in. 291;; See the ftp site for a more general version. The following 292;; functions are necessary "leftovers" from the more general version. 293 294(defun ffap-mouse-event nil ; current mouse event, or nil 295 (and (listp last-nonmenu-event) last-nonmenu-event)) 296(defun ffap-event-buffer (event) 297 (window-buffer (car (event-start event)))) 298 299 300;;; Find Next Thing in buffer (`ffap-next'): 301;; 302;; Original ffap-next-url (URL's only) from RPECK 30 Mar 1995. Since 303;; then, broke it up into ffap-next-guess (noninteractive) and 304;; ffap-next (a command). It now work on files as well as url's. 305 306(defcustom ffap-next-regexp 307 ;; If you want ffap-next to find URL's only, try this: 308 ;; (and ffap-url-regexp (string-match "\\\\`" ffap-url-regexp) 309 ;; (concat "\\<" (substring ffap-url-regexp 2)))) 310 ;; 311 ;; It pays to put a big fancy regexp here, since ffap-guesser is 312 ;; much more time-consuming than regexp searching: 313 "[/:.~[:alpha:]]/\\|@[[:alpha:]][-[:alnum:]]*\\." 314 "*Regular expression governing movements of `ffap-next'." 315 :type 'regexp 316 :group 'ffap) 317 318(defvar ffap-next-guess nil 319 "Last value returned by `ffap-next-guess'.") 320 321(defvar ffap-string-at-point-region '(1 1) 322 "List (BEG END), last region returned by `ffap-string-at-point'.") 323 324(defun ffap-next-guess (&optional back lim) 325 "Move point to next file or URL, and return it as a string. 326If nothing is found, leave point at limit and return nil. 327Optional BACK argument makes search backwards. 328Optional LIM argument limits the search. 329Only considers strings that match `ffap-next-regexp'." 330 (or lim (setq lim (if back (point-min) (point-max)))) 331 (let (guess) 332 (while (not (or guess (eq (point) lim))) 333 (funcall (if back 're-search-backward 're-search-forward) 334 ffap-next-regexp lim 'move) 335 (setq guess (ffap-guesser))) 336 ;; Go to end, so we do not get same guess twice: 337 (goto-char (nth (if back 0 1) ffap-string-at-point-region)) 338 (setq ffap-next-guess guess))) 339 340;;;###autoload 341(defun ffap-next (&optional back wrap) 342 "Search buffer for next file or URL, and run ffap. 343Optional argument BACK says to search backwards. 344Optional argument WRAP says to try wrapping around if necessary. 345Interactively: use a single prefix to search backwards, 346double prefix to wrap forward, triple to wrap backwards. 347Actual search is done by `ffap-next-guess'." 348 (interactive 349 (cdr (assq (prefix-numeric-value current-prefix-arg) 350 '((1) (4 t) (16 nil t) (64 t t))))) 351 (let ((pt (point)) 352 (guess (ffap-next-guess back))) 353 ;; Try wraparound if necessary: 354 (and (not guess) wrap 355 (goto-char (if back (point-max) (point-min))) 356 (setq guess (ffap-next-guess back pt))) 357 (if guess 358 (progn 359 (sit-for 0) ; display point movement 360 (find-file-at-point (ffap-prompter guess))) 361 (goto-char pt) ; restore point 362 (message "No %sfiles or URL's found" 363 (if wrap "" "more "))))) 364 365(defun ffap-next-url (&optional back wrap) 366 "Like `ffap-next', but search with `ffap-url-regexp'." 367 (interactive) 368 (let ((ffap-next-regexp ffap-url-regexp)) 369 (if (interactive-p) 370 (call-interactively 'ffap-next) 371 (ffap-next back wrap)))) 372 373 374;;; Machines (`ffap-machine-p'): 375 376;; I cannot decide a "best" strategy here, so these are variables. In 377;; particular, if `Pinging...' is broken or takes too long on your 378;; machine, try setting these all to accept or reject. 379(defcustom ffap-machine-p-local 'reject ; this happens often 380 "*What `ffap-machine-p' does with hostnames that have no domain. 381Value should be a symbol, one of `ping', `accept', and `reject'." 382 :type '(choice (const ping) 383 (const accept) 384 (const reject)) 385 :group 'ffap) 386(defcustom ffap-machine-p-known 'ping ; `accept' for higher speed 387 "*What `ffap-machine-p' does with hostnames that have a known domain. 388Value should be a symbol, one of `ping', `accept', and `reject'. 389See `mail-extr.el' for the known domains." 390 :type '(choice (const ping) 391 (const accept) 392 (const reject)) 393 :group 'ffap) 394(defcustom ffap-machine-p-unknown 'reject 395 "*What `ffap-machine-p' does with hostnames that have an unknown domain. 396Value should be a symbol, one of `ping', `accept', and `reject'. 397See `mail-extr.el' for the known domains." 398 :type '(choice (const ping) 399 (const accept) 400 (const reject)) 401 :group 'ffap) 402 403(defun ffap-what-domain (domain) 404 ;; Like what-domain in mail-extr.el, returns string or nil. 405 (require 'mail-extr) 406 (let ((ob (or (ffap-soft-value "mail-extr-all-top-level-domains") 407 (ffap-soft-value "all-top-level-domains")))) ; XEmacs 408 (and ob (get (intern-soft (downcase domain) ob) 'domain-name)))) 409 410(defun ffap-machine-p (host &optional service quiet strategy) 411 "Decide whether HOST is the name of a real, reachable machine. 412Depending on the domain (none, known, or unknown), follow the strategy 413named by the variable `ffap-machine-p-local', `ffap-machine-p-known', 414or `ffap-machine-p-unknown'. Pinging uses `open-network-stream'. 415Optional SERVICE specifies the port used \(default \"discard\"\). 416Optional QUIET flag suppresses the \"Pinging...\" message. 417Optional STRATEGY overrides the three variables above. 418Returned values: 419 t means that HOST answered. 420'accept means the relevant variable told us to accept. 421\"mesg\" means HOST exists, but does not respond for some reason." 422 ;; Try some (Emory local): 423 ;; (ffap-machine-p "ftp" nil nil 'ping) 424 ;; (ffap-machine-p "nonesuch" nil nil 'ping) 425 ;; (ffap-machine-p "ftp.mathcs.emory.edu" nil nil 'ping) 426 ;; (ffap-machine-p "mathcs" 5678 nil 'ping) 427 ;; (ffap-machine-p "foo.bonk" nil nil 'ping) 428 ;; (ffap-machine-p "foo.bonk.com" nil nil 'ping) 429 (if (or (string-match "[^-[:alnum:].]" host) ; Illegal chars (?) 430 (not (string-match "[^0-9]" host))) ; 1: a number? 2: quick reject 431 nil 432 (let* ((domain 433 (and (string-match "\\.[^.]*$" host) 434 (downcase (substring host (1+ (match-beginning 0)))))) 435 (what-domain (if domain (ffap-what-domain domain) "Local"))) 436 (or strategy 437 (setq strategy 438 (cond ((not domain) ffap-machine-p-local) 439 ((not what-domain) ffap-machine-p-unknown) 440 (t ffap-machine-p-known)))) 441 (cond 442 ((eq strategy 'accept) 'accept) 443 ((eq strategy 'reject) nil) 444 ((not (fboundp 'open-network-stream)) nil) 445 ;; assume (eq strategy 'ping) 446 (t 447 (or quiet 448 (if (stringp what-domain) 449 (message "Pinging %s (%s)..." host what-domain) 450 (message "Pinging %s ..." host))) 451 (condition-case error 452 (progn 453 (delete-process 454 (open-network-stream 455 "ffap-machine-p" nil host (or service "discard"))) 456 t) 457 (error 458 (let ((mesg (car (cdr error)))) 459 (cond 460 ;; v18: 461 ((string-match "^Unknown host" mesg) nil) 462 ((string-match "not responding$" mesg) mesg) 463 ;; v19: 464 ;; (file-error "connection failed" "permission denied" 465 ;; "nonesuch" "ffap-machine-p") 466 ;; (file-error "connection failed" "host is unreachable" 467 ;; "gopher.house.gov" "ffap-machine-p") 468 ;; (file-error "connection failed" "address already in use" 469 ;; "ftp.uu.net" "ffap-machine-p") 470 ((equal mesg "connection failed") 471 (if (equal (nth 2 error) "permission denied") 472 nil ; host does not exist 473 ;; Other errors mean the host exists: 474 (nth 2 error))) 475 ;; Could be "Unknown service": 476 (t (signal (car error) (cdr error)))))))))))) 477 478 479;;; Possibly Remote Resources: 480 481(defun ffap-replace-file-component (fullname name) 482 "In remote FULLNAME, replace path with NAME. May return nil." 483 ;; Use ange-ftp or efs if loaded, but do not load them otherwise. 484 (let (found) 485 (mapcar 486 (function (lambda (sym) (and (fboundp sym) (setq found sym)))) 487 '( 488 efs-replace-path-component 489 ange-ftp-replace-path-component 490 ange-ftp-replace-name-component 491 )) 492 (and found 493 (fset 'ffap-replace-file-component found) 494 (funcall found fullname name)))) 495;; (ffap-replace-file-component "/who@foo.com:/whatever" "/new") 496 497(defun ffap-file-suffix (file) 498 "Return trailing `.foo' suffix of FILE, or nil if none." 499 (let ((pos (string-match "\\.[^./]*\\'" file))) 500 (and pos (substring file pos nil)))) 501 502(defvar ffap-compression-suffixes '(".gz" ".Z") ; .z is mostly dead 503 "List of suffixes tried by `ffap-file-exists-string'.") 504 505(defun ffap-file-exists-string (file &optional nomodify) 506 ;; Early jka-compr versions modified file-exists-p to return the 507 ;; filename, maybe modified by adding a suffix like ".gz". That 508 ;; broke the interface of file-exists-p, so it was later dropped. 509 ;; Here we document and simulate the old behavior. 510 "Return FILE (maybe modified) if the file exists, else nil. 511When using jka-compr (a.k.a. `auto-compression-mode'), the returned 512name may have a suffix added from `ffap-compression-suffixes'. 513The optional NOMODIFY argument suppresses the extra search." 514 (cond 515 ((not file) nil) ; quietly reject nil 516 ((file-exists-p file) file) ; try unmodified first 517 ;; three reasons to suppress search: 518 (nomodify nil) 519 ((not (rassq 'jka-compr-handler file-name-handler-alist)) nil) 520 ((member (ffap-file-suffix file) ffap-compression-suffixes) nil) 521 (t ; ok, do the search 522 (let ((list ffap-compression-suffixes) try ret) 523 (while list 524 (if (file-exists-p (setq try (concat file (car list)))) 525 (setq ret try list nil) 526 (setq list (cdr list)))) 527 ret)))) 528 529(defun ffap-file-remote-p (filename) 530 "If FILENAME looks remote, return it (maybe slightly improved)." 531 ;; (ffap-file-remote-p "/user@foo.bar.com:/pub") 532 ;; (ffap-file-remote-p "/cssun.mathcs.emory.edu://dir") 533 ;; (ffap-file-remote-p "/ffap.el:80") 534 (or (and ffap-ftp-regexp 535 (string-match ffap-ftp-regexp filename) 536 ;; Convert "/host.com://dir" to "/host:/dir", to handle a dieing 537 ;; practice of advertising ftp files as "host.dom://filename". 538 (if (string-match "//" filename) 539 ;; (replace-match "/" nil nil filename) 540 (concat (substring filename 0 (1+ (match-beginning 0))) 541 (substring filename (match-end 0))) 542 filename)) 543 (and ffap-rfs-regexp 544 (string-match ffap-rfs-regexp filename) 545 filename))) 546 547(defun ffap-machine-at-point nil 548 "Return machine name at point if it exists, or nil." 549 (let ((mach (ffap-string-at-point 'machine))) 550 (and (ffap-machine-p mach) mach))) 551 552(defsubst ffap-host-to-filename (host) 553 "Convert HOST to something like \"/USER@HOST:\" or \"/HOST:\". 554Looks at `ffap-ftp-default-user', returns \"\" for \"localhost\"." 555 (if (equal host "localhost") 556 "" 557 (let ((user ffap-ftp-default-user)) 558 ;; Avoid including the user if it is same as default: 559 (if (or (equal user (ffap-soft-value "ange-ftp-default-user")) 560 (equal user (ffap-soft-value "efs-default-user"))) 561 (setq user nil)) 562 (concat "/" user (and user "@") host ":")))) 563 564(defun ffap-fixup-machine (mach) 565 ;; Convert a hostname into an url, an ftp file name, or nil. 566 (cond 567 ((not (and ffap-url-regexp (stringp mach))) nil) 568 ;; gopher.well.com 569 ((string-match "\\`gopher[-.]" mach) ; or "info"? 570 (concat "gopher://" mach "/")) 571 ;; www.ncsa.uiuc.edu 572 ((and (string-match "\\`w\\(ww\\|eb\\)[-.]" mach)) 573 (concat "http://" mach "/")) 574 ;; More cases? Maybe "telnet:" for archie? 575 (ffap-ftp-regexp (ffap-host-to-filename mach)) 576 )) 577 578(defvar ffap-newsgroup-regexp "^[[:lower:]]+\\.[-+[:lower:]_0-9.]+$" 579 "Strings not matching this fail `ffap-newsgroup-p'.") 580(defvar ffap-newsgroup-heads ; entirely inadequate 581 '("alt" "comp" "gnu" "misc" "news" "sci" "soc" "talk") 582 "Used by `ffap-newsgroup-p' if gnus is not running.") 583 584(defun ffap-newsgroup-p (string) 585 "Return STRING if it looks like a newsgroup name, else nil." 586 (and 587 (string-match ffap-newsgroup-regexp string) 588 (let ((htbs '(gnus-active-hashtb gnus-newsrc-hashtb gnus-killed-hashtb)) 589 (heads ffap-newsgroup-heads) 590 htb ret) 591 (while htbs 592 (setq htb (car htbs) htbs (cdr htbs)) 593 (condition-case nil 594 (progn 595 ;; errs: htb symbol may be unbound, or not a hash-table. 596 ;; gnus-gethash is just a macro for intern-soft. 597 (and (symbol-value htb) 598 (intern-soft string (symbol-value htb)) 599 (setq ret string htbs nil)) 600 ;; If we made it this far, gnus is running, so ignore "heads": 601 (setq heads nil)) 602 (error nil))) 603 (or ret (not heads) 604 (let ((head (string-match "\\`\\([[:lower:]]+\\)\\." string))) 605 (and head (setq head (substring string 0 (match-end 1))) 606 (member head heads) 607 (setq ret string)))) 608 ;; Is there ever a need to modify string as a newsgroup name? 609 ret))) 610 611(defsubst ffap-url-p (string) 612 "If STRING looks like an url, return it (maybe improved), else nil." 613 (let ((case-fold-search t)) 614 (and ffap-url-regexp (string-match ffap-url-regexp string) 615 ;; I lied, no improvement: 616 string))) 617 618;; Broke these out of ffap-fixup-url, for use of ffap-url package. 619(defsubst ffap-url-unwrap-local (url) 620 "Return URL as a local file, or nil. Ignores `ffap-url-regexp'." 621 (and (string-match "\\`\\(file\\|ftp\\):/?\\([^/]\\|\\'\\)" url) 622 (substring url (1+ (match-end 1))))) 623(defsubst ffap-url-unwrap-remote (url) 624 "Return URL as a remote file, or nil. Ignores `ffap-url-regexp'." 625 (and (string-match "\\`\\(ftp\\|file\\)://\\([^:/]+\\):?\\(/.*\\)" url) 626 (concat 627 (ffap-host-to-filename (substring url (match-beginning 2) (match-end 2))) 628 (substring url (match-beginning 3) (match-end 3))))) 629;; Test: (ffap-url-unwrap-remote "ftp://foo.com/bar.boz") 630 631(defun ffap-fixup-url (url) 632 "Clean up URL and return it, maybe as a file name." 633 (cond 634 ((not (stringp url)) nil) 635 ((and ffap-url-unwrap-local (ffap-url-unwrap-local url))) 636 ((and ffap-url-unwrap-remote ffap-ftp-regexp 637 (ffap-url-unwrap-remote url))) 638 ((fboundp 'url-normalize-url) ; may autoload url (part of w3) 639 (url-normalize-url url)) 640 (url))) 641 642 643;;; File Name Handling: 644;; 645;; The upcoming ffap-alist actions need various utilities to prepare 646;; and search directories. Too many features here. 647 648;; (defun ffap-last (l) (while (cdr l) (setq l (cdr l))) l) 649;; (defun ffap-splice (func inlist) 650;; "Equivalent to (apply 'nconc (mapcar FUNC INLIST)), but less consing." 651;; (let* ((head (cons 17 nil)) (last head)) 652;; (while inlist 653;; (setcdr last (funcall func (car inlist))) 654;; (setq last (ffap-last last) inlist (cdr inlist))) 655;; (cdr head))) 656 657(defun ffap-list-env (env &optional empty) 658 "Return a list of strings parsed from environment variable ENV. 659Optional EMPTY is the default list if \(getenv ENV\) is undefined, and 660also is substituted for the first empty-string component, if there is one. 661Uses `path-separator' to separate the path into substrings." 662 ;; We cannot use parse-colon-path (files.el), since it kills 663 ;; "//" entries using file-name-as-directory. 664 ;; Similar: dired-split, TeX-split-string, and RHOGEE's psg-list-env 665 ;; in ff-paths and bib-cite. The EMPTY arg may help mimic kpathsea. 666 (if (or empty (getenv env)) ; should return something 667 (let ((start 0) match dir ret) 668 (setq env (concat (getenv env) path-separator)) 669 (while (setq match (string-match path-separator env start)) 670 (setq dir (substring env start match) start (1+ match)) 671 ;;(and (file-directory-p dir) (not (member dir ret)) ...) 672 (setq ret (cons dir ret))) 673 (setq ret (nreverse ret)) 674 (and empty (setq match (member "" ret)) 675 (progn ; allow string or list here 676 (setcdr match (append (cdr-safe empty) (cdr match))) 677 (setcar match (or (car-safe empty) empty)))) 678 ret))) 679 680(defun ffap-reduce-path (path) 681 "Remove duplicates and non-directories from PATH list." 682 (let (ret tem) 683 (while path 684 (setq tem path path (cdr path)) 685 (if (equal (car tem) ".") (setcar tem "")) 686 (or (member (car tem) ret) 687 (not (file-directory-p (car tem))) 688 (progn (setcdr tem ret) (setq ret tem)))) 689 (nreverse ret))) 690 691(defun ffap-all-subdirs (dir &optional depth) 692 "Return list all subdirectories under DIR, starting with itself. 693Directories beginning with \".\" are ignored, and directory symlinks 694are listed but never searched (to avoid loops). 695Optional DEPTH limits search depth." 696 (and (file-exists-p dir) 697 (ffap-all-subdirs-loop (expand-file-name dir) (or depth -1)))) 698 699(defun ffap-all-subdirs-loop (dir depth) ; internal 700 (setq depth (1- depth)) 701 (cons dir 702 (and (not (eq depth -1)) 703 (apply 'nconc 704 (mapcar 705 (function 706 (lambda (d) 707 (cond 708 ((not (file-directory-p d)) nil) 709 ((file-symlink-p d) (list d)) 710 (t (ffap-all-subdirs-loop d depth))))) 711 (directory-files dir t "\\`[^.]") 712 ))))) 713 714(defvar ffap-kpathsea-depth 1 715 "Bound on depth of subdirectory search in `ffap-kpathsea-expand-path'. 716Set to 0 to avoid all searching, or nil for no limit.") 717 718(defun ffap-kpathsea-expand-path (path) 719 "Replace each \"//\"-suffixed dir in PATH by a list of its subdirs. 720The subdirs begin with the original directory, and the depth of the 721search is bounded by `ffap-kpathsea-depth'. This is intended to mimic 722kpathsea, a library used by some versions of TeX." 723 (apply 'nconc 724 (mapcar 725 (function 726 (lambda (dir) 727 (if (string-match "[^/]//\\'" dir) 728 (ffap-all-subdirs (substring dir 0 -2) ffap-kpathsea-depth) 729 (list dir)))) 730 path))) 731 732(defun ffap-locate-file (file &optional nosuffix path dir-ok) 733 ;; The current version of locate-library could almost replace this, 734 ;; except it does not let us override the suffix list. The 735 ;; compression-suffixes search moved to ffap-file-exists-string. 736 "A generic path-searching function, mimics `load' by default. 737Returns path to file that \(load FILE\) would load, or nil. 738Optional NOSUFFIX, if nil or t, is like the fourth argument 739for load: whether to try the suffixes (\".elc\" \".el\" \"\"). 740If a nonempty list, it is a list of suffixes to try instead. 741Optional PATH is a list of directories instead of `load-path'. 742Optional DIR-OK means that returning a directory is allowed, 743DIR-OK is already implicit if FILE looks like a directory. 744 745This uses ffap-file-exists-string, which may try adding suffixes from 746`ffap-compression-suffixes'." 747 (or path (setq path load-path)) 748 (or dir-ok (setq dir-ok (equal "" (file-name-nondirectory file)))) 749 (if (file-name-absolute-p file) 750 (setq path (list (file-name-directory file)) 751 file (file-name-nondirectory file))) 752 (let ((suffixes-to-try 753 (cond 754 ((consp nosuffix) nosuffix) 755 (nosuffix '("")) 756 (t '(".elc" ".el" "")))) 757 suffixes try found) 758 (while path 759 (setq suffixes suffixes-to-try) 760 (while suffixes 761 (setq try (ffap-file-exists-string 762 (expand-file-name 763 (concat file (car suffixes)) (car path)))) 764 (if (and try (or dir-ok (not (file-directory-p try)))) 765 (setq found try suffixes nil path nil) 766 (setq suffixes (cdr suffixes)))) 767 (setq path (cdr path))) 768 found)) 769 770 771;;; Action List (`ffap-alist'): 772;; 773;; These search actions depend on the major-mode or regexps matching 774;; the current name. The little functions and their variables are 775;; deferred to the next section, at some loss of "code locality". A 776;; good example of featuritis. Trim this list for speed. 777 778(defvar ffap-alist 779 '( 780 ("" . ffap-completable) ; completion, slow on some systems 781 ("\\.info\\'" . ffap-info) ; gzip.info 782 ("\\`info/" . ffap-info-2) ; info/emacs 783 ("\\`[-[:lower:]]+\\'" . ffap-info-3) ; (emacs)Top [only in the parentheses] 784 ("\\.elc?\\'" . ffap-el) ; simple.el, simple.elc 785 (emacs-lisp-mode . ffap-el-mode) ; rmail, gnus, simple, custom 786 ;; (lisp-interaction-mode . ffap-el-mode) ; maybe 787 (finder-mode . ffap-el-mode) ; type {C-h p} and try it 788 (help-mode . ffap-el-mode) ; maybe useful 789 (c++-mode . ffap-c-mode) ; search ffap-c-path 790 (cc-mode . ffap-c-mode) ; same 791 ("\\.\\([chCH]\\|cc\\|hh\\)\\'" . ffap-c-mode) ; stdio.h 792 (fortran-mode . ffap-fortran-mode) ; FORTRAN requested by MDB 793 ("\\.[fF]\\'" . ffap-fortran-mode) 794 (tex-mode . ffap-tex-mode) ; search ffap-tex-path 795 (latex-mode . ffap-latex-mode) ; similar 796 ("\\.\\(tex\\|sty\\|doc\\|cls\\)\\'" . ffap-tex) 797 ("\\.bib\\'" . ffap-bib) ; search ffap-bib-path 798 ("\\`\\." . ffap-home) ; .emacs, .bashrc, .profile 799 ("\\`~/" . ffap-lcd) ; |~/misc/ffap.el.Z| 800 ("^[Rr][Ff][Cc][- #]?\\([0-9]+\\)" ; no $ 801 . ffap-rfc) ; "100% RFC2100 compliant" 802 (dired-mode . ffap-dired) ; maybe in a subdirectory 803 ) 804 "Alist of \(KEY . FUNCTION\) pairs parsed by `ffap-file-at-point'. 805If string NAME at point (maybe \"\") is not a file or url, these pairs 806specify actions to try creating such a string. A pair matches if either 807 KEY is a symbol, and it equals `major-mode', or 808 KEY is a string, it should matches NAME as a regexp. 809On a match, \(FUNCTION NAME\) is called and should return a file, an 810url, or nil. If nil, search the alist for further matches.") 811 812(put 'ffap-alist 'risky-local-variable t) 813 814;; Example `ffap-alist' modifications: 815;; 816;; (setq ffap-alist ; remove a feature in `ffap-alist' 817;; (delete (assoc 'c-mode ffap-alist) ffap-alist)) 818;; 819;; (setq ffap-alist ; add something to `ffap-alist' 820;; (cons 821;; (cons "^YSN[0-9]+$" 822;; (defun ffap-ysn (name) 823;; (concat 824;; "http://www.physics.uiuc.edu/" 825;; "ysn/httpd/htdocs/ysnarchive/issuefiles/" 826;; (substring name 3) ".html"))) 827;; ffap-alist)) 828 829 830;;; Action Definitions: 831;; 832;; Define various default members of `ffap-alist'. 833 834(defun ffap-completable (name) 835 (let* ((dir (or (file-name-directory name) default-directory)) 836 (cmp (file-name-completion (file-name-nondirectory name) dir))) 837 (and cmp (concat dir cmp)))) 838 839(defun ffap-home (name) (ffap-locate-file name t '("~"))) 840 841(defun ffap-info (name) 842 (ffap-locate-file 843 name '("" ".info") 844 (or (ffap-soft-value "Info-directory-list") 845 (ffap-soft-value "Info-default-directory-list") 846 ))) 847 848(defun ffap-info-2 (name) (ffap-info (substring name 5))) 849 850(defun ffap-info-3 (name) 851 ;; This ignores the node! "(emacs)Top" same as "(emacs)Intro" 852 (and (equal (ffap-string-around) "()") (ffap-info name))) 853 854(defun ffap-el (name) (ffap-locate-file name t)) 855 856(defun ffap-el-mode (name) 857 ;; If name == "foo.el" we will skip it, since ffap-el already 858 ;; searched for it once. (This assumes the default ffap-alist.) 859 (and (not (string-match "\\.el\\'" name)) 860 (ffap-locate-file name '(".el")))) 861 862(defvar ffap-c-path 863 ;; Need smarter defaults here! Suggestions welcome. 864 '("/usr/include" "/usr/local/include")) 865(defun ffap-c-mode (name) 866 (ffap-locate-file name t ffap-c-path)) 867 868(defvar ffap-fortran-path '("../include" "/usr/include")) 869 870(defun ffap-fortran-mode (name) 871 (ffap-locate-file name t ffap-fortran-path)) 872 873(defvar ffap-tex-path 874 t ; delayed initialization 875 "Path where `ffap-tex-mode' looks for tex files. 876If t, `ffap-tex-init' will initialize this when needed.") 877 878(defun ffap-tex-init nil 879 ;; Compute ffap-tex-path if it is now t. 880 (and (eq t ffap-tex-path) 881 ;; this may be slow, so say something 882 (message "Initializing ffap-tex-path ...") 883 (setq ffap-tex-path 884 (ffap-reduce-path 885 (cons 886 "." 887 (ffap-kpathsea-expand-path 888 (append 889 (ffap-list-env "TEXINPUTS") 890 ;; (ffap-list-env "BIBINPUTS") 891 (ffap-soft-value 892 "TeX-macro-global" ; AUCTeX 893 '("/usr/local/lib/tex/macros" 894 "/usr/local/lib/tex/inputs"))))))))) 895 896(defun ffap-tex-mode (name) 897 (ffap-tex-init) 898 (ffap-locate-file name '(".tex" "") ffap-tex-path)) 899 900(defun ffap-latex-mode (name) 901 (ffap-tex-init) 902 ;; only rare need for "" 903 (ffap-locate-file name '(".cls" ".sty" ".tex" "") ffap-tex-path)) 904 905(defun ffap-tex (name) 906 (ffap-tex-init) 907 (ffap-locate-file name t ffap-tex-path)) 908 909(defvar ffap-bib-path 910 (ffap-list-env "BIBINPUTS" 911 (ffap-reduce-path 912 '( 913 ;; a few wild guesses, need better 914 "/usr/local/lib/tex/macros/bib" ; Solaris? 915 "/usr/lib/texmf/bibtex/bib" ; Linux? 916 )))) 917 918(defun ffap-bib (name) 919 (ffap-locate-file name t ffap-bib-path)) 920 921(defun ffap-dired (name) 922 (let ((pt (point)) dir try) 923 (save-excursion 924 (and (progn 925 (beginning-of-line) 926 (looking-at " *[-d]r[-w][-x][-r][-w][-x][-r][-w][-x] ")) 927 (re-search-backward "^ *$" nil t) 928 (re-search-forward "^ *\\([^ \t\n:]*\\):\n *total " pt t) 929 (file-exists-p 930 (setq try 931 (expand-file-name 932 name 933 (buffer-substring 934 (match-beginning 1) (match-end 1))))) 935 try)))) 936 937;; Maybe a "Lisp Code Directory" reference: 938(defun ffap-lcd (name) 939 (and 940 (or 941 ;; lisp-dir-apropos output buffer: 942 (string-match "Lisp Code Dir" (buffer-name)) 943 ;; Inside an LCD entry like |~/misc/ffap.el.Z|, 944 ;; or maybe the holy LCD-Datafile itself: 945 (member (ffap-string-around) '("||" "|\n"))) 946 (concat 947 ;; lispdir.el may not be loaded yet: 948 (ffap-host-to-filename 949 (ffap-soft-value "elisp-archive-host" 950 "archive.cis.ohio-state.edu")) 951 (file-name-as-directory 952 (ffap-soft-value "elisp-archive-directory" 953 "/pub/gnu/emacs/elisp-archive/")) 954 (substring name 2)))) 955 956(defvar ffap-rfc-path 957 (concat (ffap-host-to-filename "ftp.rfc-editor.org") "/in-notes/rfc%s.txt")) 958 959(defun ffap-rfc (name) 960 (format ffap-rfc-path 961 (substring name (match-beginning 1) (match-end 1)))) 962 963 964;;; At-Point Functions: 965 966(defvar ffap-string-at-point-mode-alist 967 '( 968 ;; The default, used when the `major-mode' is not found. 969 ;; Slightly controversial decisions: 970 ;; * strip trailing "@" and ":" 971 ;; * no commas (good for latex) 972 (file "--:$+<>@-Z_[:lower:]~*?" "<@" "@>;.,!:") 973 ;; An url, or maybe a email/news message-id: 974 (url "--:=&?$+@-Z_[:lower:]~#,%;*" "^[:alnum:]" ":;.,!?") 975 ;; Find a string that does *not* contain a colon: 976 (nocolon "--9$+<>@-Z_[:lower:]~" "<@" "@>;.,!?") 977 ;; A machine: 978 (machine "-[:alnum:]." "" ".") 979 ;; Mathematica paths: allow backquotes 980 (math-mode ",-:$+<>@-Z_[:lower:]~`" "<" "@>;.,!?`:") 981 ) 982 "Alist of \(MODE CHARS BEG END\), where MODE is a symbol, 983possibly a major-mode name, or one of the symbol 984`file', `url', `machine', and `nocolon'. 985`ffap-string-at-point' uses the data fields as follows: 9861. find a maximal string of CHARS around point, 9872. strip BEG chars before point from the beginning, 9883. Strip END chars after point from the end.") 989 990(defvar ffap-string-at-point nil 991 ;; Added at suggestion of RHOGEE (for ff-paths), 7/24/95. 992 "Last string returned by `ffap-string-at-point'.") 993 994(defun ffap-string-at-point (&optional mode) 995 "Return a string of characters from around point. 996MODE (defaults to value of `major-mode') is a symbol used to look up string 997syntax parameters in `ffap-string-at-point-mode-alist'. 998If MODE is not found, we use `file' instead of MODE. 999If the region is active, return a string from the region. 1000Sets `ffap-string-at-point' and `ffap-string-at-point-region'." 1001 (let* ((args 1002 (cdr 1003 (or (assq (or mode major-mode) ffap-string-at-point-mode-alist) 1004 (assq 'file ffap-string-at-point-mode-alist)))) 1005 (pt (point)) 1006 (str 1007 (if (and transient-mark-mode mark-active) 1008 (buffer-substring 1009 (setcar ffap-string-at-point-region (region-beginning)) 1010 (setcar (cdr ffap-string-at-point-region) (region-end))) 1011 (buffer-substring 1012 (save-excursion 1013 (skip-chars-backward (car args)) 1014 (skip-chars-forward (nth 1 args) pt) 1015 (setcar ffap-string-at-point-region (point))) 1016 (save-excursion 1017 (skip-chars-forward (car args)) 1018 (skip-chars-backward (nth 2 args) pt) 1019 (setcar (cdr ffap-string-at-point-region) (point))))))) 1020 (set-text-properties 0 (length str) nil str) 1021 (setq ffap-string-at-point str))) 1022 1023(defun ffap-string-around nil 1024 ;; Sometimes useful to decide how to treat a string. 1025 "Return string of two chars around last `ffap-string-at-point'. 1026Assumes the buffer has not changed." 1027 (save-excursion 1028 (format "%c%c" 1029 (progn 1030 (goto-char (car ffap-string-at-point-region)) 1031 (preceding-char)) ; maybe 0 1032 (progn 1033 (goto-char (nth 1 ffap-string-at-point-region)) 1034 (following-char)) ; maybe 0 1035 ))) 1036 1037(defun ffap-copy-string-as-kill (&optional mode) 1038 ;; Requested by MCOOK. Useful? 1039 "Call `ffap-string-at-point', and copy result to `kill-ring'." 1040 (interactive) 1041 (let ((str (ffap-string-at-point mode))) 1042 (if (equal "" str) 1043 (message "No string found around point.") 1044 (kill-new str) 1045 ;; Older: (apply 'copy-region-as-kill ffap-string-at-point-region) 1046 (message "Copied to kill ring: %s" str)))) 1047 1048(defun ffap-url-at-point nil 1049 "Return url from around point if it exists, or nil." 1050 ;; Could use w3's url-get-url-at-point instead. Both handle "URL:", 1051 ;; ignore non-relative links, trim punctuation. The other will 1052 ;; actually look back if point is in whitespace, but I would rather 1053 ;; ffap be less aggressive in such situations. 1054 (and 1055 ffap-url-regexp 1056 (or 1057 ;; In a w3 buffer button? 1058 (and (eq major-mode 'w3-mode) 1059 ;; interface recommended by wmperry: 1060 (w3-view-this-url t)) 1061 ;; Is there a reason not to strip trailing colon? 1062 (let ((name (ffap-string-at-point 'url))) 1063 (cond 1064 ((string-match "^url:" name) (setq name (substring name 4))) 1065 ((and (string-match "\\`[^:</>@]+@[^:</>@]+[[:alnum:]]\\'" name) 1066 ;; "foo@bar": could be "mailto" or "news" (a Message-ID). 1067 ;; Without "<>" it must be "mailto". Otherwise could be 1068 ;; either, so consult `ffap-foo-at-bar-prefix'. 1069 (let ((prefix (if (and (equal (ffap-string-around) "<>") 1070 ;; Expect some odd characters: 1071 (string-match "[$.0-9].*[$.0-9].*@" name)) 1072 ;; Could be news: 1073 ffap-foo-at-bar-prefix 1074 "mailto"))) 1075 (and prefix (setq name (concat prefix ":" name)))))) 1076 ((ffap-newsgroup-p name) (setq name (concat "news:" name))) 1077 ((and (string-match "\\`[[:alnum:]]+\\'" name) ; <mic> <root> <nobody> 1078 (equal (ffap-string-around) "<>") 1079 ;; (ffap-user-p name): 1080 (not (string-match "~" (expand-file-name (concat "~" name)))) 1081 ) 1082 (setq name (concat "mailto:" name))) 1083 ) 1084 (and (ffap-url-p name) name) 1085 )))) 1086 1087(defvar ffap-gopher-regexp 1088 "^.*\\<\\(Type\\|Name\\|Path\\|Host\\|Port\\) *= *\\(.*\\) *$" 1089 "Regexp Matching a line in a gopher bookmark (maybe indented). 1090The two subexpressions are the KEY and VALUE.") 1091 1092(defun ffap-gopher-at-point nil 1093 "If point is inside a gopher bookmark block, return its url." 1094 ;; `gopher-parse-bookmark' from gopher.el is not so robust 1095 (save-excursion 1096 (beginning-of-line) 1097 (if (looking-at ffap-gopher-regexp) 1098 (progn 1099 (while (and (looking-at ffap-gopher-regexp) (not (bobp))) 1100 (forward-line -1)) 1101 (or (looking-at ffap-gopher-regexp) (forward-line 1)) 1102 (let ((type "1") name path host (port "70")) 1103 (while (looking-at ffap-gopher-regexp) 1104 (let ((var (intern 1105 (downcase 1106 (buffer-substring (match-beginning 1) 1107 (match-end 1))))) 1108 (val (buffer-substring (match-beginning 2) 1109 (match-end 2)))) 1110 (set var val) 1111 (forward-line 1))) 1112 (if (and path (string-match "^ftp:.*@" path)) 1113 (concat "ftp://" 1114 (substring path 4 (1- (match-end 0))) 1115 (substring path (match-end 0))) 1116 (and (= (length type) 1) 1117 host;; (ffap-machine-p host) 1118 (concat "gopher://" host 1119 (if (equal port "70") "" (concat ":" port)) 1120 "/" type path)))))))) 1121 1122(defvar ffap-ftp-sans-slash-regexp 1123 (and 1124 ffap-ftp-regexp 1125 ;; Note: by now, we know it is not an url. 1126 ;; Icky regexp avoids: default: 123: foo::bar cs:pub 1127 ;; It does match on: mic@cs: cs:/pub mathcs.emory.edu: (point at end) 1128 "\\`\\([^:@]+@[^:@]+:\\|[^@.:]+\\.[^@:]+:\\|[^:]+:[~/]\\)\\([^:]\\|\\'\\)") 1129 "Strings matching this are coerced to ftp file names by ffap. 1130That is, ffap just prepends \"/\". Set to nil to disable.") 1131 1132(defun ffap-file-at-point nil 1133 "Return filename from around point if it exists, or nil. 1134Existence test is skipped for names that look remote. 1135If the filename is not obvious, it also tries `ffap-alist', 1136which may actually result in an url rather than a filename." 1137 ;; Note: this function does not need to look for url's, just 1138 ;; filenames. On the other hand, it is responsible for converting 1139 ;; a pseudo-url "site.com://dir" to an ftp file name 1140 (let* ((case-fold-search t) ; url prefixes are case-insensitive 1141 (data (match-data)) 1142 (string (ffap-string-at-point)) ; uses mode alist 1143 (name 1144 (or (condition-case nil 1145 (and (not (string-match "//" string)) ; foo.com://bar 1146 (substitute-in-file-name string)) 1147 (error nil)) 1148 string)) 1149 (abs (file-name-absolute-p name)) 1150 (default-directory default-directory) 1151 (oname name)) 1152 (unwind-protect 1153 (cond 1154 ;; Immediate rejects (/ and // and /* are too common in C/C++): 1155 ((member name '("" "/" "//" "/*" ".")) nil) 1156 ;; Immediately test local filenames. If default-directory is 1157 ;; remote, you probably already have a connection. 1158 ((and (not abs) (ffap-file-exists-string name))) 1159 ;; Try stripping off line numbers; good for compilation/grep output. 1160 ((and (not abs) (string-match ":[0-9]" name) 1161 (ffap-file-exists-string (substring name 0 (match-beginning 0))))) 1162 ;; Try stripping off prominent (non-root - #) shell prompts 1163 ;; if the ffap-shell-prompt-regexp is non-nil. 1164 ((and ffap-shell-prompt-regexp 1165 (not abs) (string-match ffap-shell-prompt-regexp name) 1166 (ffap-file-exists-string (substring name (match-end 0))))) 1167 ;; Accept remote names without actual checking (too slow): 1168 ((and abs (ffap-file-remote-p name))) 1169 ;; Ok, not remote, try the existence test even if it is absolute: 1170 ((and abs (ffap-file-exists-string name))) 1171 ;; If it contains a colon, get rid of it (and return if exists) 1172 ((and (string-match path-separator name) 1173 (setq name (ffap-string-at-point 'nocolon)) 1174 (ffap-file-exists-string name))) 1175 ;; File does not exist, try the alist: 1176 ((let ((alist ffap-alist) tem try case-fold-search) 1177 (while (and alist (not try)) 1178 (setq tem (car alist) alist (cdr alist)) 1179 (if (or (eq major-mode (car tem)) 1180 (and (stringp (car tem)) 1181 (string-match (car tem) name))) 1182 (and (setq try 1183 (condition-case nil 1184 (funcall (cdr tem) name) 1185 (error nil))) 1186 (setq try (or 1187 (ffap-url-p try) ; not a file! 1188 (ffap-file-remote-p try) 1189 (ffap-file-exists-string try)))))) 1190 try)) 1191 ;; Try adding a leading "/" (common omission in ftp file names). 1192 ;; Note that this uses oname, which still has any colon part. 1193 ;; This should have a lower priority than the alist stuff, 1194 ;; else it matches things like "ffap.el:1234:56:Warning". 1195 ((and (not abs) 1196 ffap-ftp-sans-slash-regexp 1197 (string-match ffap-ftp-sans-slash-regexp oname) 1198 (ffap-file-remote-p (concat "/" oname)))) 1199 ;; Alist failed? Try to guess an active remote connection 1200 ;; from buffer variables, and try once more, both as an 1201 ;; absolute and relative file name on that remote host. 1202 ((let* (ffap-rfs-regexp ; suppress 1203 (remote-dir 1204 (cond 1205 ((ffap-file-remote-p default-directory)) 1206 ((and (eq major-mode 'internal-ange-ftp-mode) 1207 (string-match "^\\*ftp \\(.*\\)@\\(.*\\)\\*$" 1208 (buffer-name))) 1209 (concat "/" (substring (buffer-name) 5 -1) ":")) 1210 ;; This is too often a bad idea: 1211 ;;((and (eq major-mode 'w3-mode) 1212 ;; (stringp url-current-server)) 1213 ;; (host-to-ange-path url-current-server)) 1214 ))) 1215 (and remote-dir 1216 (or 1217 (and (string-match "\\`\\(/?~?ftp\\)/" name) 1218 (ffap-file-exists-string 1219 (ffap-replace-file-component 1220 remote-dir (substring name (match-end 1))))) 1221 (ffap-file-exists-string 1222 (ffap-replace-file-component remote-dir name)))))) 1223 ((and ffap-dired-wildcards 1224 (string-match ffap-dired-wildcards name) 1225 abs 1226 (ffap-file-exists-string (file-name-directory 1227 (directory-file-name name))) 1228 name)) 1229 ;; Try all parent directories by deleting the trailing directory 1230 ;; name until existing directory is found or name stops changing 1231 ((let ((dir name)) 1232 (while (and dir 1233 (not (ffap-file-exists-string dir)) 1234 (not (equal dir (setq dir (file-name-directory 1235 (directory-file-name dir))))))) 1236 (ffap-file-exists-string dir))) 1237 ) 1238 (set-match-data data)))) 1239 1240;;; Prompting (`ffap-read-file-or-url'): 1241;; 1242;; We want to complete filenames as in read-file-name, but also url's 1243;; which read-file-name-internal would truncate at the "//" string. 1244;; The solution here is to replace read-file-name-internal with 1245;; `ffap-read-file-or-url-internal', which checks the minibuffer 1246;; contents before attempting to complete filenames. 1247 1248(defun ffap-read-file-or-url (prompt guess) 1249 "Read file or url from minibuffer, with PROMPT and initial GUESS." 1250 (or guess (setq guess default-directory)) 1251 (let (dir) 1252 ;; Tricky: guess may have or be a local directory, like "w3/w3.elc" 1253 ;; or "w3/" or "../el/ffap.el" or "../../../" 1254 (or (ffap-url-p guess) 1255 (progn 1256 (or (ffap-file-remote-p guess) 1257 (setq guess 1258 (abbreviate-file-name (expand-file-name guess)) 1259 )) 1260 (setq dir (file-name-directory guess)))) 1261 (let ((minibuffer-completing-file-name t) 1262 (completion-ignore-case read-file-name-completion-ignore-case)) 1263 (setq guess 1264 (completing-read 1265 prompt 1266 'ffap-read-file-or-url-internal 1267 dir 1268 nil 1269 (if dir (cons guess (length dir)) guess) 1270 (list 'file-name-history) 1271 (and buffer-file-name 1272 (abbreviate-file-name buffer-file-name))))) 1273 ;; Do file substitution like (interactive "F"), suggested by MCOOK. 1274 (or (ffap-url-p guess) (setq guess (substitute-in-file-name guess))) 1275 ;; Should not do it on url's, where $ is a common (VMS?) character. 1276 ;; Note: upcoming url.el package ought to handle this automatically. 1277 guess)) 1278 1279(defun ffap-read-url-internal (string dir action) 1280 "Complete url's from history, treating given string as valid." 1281 (let ((hist (ffap-soft-value "url-global-history-hash-table"))) 1282 (cond 1283 ((not action) 1284 (or (try-completion string hist) string)) 1285 ((eq action t) 1286 (or (all-completions string hist) (list string))) 1287 ;; action == lambda, documented where? Tests whether string is a 1288 ;; valid "match". Let us always say yes. 1289 (t t)))) 1290 1291(defun ffap-read-file-or-url-internal (string dir action) 1292 (unless dir 1293 (setq dir default-directory)) 1294 (unless string 1295 (setq string default-directory)) 1296 (if (ffap-url-p string) 1297 (ffap-read-url-internal string dir action) 1298 (read-file-name-internal string dir action))) 1299 1300;; The rest of this page is just to work with package complete.el. 1301;; This code assumes that you load ffap.el after complete.el. 1302;; 1303;; We must inform complete about whether our completion function 1304;; will do filename style completion. 1305 1306(defun ffap-complete-as-file-p nil 1307 ;; Will `minibuffer-completion-table' complete the minibuffer 1308 ;; contents as a filename? Assumes the minibuffer is current. 1309 ;; Note: t and non-nil mean somewhat different reasons. 1310 (if (eq minibuffer-completion-table 'ffap-read-file-or-url-internal) 1311 (not (ffap-url-p (buffer-string))) ; t 1312 (and minibuffer-completing-file-name '(t)))) ;list 1313 1314(and 1315 (featurep 'complete) 1316 (if (boundp 'PC-completion-as-file-name-predicate) 1317 ;; modern version of complete.el, just set the variable: 1318 (setq PC-completion-as-file-name-predicate 'ffap-complete-as-file-p))) 1319 1320 1321;;; Highlighting (`ffap-highlight'): 1322;; 1323;; Based on overlay highlighting in Emacs 19.28 isearch.el. 1324 1325(defvar ffap-highlight t 1326 "If non-nil, ffap highlights the current buffer substring.") 1327 1328(defface ffap 1329 '((t :inherit highlight)) 1330 "Face used to highlight the current buffer substring." 1331 :group 'ffap 1332 :version "22.1") 1333 1334(defvar ffap-highlight-overlay nil 1335 "Overlay used by `ffap-highlight'.") 1336 1337(defun ffap-highlight (&optional remove) 1338 "If `ffap-highlight' is set, highlight the guess in this buffer. 1339That is, the last buffer substring found by `ffap-string-at-point'. 1340Optional argument REMOVE means to remove any such highlighting. 1341Uses the face `ffap' if it is defined, or else `highlight'." 1342 (cond 1343 (remove 1344 (and ffap-highlight-overlay 1345 (delete-overlay ffap-highlight-overlay)) 1346 ) 1347 ((not ffap-highlight) nil) 1348 (ffap-highlight-overlay 1349 (move-overlay 1350 ffap-highlight-overlay 1351 (car ffap-string-at-point-region) 1352 (nth 1 ffap-string-at-point-region) 1353 (current-buffer))) 1354 (t 1355 (setq ffap-highlight-overlay 1356 (apply 'make-overlay ffap-string-at-point-region)) 1357 (overlay-put ffap-highlight-overlay 'face 'ffap)))) 1358 1359 1360;;; Main Entrance (`find-file-at-point' == `ffap'): 1361 1362(defun ffap-guesser nil 1363 "Return file or URL or nil, guessed from text around point." 1364 (or (and ffap-url-regexp 1365 (ffap-fixup-url (or (ffap-url-at-point) 1366 (ffap-gopher-at-point)))) 1367 (ffap-file-at-point) ; may yield url! 1368 (ffap-fixup-machine (ffap-machine-at-point)))) 1369 1370(defun ffap-prompter (&optional guess) 1371 ;; Does guess and prompt step for find-file-at-point. 1372 ;; Extra complication for the temporary highlighting. 1373 (unwind-protect 1374 ;; This catch will let ffap-alist entries do their own prompting 1375 ;; and then maybe skip over this prompt (ff-paths, for example). 1376 (catch 'ffap-prompter 1377 (ffap-read-file-or-url 1378 (if ffap-url-regexp "Find file or URL: " "Find file: ") 1379 (prog1 1380 (setq guess (or guess (ffap-guesser))) ; using ffap-alist here 1381 (and guess (ffap-highlight)) 1382 ))) 1383 (ffap-highlight t))) 1384 1385;;;###autoload 1386(defun find-file-at-point (&optional filename) 1387 "Find FILENAME, guessing a default from text around point. 1388If `ffap-url-regexp' is not nil, the FILENAME may also be an URL. 1389With a prefix, this command behaves exactly like `ffap-file-finder'. 1390If `ffap-require-prefix' is set, the prefix meaning is reversed. 1391See also the variables `ffap-dired-wildcards', `ffap-newfile-prompt', 1392and the functions `ffap-file-at-point' and `ffap-url-at-point'." 1393 (interactive) 1394 (if (and (interactive-p) 1395 (if ffap-require-prefix (not current-prefix-arg) 1396 current-prefix-arg)) 1397 ;; Do exactly the ffap-file-finder command, even the prompting: 1398 (let (current-prefix-arg) ; we already interpreted it 1399 (call-interactively ffap-file-finder)) 1400 (or filename (setq filename (ffap-prompter))) 1401 (cond 1402 ((ffap-url-p filename) 1403 (let (current-prefix-arg) ; w3 2.3.25 bug, reported by KPC 1404 (funcall ffap-url-fetcher filename))) 1405 ((and ffap-pass-wildcards-to-dired 1406 ffap-dired-wildcards 1407 (string-match ffap-dired-wildcards filename)) 1408 (funcall ffap-directory-finder filename)) 1409 ((and ffap-dired-wildcards 1410 (string-match ffap-dired-wildcards filename) 1411 find-file-wildcards 1412 ;; Check if it's find-file that supports wildcards arg 1413 (memq ffap-file-finder '(find-file find-alternate-file))) 1414 (funcall ffap-file-finder (expand-file-name filename) t)) 1415 ((or (not ffap-newfile-prompt) 1416 (file-exists-p filename) 1417 (y-or-n-p "File does not exist, create buffer? ")) 1418 (funcall ffap-file-finder 1419 ;; expand-file-name fixes "~/~/.emacs" bug sent by CHUCKR. 1420 (expand-file-name filename))) 1421 ;; User does not want to find a non-existent file: 1422 ((signal 'file-error (list "Opening file buffer" 1423 "no such file or directory" 1424 filename)))))) 1425 1426;; Shortcut: allow {M-x ffap} rather than {M-x find-file-at-point}. 1427;;;###autoload 1428(defalias 'ffap 'find-file-at-point) 1429 1430 1431;;; Menu support (`ffap-menu'): 1432 1433(defvar ffap-menu-regexp nil 1434 "*If non-nil, overrides `ffap-next-regexp' during `ffap-menu'. 1435Make this more restrictive for faster menu building. 1436For example, try \":/\" for URL (and some ftp) references.") 1437 1438(defvar ffap-menu-alist nil 1439 "Buffer local cache of menu presented by `ffap-menu'.") 1440(make-variable-buffer-local 'ffap-menu-alist) 1441 1442(defvar ffap-menu-text-plist 1443 (cond 1444 ((display-mouse-p) '(face bold mouse-face highlight)) ; keymap <mousy-map> 1445 (t nil)) 1446 "Text properties applied to strings found by `ffap-menu-rescan'. 1447These properties may be used to fontify the menu references.") 1448 1449;;;###autoload 1450(defun ffap-menu (&optional rescan) 1451 "Put up a menu of files and urls mentioned in this buffer. 1452Then set mark, jump to choice, and try to fetch it. The menu is 1453cached in `ffap-menu-alist', and rebuilt by `ffap-menu-rescan'. 1454The optional RESCAN argument \(a prefix, interactively\) forces 1455a rebuild. Searches with `ffap-menu-regexp'." 1456 (interactive "P") 1457 ;; (require 'imenu) -- no longer used, but roughly emulated 1458 (if (or (not ffap-menu-alist) rescan 1459 ;; or if the first entry is wrong: 1460 (and ffap-menu-alist 1461 (let ((first (car ffap-menu-alist))) 1462 (save-excursion 1463 (goto-char (cdr first)) 1464 (not (equal (car first) (ffap-guesser))))))) 1465 (ffap-menu-rescan)) 1466 ;; Tail recursive: 1467 (ffap-menu-ask 1468 (if ffap-url-regexp "Find file or URL" "Find file") 1469 (cons (cons "*Rescan Buffer*" -1) ffap-menu-alist) 1470 'ffap-menu-cont)) 1471 1472(defun ffap-menu-cont (choice) ; continuation of ffap-menu 1473 (if (< (cdr choice) 0) 1474 (ffap-menu t) ; *Rescan* 1475 (push-mark) 1476 (goto-char (cdr choice)) 1477 ;; Momentary highlight: 1478 (unwind-protect 1479 (progn 1480 (and ffap-highlight (ffap-guesser) (ffap-highlight)) 1481 (sit-for 0) ; display 1482 (find-file-at-point (car choice))) 1483 (ffap-highlight t)))) 1484 1485(defun ffap-menu-ask (title alist cont) 1486 "Prompt from a menu of choices, and then apply some action. 1487Arguments are TITLE, ALIST, and CONT \(a continuation function\). 1488This uses either a menu or the minibuffer depending on invocation. 1489The TITLE string is used as either the prompt or menu title. 1490Each ALIST entry looks like (STRING . DATA) and defines one choice. 1491Function CONT is applied to the entry chosen by the user." 1492 ;; Note: this function is used with a different continuation 1493 ;; by the ffap-url add-on package. 1494 ;; Could try rewriting to use easymenu.el or lmenu.el. 1495 (let (choice) 1496 (cond 1497 ;; Emacs mouse: 1498 ((and (fboundp 'x-popup-menu) (ffap-mouse-event)) 1499 (setq choice 1500 (x-popup-menu 1501 t 1502 (list "" (cons title 1503 (mapcar (function (lambda (i) (cons (car i) i))) 1504 alist)))))) 1505 ;; minibuffer with completion buffer: 1506 (t 1507 (let ((minibuffer-setup-hook 'minibuffer-completion-help)) 1508 ;; Bug: prompting may assume unique strings, no "". 1509 (setq choice 1510 (completing-read 1511 (format "%s (default %s): " title (car (car alist))) 1512 alist nil t 1513 ;; (cons (car (car alist)) 0) 1514 nil))) 1515 (sit-for 0) ; redraw original screen 1516 ;; Convert string to its entry, or else the default: 1517 (setq choice (or (assoc choice alist) (car alist)))) 1518 ) 1519 (if choice 1520 (funcall cont choice) 1521 (message "No choice made!") ; possible with menus 1522 nil))) 1523 1524(defun ffap-menu-rescan nil 1525 "Search buffer for `ffap-menu-regexp' to build `ffap-menu-alist'. 1526Applies `ffap-menu-text-plist' text properties at all matches." 1527 (interactive) 1528 (let ((ffap-next-regexp (or ffap-menu-regexp ffap-next-regexp)) 1529 (range (- (point-max) (point-min))) 1530 (mod (buffer-modified-p)) ; was buffer modified? 1531 ;; inhibit-read-only works on read-only text properties 1532 ;; as well as read-only buffers. 1533 (inhibit-read-only t) ; to set text-properties 1534 item 1535 ;; Avoid repeated searches of the *mode-alist: 1536 (major-mode (if (assq major-mode ffap-string-at-point-mode-alist) 1537 major-mode 1538 'file))) 1539 (setq ffap-menu-alist nil) 1540 (unwind-protect 1541 (save-excursion 1542 (goto-char (point-min)) 1543 (while (setq item (ffap-next-guess)) 1544 (setq ffap-menu-alist (cons (cons item (point)) ffap-menu-alist)) 1545 (add-text-properties (car ffap-string-at-point-region) (point) 1546 ffap-menu-text-plist) 1547 (message "Scanning...%2d%% <%s>" 1548 (/ (* 100 (- (point) (point-min))) range) item))) 1549 (or mod (set-buffer-modified-p nil)))) 1550 (message "Scanning...done") 1551 ;; Remove duplicates. 1552 (setq ffap-menu-alist ; sort by item 1553 (sort ffap-menu-alist 1554 (function 1555 (lambda (a b) (string-lessp (car a) (car b)))))) 1556 (let ((ptr ffap-menu-alist)) ; remove duplicates 1557 (while (cdr ptr) 1558 (if (equal (car (car ptr)) (car (car (cdr ptr)))) 1559 (setcdr ptr (cdr (cdr ptr))) 1560 (setq ptr (cdr ptr))))) 1561 (setq ffap-menu-alist ; sort by position 1562 (sort ffap-menu-alist 1563 (function 1564 (lambda (a b) (< (cdr a) (cdr b))))))) 1565 1566 1567;;; Mouse Support (`ffap-at-mouse'): 1568;; 1569;; See the suggested binding in ffap-bindings (near eof). 1570 1571(defvar ffap-at-mouse-fallback nil ; ffap-menu? too time-consuming 1572 "Command invoked by `ffap-at-mouse' if nothing found at click, or nil. 1573Ignored when `ffap-at-mouse' is called programmatically.") 1574(put 'ffap-at-mouse-fallback 'risky-local-variable t) 1575 1576;;;###autoload 1577(defun ffap-at-mouse (e) 1578 "Find file or url guessed from text around mouse click. 1579Interactively, calls `ffap-at-mouse-fallback' if no guess is found. 1580Return value: 1581 * if a guess string is found, return it (after finding it) 1582 * if the fallback is called, return whatever it returns 1583 * otherwise, nil" 1584 (interactive "e") 1585 (let ((guess 1586 ;; Maybe less surprising without the save-excursion? 1587 (save-excursion 1588 (mouse-set-point e) 1589 ;; Would prefer to do nothing unless click was *on* text. How 1590 ;; to tell that the click was beyond the end of current line? 1591 (ffap-guesser)))) 1592 (cond 1593 (guess 1594 (set-buffer (ffap-event-buffer e)) 1595 (ffap-highlight) 1596 (unwind-protect 1597 (progn 1598 (sit-for 0) ; display 1599 (message "Finding `%s'" guess) 1600 (find-file-at-point guess) 1601 guess) ; success: return non-nil 1602 (ffap-highlight t))) 1603 ((interactive-p) 1604 (if ffap-at-mouse-fallback 1605 (call-interactively ffap-at-mouse-fallback) 1606 (message "No file or url found at mouse click.") 1607 nil)) ; no fallback, return nil 1608 ;; failure: return nil 1609 ))) 1610 1611 1612;;; ffap-other-*, ffap-read-only-*, ffap-alternate-* commands: 1613 1614;; There could be a real `ffap-noselect' function, but we would need 1615;; at least two new user variables, and there is no w3-fetch-noselect. 1616;; So instead, we just fake it with a slow save-window-excursion. 1617 1618(defun ffap-other-window nil 1619 "Like `ffap', but put buffer in another window. 1620Only intended for interactive use." 1621 (interactive) 1622 (let (value) 1623 (switch-to-buffer-other-window 1624 (save-window-excursion 1625 (setq value (call-interactively 'ffap)) 1626 (unless (or (bufferp value) (bufferp (car-safe value))) 1627 (setq value (current-buffer))) 1628 (current-buffer))) 1629 value)) 1630 1631(defun ffap-other-frame nil 1632 "Like `ffap', but put buffer in another frame. 1633Only intended for interactive use." 1634 (interactive) 1635 ;; Extra code works around dedicated windows (noted by JENS, 7/96): 1636 (let* ((win (selected-window)) 1637 (wdp (window-dedicated-p win)) 1638 value) 1639 (unwind-protect 1640 (progn 1641 (set-window-dedicated-p win nil) 1642 (switch-to-buffer-other-frame 1643 (save-window-excursion 1644 (setq value (call-interactively 'ffap)) 1645 (unless (or (bufferp value) (bufferp (car-safe value))) 1646 (setq value (current-buffer))) 1647 (current-buffer)))) 1648 (set-window-dedicated-p win wdp)) 1649 value)) 1650 1651(defun ffap-read-only () 1652 "Like `ffap', but mark buffer as read-only. 1653Only intended for interactive use." 1654 (interactive) 1655 (let ((value (call-interactively 'ffap))) 1656 (unless (or (bufferp value) (bufferp (car-safe value))) 1657 (setq value (current-buffer))) 1658 (mapc (lambda (b) (with-current-buffer b (toggle-read-only 1))) 1659 (if (listp value) value (list value))) 1660 value)) 1661 1662(defun ffap-read-only-other-window () 1663 "Like `ffap', but put buffer in another window and mark as read-only. 1664Only intended for interactive use." 1665 (interactive) 1666 (let ((value (ffap-other-window))) 1667 (mapc (lambda (b) (with-current-buffer b (toggle-read-only 1))) 1668 (if (listp value) value (list value))) 1669 value)) 1670 1671(defun ffap-read-only-other-frame () 1672 "Like `ffap', but put buffer in another frame and mark as read-only. 1673Only intended for interactive use." 1674 (interactive) 1675 (let ((value (ffap-other-frame))) 1676 (mapc (lambda (b) (with-current-buffer b (toggle-read-only 1))) 1677 (if (listp value) value (list value))) 1678 value)) 1679 1680(defun ffap-alternate-file () 1681 "Like `ffap' and `find-alternate-file'. 1682Only intended for interactive use." 1683 (interactive) 1684 (let ((ffap-file-finder 'find-alternate-file)) 1685 (call-interactively 'ffap))) 1686 1687 1688;;; Bug Reporter: 1689 1690(defun ffap-bug nil 1691 "Submit a bug report for the ffap package." 1692 ;; Important: keep the version string here in synch with that at top 1693 ;; of file! Could use lisp-mnt from Emacs 19, but that would depend 1694 ;; on being able to find the ffap.el source file. 1695 (interactive) 1696 (require 'reporter) 1697 (let ((reporter-prompt-for-summary-p t)) 1698 (reporter-submit-bug-report 1699 "Michelangelo Grigni <mic@mathcs.emory.edu>" 1700 "ffap" 1701 (mapcar 'intern (all-completions "ffap-" obarray 'boundp))))) 1702 1703(fset 'ffap-submit-bug 'ffap-bug) ; another likely name 1704 1705 1706;;; Hooks for Gnus, VM, Rmail: 1707;; 1708;; If you do not like these bindings, write versions with whatever 1709;; bindings you would prefer. 1710 1711(defun ffap-ro-mode-hook nil 1712 "Bind `ffap-next' and `ffap-menu' to M-l and M-m, resp." 1713 (local-set-key "\M-l" 'ffap-next) 1714 (local-set-key "\M-m" 'ffap-menu) 1715 ) 1716 1717(defun ffap-gnus-hook nil 1718 "Bind `ffap-gnus-next' and `ffap-gnus-menu' to M-l and M-m, resp." 1719 (set (make-local-variable 'ffap-foo-at-bar-prefix) "news") ; message-id's 1720 ;; Note "l", "L", "m", "M" are taken: 1721 (local-set-key "\M-l" 'ffap-gnus-next) 1722 (local-set-key "\M-m" 'ffap-gnus-menu)) 1723 1724(defvar gnus-summary-buffer) 1725(defvar gnus-article-buffer) 1726 1727(defun ffap-gnus-wrapper (form) ; used by both commands below 1728 (and (eq (current-buffer) (get-buffer gnus-summary-buffer)) 1729 (gnus-summary-select-article)) ; get article of current line 1730 ;; Preserve selected buffer, but do not do save-window-excursion, 1731 ;; since we want to see any window created by the form. Temporarily 1732 ;; select the article buffer, so we can see any point movement. 1733 (let ((sb (window-buffer (selected-window)))) 1734 (gnus-configure-windows 'article) 1735 (pop-to-buffer gnus-article-buffer) 1736 (widen) 1737 ;; Skip headers for ffap-gnus-next (which will wrap around) 1738 (if (eq (point) (point-min)) (search-forward "\n\n" nil t)) 1739 (unwind-protect 1740 (eval form) 1741 (pop-to-buffer sb)))) 1742 1743(defun ffap-gnus-next nil 1744 "Run `ffap-next' in the gnus article buffer." 1745 (interactive) (ffap-gnus-wrapper '(ffap-next nil t))) 1746 1747(defun ffap-gnus-menu nil 1748 "Run `ffap-menu' in the gnus article buffer." 1749 (interactive) (ffap-gnus-wrapper '(ffap-menu))) 1750 1751 1752(defcustom dired-at-point-require-prefix nil 1753 "*If set, reverses the prefix argument to `dired-at-point'. 1754This is nil so neophytes notice ffap. Experts may prefer to disable 1755ffap most of the time." 1756 :type 'boolean 1757 :group 'ffap 1758 :version "20.3") 1759 1760;;;###autoload 1761(defun dired-at-point (&optional filename) 1762 "Start Dired, defaulting to file at point. See `ffap'." 1763 (interactive) 1764 (if (and (interactive-p) 1765 (if dired-at-point-require-prefix 1766 (not current-prefix-arg) 1767 current-prefix-arg)) 1768 (let (current-prefix-arg) ; already interpreted 1769 (call-interactively ffap-directory-finder)) 1770 (or filename (setq filename (dired-at-point-prompter))) 1771 (cond 1772 ((ffap-url-p filename) 1773 (funcall ffap-url-fetcher filename)) 1774 ((and ffap-dired-wildcards 1775 (string-match ffap-dired-wildcards filename)) 1776 (funcall ffap-directory-finder filename)) 1777 ((file-exists-p filename) 1778 (if (file-directory-p filename) 1779 (funcall ffap-directory-finder 1780 (expand-file-name filename)) 1781 (funcall ffap-directory-finder 1782 (concat (expand-file-name filename) "*")))) 1783 ((and (file-writable-p 1784 (or (file-name-directory (directory-file-name filename)) 1785 filename)) 1786 (y-or-n-p "Directory does not exist, create it? ")) 1787 (make-directory filename) 1788 (funcall ffap-directory-finder filename)) 1789 ((error "No such file or directory `%s'" filename))))) 1790 1791(defun dired-at-point-prompter (&optional guess) 1792 ;; Does guess and prompt step for find-file-at-point. 1793 ;; Extra complication for the temporary highlighting. 1794 (unwind-protect 1795 (ffap-read-file-or-url 1796 (if ffap-url-regexp "Dired file or URL: " "Dired file: ") 1797 (prog1 1798 (setq guess (or guess 1799 (let ((guess (ffap-guesser))) 1800 (if (or (not guess) 1801 (ffap-url-p guess) 1802 (ffap-file-remote-p guess)) 1803 guess 1804 (setq guess (abbreviate-file-name 1805 (expand-file-name guess))) 1806 (cond 1807 ;; Interpret local directory as a directory. 1808 ((file-directory-p guess) 1809 (file-name-as-directory guess)) 1810 ;; Get directory component from local files. 1811 ((file-regular-p guess) 1812 (file-name-directory guess)) 1813 (guess)))) 1814 )) 1815 (and guess (ffap-highlight)))) 1816 (ffap-highlight t))) 1817 1818;;; ffap-dired-other-*, ffap-list-directory commands: 1819 1820(defun ffap-dired-other-window () 1821 "Like `dired-at-point', but put buffer in another window. 1822Only intended for interactive use." 1823 (interactive) 1824 (let (value) 1825 (switch-to-buffer-other-window 1826 (save-window-excursion 1827 (setq value (call-interactively 'dired-at-point)) 1828 (current-buffer))) 1829 value)) 1830 1831(defun ffap-dired-other-frame () 1832 "Like `dired-at-point', but put buffer in another frame. 1833Only intended for interactive use." 1834 (interactive) 1835 ;; Extra code works around dedicated windows (noted by JENS, 7/96): 1836 (let* ((win (selected-window)) 1837 (wdp (window-dedicated-p win)) 1838 value) 1839 (unwind-protect 1840 (progn 1841 (set-window-dedicated-p win nil) 1842 (switch-to-buffer-other-frame 1843 (save-window-excursion 1844 (setq value (call-interactively 'dired-at-point)) 1845 (current-buffer)))) 1846 (set-window-dedicated-p win wdp)) 1847 value)) 1848 1849(defun ffap-list-directory () 1850 "Like `dired-at-point' and `list-directory'. 1851Only intended for interactive use." 1852 (interactive) 1853 (let ((ffap-directory-finder 'list-directory)) 1854 (call-interactively 'dired-at-point))) 1855 1856 1857;;; Offer default global bindings (`ffap-bindings'): 1858 1859(defvar ffap-bindings 1860 '( 1861 (global-set-key [S-mouse-3] 'ffap-at-mouse) 1862 (global-set-key [C-S-mouse-3] 'ffap-menu) 1863 1864 (global-set-key "\C-x\C-f" 'find-file-at-point) 1865 (global-set-key "\C-x\C-r" 'ffap-read-only) 1866 (global-set-key "\C-x\C-v" 'ffap-alternate-file) 1867 1868 (global-set-key "\C-x4f" 'ffap-other-window) 1869 (global-set-key "\C-x5f" 'ffap-other-frame) 1870 (global-set-key "\C-x4r" 'ffap-read-only-other-window) 1871 (global-set-key "\C-x5r" 'ffap-read-only-other-frame) 1872 1873 (global-set-key "\C-xd" 'dired-at-point) 1874 (global-set-key "\C-x4d" 'ffap-dired-other-window) 1875 (global-set-key "\C-x5d" 'ffap-dired-other-frame) 1876 (global-set-key "\C-x\C-d" 'ffap-list-directory) 1877 1878 (add-hook 'gnus-summary-mode-hook 'ffap-gnus-hook) 1879 (add-hook 'gnus-article-mode-hook 'ffap-gnus-hook) 1880 (add-hook 'vm-mode-hook 'ffap-ro-mode-hook) 1881 (add-hook 'rmail-mode-hook 'ffap-ro-mode-hook) 1882 ;; (setq dired-x-hands-off-my-keys t) ; the default 1883 ) 1884 "List of binding forms evaluated by function `ffap-bindings'. 1885A reasonable ffap installation needs just this one line: 1886 (ffap-bindings) 1887Of course if you do not like these bindings, just roll your own!") 1888 1889;;;###autoload 1890(defun ffap-bindings nil 1891 "Evaluate the forms in variable `ffap-bindings'." 1892 (interactive) 1893 (eval (cons 'progn ffap-bindings))) 1894 1895 1896 1897;;; arch-tag: 9dd3e88a-5dec-4607-bd57-60ae9ede8ebc 1898;;; ffap.el ends here 1899