diff options
| author | Dave Love <fx@gnu.org> | 1998-02-25 23:16:42 +0000 |
|---|---|---|
| committer | Dave Love <fx@gnu.org> | 1998-02-25 23:16:42 +0000 |
| commit | 340483df0d0ff3d04beac29684aa8949d9b995ea (patch) | |
| tree | 4ed31186d8b9805ee55e27d1461337b6e417d544 /lisp/thingatpt.el | |
| parent | bc69581bb2682a507919481f306653fdb9d107ec (diff) | |
| download | emacs-340483df0d0ff3d04beac29684aa8949d9b995ea.tar.gz | |
(thing-at-point-url-at-point): Intuit ftp:// on `short' URLs.
Diffstat (limited to 'lisp/thingatpt.el')
| -rw-r--r-- | lisp/thingatpt.el | 20 |
1 files changed, 14 insertions, 6 deletions
diff --git a/lisp/thingatpt.el b/lisp/thingatpt.el index 88a2807538b..0f3ff229f68 100644 --- a/lisp/thingatpt.el +++ b/lisp/thingatpt.el @@ -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))))) |