Mercurial > emacs

comparison lisp/thingatpt.el @ 20982:3a01b0f0338f

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
(thing-at-point-url-at-point): Intuit ftp:// on `short' URLs.
author Dave Love <fx@gnu.org>
date Wed, 25 Feb 1998 23:16:42 +0000
parents 28f77aef27b2
children 615a6a17e7d6
comparison
equal deleted inserted replaced
20981:0ce30e7ba2b8 20982:3a01b0f0338f
1 ;;; thingatpt.el --- Get the `thing' at point 1 ;;; thingatpt.el --- Get the `thing' at point
2 2
3 ;; Copyright (C) 1991,92,93,94,95,96,1997 Free Software Foundation, Inc. 3 ;; Copyright (C) 1991,92,93,94,95,96,97,1998 Free Software Foundation, Inc.
4 4
5 ;; Author: Mike Williams <mikew@gopher.dosli.govt.nz> 5 ;; Author: Mike Williams <mikew@gopher.dosli.govt.nz>
6 ;; Keywords: extensions, matching, mouse 6 ;; Keywords: extensions, matching, mouse
7 ;; Created: Thu Mar 28 13:48:23 1991 7 ;; Created: Thu Mar 28 13:48:23 1991
8 8
239 (cons beginning end))))) 239 (cons beginning end)))))
240 240
241 (put 'url 'thing-at-point 'thing-at-point-url-at-point) 241 (put 'url 'thing-at-point 'thing-at-point-url-at-point)
242 (defun thing-at-point-url-at-point () 242 (defun thing-at-point-url-at-point ()
243 "Return the URL around or before point. 243 "Return the URL around or before point.
244 Search backwards for the start of a URL ending at or after 244
245 point. If no URL found, return nil. The access scheme, `http://' 245 Search backwards for the start of a URL ending at or after point. If
246 will be prepended if absent." 246 no URL found, return nil. The access scheme will be prepended if
247 absent: \"mailto:\" if the string contains \"@\", \"ftp://\" if it
248 starts with \"ftp\" and not \"ftp:/\", or \"http://\" by default."
249
247 (let ((url "") short strip) 250 (let ((url "") short strip)
248 (if (or (setq strip (thing-at-point-looking-at 251 (if (or (setq strip (thing-at-point-looking-at
249 thing-at-point-markedup-url-regexp)) 252 thing-at-point-markedup-url-regexp))
250 (thing-at-point-looking-at thing-at-point-url-regexp) 253 (thing-at-point-looking-at thing-at-point-url-regexp)
251 ;; Access scheme omitted? 254 ;; Access scheme omitted?
256 (match-end 0))) 259 (match-end 0)))
257 (and strip (setq url (substring url 5 -1))) ; Drop "<URL:" & ">" 260 (and strip (setq url (substring url 5 -1))) ; Drop "<URL:" & ">"
258 ;; strip whitespace 261 ;; strip whitespace
259 (while (string-match "\\s +\\|\n+" url) 262 (while (string-match "\\s +\\|\n+" url)
260 (setq url (replace-match "" t t url))) 263 (setq url (replace-match "" t t url)))
261 (and short (setq url (concat (if (string-match "@" url) 264 (and short (setq url (concat (cond ((string-match "@" url)
262 "mailto:" "http://") url))) 265 "mailto:")
266 ;; e.g. ftp.swiss... or ftp-swiss...
267 ((string-match "^ftp" url)
268 "ftp://")
269 (t "http://"))
270 url)))
263 (if (string-equal "" url) 271 (if (string-equal "" url)
264 nil 272 nil
265 url))))) 273 url)))))
266 274
267 ;; The normal thingatpt mechanism doesn't work for complex regexps. 275 ;; The normal thingatpt mechanism doesn't work for complex regexps.