(url-generic-parse-url): Bind deactivate-mark.

2 files changed, 84 insertions, 78 deletions

diff --git a/lisp/url/ChangeLog b/lisp/url/ChangeLog
index 91cafbb8cce..0091ba1171a 100644
--- a/lisp/url/ChangeLog
+++ b/lisp/url/ChangeLog
@@ -1,3 +1,7 @@
+2009-11-27  Stefan Monnier  <monnier@iro.umontreal.ca>
+
+	* url-parse.el (url-generic-parse-url): Bind deactivate-mark.
+
 2009-11-08  Kai Tetzlaff  <kai.tetzlaff@web.de>  (tiny change)
 
 	* url-http.el (url-http-handle-authentication): Use proxy server,
diff --git a/lisp/url/url-parse.el b/lisp/url/url-parse.el
index 254a2167112..659329ab81e 100644
--- a/lisp/url/url-parse.el
+++ b/lisp/url/url-parse.el
@@ -91,86 +91,88 @@ TYPE USER PASSWORD HOST PORTSPEC FILENAME TARGET ATTRIBUTES FULLNESS."
     (url-parse-make-urlobj nil nil nil nil nil url))
    (t
     (with-temp-buffer
-      (set-syntax-table url-parse-syntax-table)
-      (let ((save-pos nil)
-	    (prot nil)
-	    (user nil)
-	    (pass nil)
-	    (host nil)
-	    (port nil)
-	    (file nil)
-	    (refs nil)
-	    (attr nil)
-	    (full nil)
-	    (inhibit-read-only t))
-	(erase-buffer)
-	(insert url)
-	(goto-char (point-min))
-	(setq save-pos (point))
-
-	;; 3.1. Scheme
-	(if (not (looking-at "//"))
-	    (progn
-	      (skip-chars-forward "a-zA-Z+.\\-")
-	      (downcase-region save-pos (point))
-	      (setq prot (buffer-substring save-pos (point)))
-	      (skip-chars-forward ":")
-	      (setq save-pos (point))))
-
-	;; 3.2. Authority
-	(if (looking-at "//")
-	    (progn
-	      (setq full t)
-	      (forward-char 2)
-	      (setq save-pos (point))
-	      (skip-chars-forward "^/")
-	      (setq host (buffer-substring save-pos (point)))
-	      (if (string-match "^\\([^@]+\\)@" host)
-		  (setq user (match-string 1 host)
-			host (substring host (match-end 0) nil)))
-	      (if (and user (string-match "\\([^:]+\\):\\(.*\\)" user))
-		  (setq pass (match-string 2 user)
-			user (match-string 1 user)))
-	      ;; This gives wrong results for IPv6 literal addresses.
-	      (if (string-match ":\\([0-9+]+\\)" host)
-		  (setq port (string-to-number (match-string 1 host))
-			host (substring host 0 (match-beginning 0))))
-	      (if (string-match ":$" host)
-		  (setq host (substring host 0 (match-beginning 0))))
-	      (setq host (downcase host)
-		    save-pos (point))))
-
-	(if (not port)
-	    (setq port (url-scheme-get-property prot 'default-port)))
-
-	;; 3.3. Path
-	;; Gross hack to preserve ';' in data URLs
-	(setq save-pos (point))
-
-	;; 3.4. Query
-	(if (string= "data" prot)
-	    (goto-char (point-max))
-	  ;; Now check for references
-	  (skip-chars-forward "^#")
-	  (if (eobp)
-	      nil
-	    (delete-region
-	     (point)
-	     (progn
-	       (skip-chars-forward "#")
-	       (setq refs (buffer-substring (point) (point-max)))
-	       (point-max))))
-	  (goto-char save-pos)
-	  (skip-chars-forward "^;")
-	  (if (not (eobp))
-	      (setq attr (url-parse-args (buffer-substring (point) (point-max)) t)
+      ;; Don't let those temp-buffer modifications accidentally
+      ;; deactivate the mark of the current-buffer.
+      (let ((deactivate-mark nil))
+        (set-syntax-table url-parse-syntax-table)
+        (let ((save-pos nil)
+              (prot nil)
+              (user nil)
+              (pass nil)
+              (host nil)
+              (port nil)
+              (file nil)
+              (refs nil)
+              (attr nil)
+              (full nil)
+              (inhibit-read-only t))
+          (erase-buffer)
+          (insert url)
+          (goto-char (point-min))
+          (setq save-pos (point))
+
+          ;; 3.1. Scheme
+          (unless (looking-at "//")
+            (skip-chars-forward "a-zA-Z+.\\-")
+            (downcase-region save-pos (point))
+            (setq prot (buffer-substring save-pos (point)))
+            (skip-chars-forward ":")
+            (setq save-pos (point)))
+
+          ;; 3.2. Authority
+          (when (looking-at "//")
+            (setq full t)
+            (forward-char 2)
+            (setq save-pos (point))
+            (skip-chars-forward "^/")
+            (setq host (buffer-substring save-pos (point)))
+            (if (string-match "^\\([^@]+\\)@" host)
+                (setq user (match-string 1 host)
+                      host (substring host (match-end 0) nil)))
+            (if (and user (string-match "\\([^:]+\\):\\(.*\\)" user))
+                (setq pass (match-string 2 user)
+                      user (match-string 1 user)))
+            ;; This gives wrong results for IPv6 literal addresses.
+            (if (string-match ":\\([0-9+]+\\)" host)
+                (setq port (string-to-number (match-string 1 host))
+                      host (substring host 0 (match-beginning 0))))
+            (if (string-match ":$" host)
+                (setq host (substring host 0 (match-beginning 0))))
+            (setq host (downcase host)
+                  save-pos (point)))
+
+          (if (not port)
+              (setq port (url-scheme-get-property prot 'default-port)))
+
+          ;; 3.3. Path
+          ;; Gross hack to preserve ';' in data URLs
+          (setq save-pos (point))
+
+          ;; 3.4. Query
+          (if (string= "data" prot)
+              (goto-char (point-max))
+            ;; Now check for references
+            (skip-chars-forward "^#")
+            (if (eobp)
+                nil
+              (delete-region
+               (point)
+               (progn
+                 (skip-chars-forward "#")
+                 (setq refs (buffer-substring (point) (point-max)))
+                 (point-max))))
+            (goto-char save-pos)
+            (skip-chars-forward "^;")
+            (unless (eobp)
+              (setq attr (url-parse-args (buffer-substring (point) (point-max))
+                                         t)
 		    attr (nreverse attr))))
 
-	(setq file (buffer-substring save-pos (point)))
-	(if (and host (string-match "%[0-9][0-9]" host))
-	    (setq host (url-unhex-string host)))
-	(url-parse-make-urlobj
-         prot user pass host port file refs attr full))))))
+          (setq file (buffer-substring save-pos (point)))
+          (if (and host (string-match "%[0-9][0-9]" host))
+              (setq host (url-unhex-string host)))
+          (url-parse-make-urlobj
+           prot user pass host port file refs attr full)))))))
 
 (provide 'url-parse)