From c074ba4a567963720aefde4d38c447660d09e330 Mon Sep 17 00:00:00 2001 From: Stefan Monnier Date: Fri, 27 Nov 2009 01:27:04 +0000 Subject: [PATCH] (url-generic-parse-url): Bind deactivate-mark. --- lisp/url/ChangeLog | 4 ++ lisp/url/url-parse.el | 158 +++++++++++++++++++++--------------------- 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 + + * url-parse.el (url-generic-parse-url): Bind deactivate-mark. + 2009-11-08 Kai Tetzlaff (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) -- 2.39.5