mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2026-01-30 04:10:54 -08:00
Code Issues Projects Releases Wiki Activity

(thing-at-point-url-at-point): Intuit ftp:// on `short' URLs.

Browse source
This commit is contained in:
Dave Love 1998-02-25 23:16:42 +00:00
parent bc69581bb2
commit 340483df0d
1 changed files with 14 additions and 6 deletions
Download patch file Download diff file Expand all files Collapse all files

20
lisp/thingatpt.el
View file

@ -1,6 +1,6 @@
;;; thingatpt.el --- Get the `thing' at point
;; Copyright (C) 1991,92,93,94,95,96,1997 Free Software Foundation, Inc.
;; Copyright (C) 1991,92,93,94,95,96,97,1998 Free Software Foundation, Inc.
;; Author: Mike Williams <mikew@gopher.dosli.govt.nz>
;; Keywords: extensions, matching, mouse
@ -241,9 +241,12 @@ This may contain whitespace (including newlines) .")
(put 'url 'thing-at-point 'thing-at-point-url-at-point)
(defun thing-at-point-url-at-point ()
"Return the URL around or before point.
Search backwards for the start of a URL ending at or after
point. If no URL found, return nil. The access scheme, `http://'
will be prepended if absent."
Search backwards for the start of a URL ending at or after point. If
no URL found, return nil. The access scheme will be prepended if
absent: \"mailto:\" if the string contains \"@\", \"ftp://\" if it
starts with \"ftp\" and not \"ftp:/\", or \"http://\" by default."
(let ((url "") short strip)
(if (or (setq strip (thing-at-point-looking-at
thing-at-point-markedup-url-regexp))
@ -258,8 +261,13 @@ will be prepended if absent."
;; strip whitespace
(while (string-match "\\s +\\|\n+" url)
(setq url (replace-match "" t t url)))
(and short (setq url (concat (if (string-match "@" url)
"mailto:" "http://") url)))
(and short (setq url (concat (cond ((string-match "@" url)
"mailto:")
;; e.g. ftp.swiss... or ftp-swiss...
((string-match "^ftp" url)
"ftp://")
(t "http://"))
url)))
(if (string-equal "" url)
nil
url)))))