# HG changeset patch # User Dave Love # Date 888448602 0 # Node ID 3a01b0f0338f1c63a4ebacff30209e1e841b0775 # Parent 0ce30e7ba2b8ad2f6f1d7c6aaf7aee3505dc1ad8 (thing-at-point-url-at-point): Intuit ftp:// on `short' URLs. diff -r 0ce30e7ba2b8 -r 3a01b0f0338f lisp/thingatpt.el --- a/lisp/thingatpt.el Wed Feb 25 23:16:37 1998 +0000 +++ b/lisp/thingatpt.el Wed Feb 25 23:16:42 1998 +0000 @@ -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 ;; Keywords: extensions, matching, mouse @@ -241,9 +241,12 @@ (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 @@ ;; 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)))))