From: Richard M. Stallman <rms@gnu.org>
Date: Tue, 21 Nov 2006 01:38:04 +0000 (+0000)
Subject: (thing-at-point-url-at-point):  Don't add a redundant scheme.
X-Git-Tag: emacs-pretest-22.0.92~578
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=4f5d46685d2a8ec44b9a3bba09c096735a86d3b5;p=emacs.git

(thing-at-point-url-at-point):  Don't add a redundant scheme.

(thing-at-point-uri-schemes): Added schemes that
are new to the list at IANA.  Also added irc, mms, mmsh.
---

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index fc028549c75..6c6f513998b 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,13 @@
+2006-11-20  Bob Rogers  <rogers-emacs@rgrjr.dyndns.org>  (tiny change)
+
+	* thingatpt.el (thing-at-point-url-at-point):  Don't add a
+	redundant scheme.
+
+2006-11-20  Diane Murray  <disumu@x3y2z1.net>  (tiny change)
+
+	* thingatpt.el (thing-at-point-uri-schemes): Added schemes that
+	are new to the list at IANA.  Also added irc, mms, mmsh.
+
 2006-11-20  J.D. Smith  <jdsmith@as.arizona.edu>
 
 	* progmodes/idlw-help.el (idlwave-html-help-location): Fail
diff --git a/lisp/thingatpt.el b/lisp/thingatpt.el
index e2618bca8fd..ee58fffce34 100644
--- a/lisp/thingatpt.el
+++ b/lisp/thingatpt.el
@@ -214,15 +214,18 @@ Hostname matching is stricter in this case than for
 ``thing-at-point-url-regexp''.")
 
 (defvar thing-at-point-uri-schemes
-  ;; Officials from http://www.iana.org/assignments/uri-schemes
+  ;; Officials from http://www.iana.org/assignments/uri-schemes.html
   '("ftp://" "http://" "gopher://" "mailto:" "news:" "nntp:"
     "telnet://" "wais://" "file:/" "prospero:" "z39.50s:" "z39.50r:"
     "cid:" "mid:" "vemmi:" "service:" "imap:" "nfs:" "acap:" "rtsp:"
     "tip:" "pop:" "data:" "dav:" "opaquelocktoken:" "sip:" "tel:" "fax:"
     "modem:" "ldap:" "https://" "soap.beep:" "soap.beeps:" "urn:" "go:"
     "afs:" "tn3270:" "mailserver:"
+    "crid:" "dict:" "dns:" "dtn:" "h323:" "im:" "info:" "ipp:"
+    "iris.beep:" "mtqp:" "mupdate:" "pres:" "sips:" "snmp:" "tag:"
+    "tftp:" "xmlrpc.beep:" "xmlrpc.beeps:" "xmpp:"
   ;; Compatibility
-    "snews:")
+    "snews:" "irc:" "mms://" "mmsh://")
   "Uniform Resource Identifier (URI) Schemes.")
 
 (defvar thing-at-point-url-regexp
@@ -275,7 +278,10 @@ starts with \"ftp\" and not \"ftp:/\", or \"http://\" by default."
 	  ;; strip whitespace
 	  (while (string-match "[ \t\n\r]+" url)
 	    (setq url (replace-match "" t t url)))
-	  (and short (setq url (concat (cond ((string-match "@" url)
+	  (and short (setq url (concat (cond ((string-match "^[a-zA-Z]+:" url)
+					       ;; already has a URL scheme.
+					       "")
+					     ((string-match "@" url)
                                               "mailto:")
 					     ;; e.g. ftp.swiss... or ftp-swiss...
                                              ((string-match "^ftp" url)