ffap.el 72 KB

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