annotate lisp/url/url-util.el @ 59917:81a7887c8c82

*** empty log message ***
author Jay Belanger <jay.p.belanger@gmail.com>
date Fri, 04 Feb 2005 06:38:34 +0000
parents 6052b6df37c1
children e30c08177a3b 0fc4928cc48e
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
54695
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
1 ;;; url-util.el --- Miscellaneous helper routines for URL library
54935
efddc239393d (url-debug): Use with-current-buffer.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 54803
diff changeset
2
57427
01934125951e Fix copyright notice.
Lars Hansen <larsh@soem.dk>
parents: 54935
diff changeset
3 ;; Copyright (c) 1996,1997,1998,1999,2001,2004 Free Software Foundation, Inc.
54935
efddc239393d (url-debug): Use with-current-buffer.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 54803
diff changeset
4
54695
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
5 ;; Author: Bill Perry <wmperry@gnu.org>
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
6 ;; Keywords: comm, data, processes
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
7
54935
efddc239393d (url-debug): Use with-current-buffer.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 54803
diff changeset
8 ;; This file is part of GNU Emacs.
efddc239393d (url-debug): Use with-current-buffer.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 54803
diff changeset
9 ;;
efddc239393d (url-debug): Use with-current-buffer.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 54803
diff changeset
10 ;; GNU Emacs is free software; you can redistribute it and/or modify
efddc239393d (url-debug): Use with-current-buffer.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 54803
diff changeset
11 ;; it under the terms of the GNU General Public License as published by
efddc239393d (url-debug): Use with-current-buffer.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 54803
diff changeset
12 ;; the Free Software Foundation; either version 2, or (at your option)
efddc239393d (url-debug): Use with-current-buffer.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 54803
diff changeset
13 ;; any later version.
efddc239393d (url-debug): Use with-current-buffer.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 54803
diff changeset
14 ;;
efddc239393d (url-debug): Use with-current-buffer.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 54803
diff changeset
15 ;; GNU Emacs is distributed in the hope that it will be useful,
efddc239393d (url-debug): Use with-current-buffer.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 54803
diff changeset
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
efddc239393d (url-debug): Use with-current-buffer.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 54803
diff changeset
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
efddc239393d (url-debug): Use with-current-buffer.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 54803
diff changeset
18 ;; GNU General Public License for more details.
efddc239393d (url-debug): Use with-current-buffer.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 54803
diff changeset
19 ;;
efddc239393d (url-debug): Use with-current-buffer.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 54803
diff changeset
20 ;; You should have received a copy of the GNU General Public License
efddc239393d (url-debug): Use with-current-buffer.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 54803
diff changeset
21 ;; along with GNU Emacs; see the file COPYING. If not, write to the
efddc239393d (url-debug): Use with-current-buffer.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 54803
diff changeset
22 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
efddc239393d (url-debug): Use with-current-buffer.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 54803
diff changeset
23 ;; Boston, MA 02111-1307, USA.
efddc239393d (url-debug): Use with-current-buffer.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 54803
diff changeset
24
efddc239393d (url-debug): Use with-current-buffer.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 54803
diff changeset
25 ;;; Commentary:
efddc239393d (url-debug): Use with-current-buffer.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 54803
diff changeset
26
efddc239393d (url-debug): Use with-current-buffer.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 54803
diff changeset
27 ;;; Code:
54695
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
28
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
29 (require 'url-parse)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
30 (autoload 'timezone-parse-date "timezone")
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
31 (autoload 'timezone-make-date-arpa-standard "timezone")
54803
a78c94aa182d (url-hexify-string): Don't give multibyte error for char <16.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 54770
diff changeset
32 (autoload 'mail-header-extract "mailheader")
54695
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
33
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
34 (defvar url-parse-args-syntax-table
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
35 (copy-syntax-table emacs-lisp-mode-syntax-table)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
36 "A syntax table for parsing sgml attributes.")
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
37
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
38 (modify-syntax-entry ?' "\"" url-parse-args-syntax-table)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
39 (modify-syntax-entry ?` "\"" url-parse-args-syntax-table)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
40 (modify-syntax-entry ?{ "(" url-parse-args-syntax-table)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
41 (modify-syntax-entry ?} ")" url-parse-args-syntax-table)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
42
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
43 ;;;###autoload
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
44 (defcustom url-debug nil
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
45 "*What types of debug messages from the URL library to show.
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
46 Debug messages are logged to the *URL-DEBUG* buffer.
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
47
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
48 If t, all messages will be logged.
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
49 If a number, all messages will be logged, as well shown via `message'.
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
50 If a list, it is a list of the types of messages to be logged."
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
51 :type '(choice (const :tag "none" nil)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
52 (const :tag "all" t)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
53 (checklist :tag "custom"
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
54 (const :tag "HTTP" :value http)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
55 (const :tag "DAV" :value dav)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
56 (const :tag "General" :value retrieval)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
57 (const :tag "Filename handlers" :value handlers)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
58 (symbol :tag "Other")))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
59 :group 'url-hairy)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
60
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
61 ;;;###autoload
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
62 (defun url-debug (tag &rest args)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
63 (if quit-flag
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
64 (error "Interrupted!"))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
65 (if (or (eq url-debug t)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
66 (numberp url-debug)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
67 (and (listp url-debug) (memq tag url-debug)))
54935
efddc239393d (url-debug): Use with-current-buffer.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 54803
diff changeset
68 (with-current-buffer (get-buffer-create "*URL-DEBUG*")
54695
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
69 (goto-char (point-max))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
70 (insert (symbol-name tag) " -> " (apply 'format args) "\n")
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
71 (if (numberp url-debug)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
72 (apply 'message args)))))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
73
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
74 ;;;###autoload
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
75 (defun url-parse-args (str &optional nodowncase)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
76 ;; Return an assoc list of attribute/value pairs from an RFC822-type string
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
77 (let (
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
78 name ; From name=
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
79 value ; its value
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
80 results ; Assoc list of results
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
81 name-pos ; Start of XXXX= position
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
82 val-pos ; Start of value position
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
83 st
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
84 nd
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
85 )
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
86 (save-excursion
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
87 (save-restriction
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
88 (set-buffer (get-buffer-create " *urlparse-temp*"))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
89 (set-syntax-table url-parse-args-syntax-table)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
90 (erase-buffer)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
91 (insert str)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
92 (setq st (point-min)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
93 nd (point-max))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
94 (set-syntax-table url-parse-args-syntax-table)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
95 (narrow-to-region st nd)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
96 (goto-char (point-min))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
97 (while (not (eobp))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
98 (skip-chars-forward "; \n\t")
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
99 (setq name-pos (point))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
100 (skip-chars-forward "^ \n\t=;")
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
101 (if (not nodowncase)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
102 (downcase-region name-pos (point)))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
103 (setq name (buffer-substring name-pos (point)))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
104 (skip-chars-forward " \t\n")
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
105 (if (/= (or (char-after (point)) 0) ?=) ; There is no value
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
106 (setq value nil)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
107 (skip-chars-forward " \t\n=")
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
108 (setq val-pos (point)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
109 value
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
110 (cond
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
111 ((or (= (or (char-after val-pos) 0) ?\")
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
112 (= (or (char-after val-pos) 0) ?'))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
113 (buffer-substring (1+ val-pos)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
114 (condition-case ()
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
115 (prog2
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
116 (forward-sexp 1)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
117 (1- (point))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
118 (skip-chars-forward "\""))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
119 (error
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
120 (skip-chars-forward "^ \t\n")
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
121 (point)))))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
122 (t
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
123 (buffer-substring val-pos
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
124 (progn
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
125 (skip-chars-forward "^;")
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
126 (skip-chars-backward " \t")
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
127 (point)))))))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
128 (setq results (cons (cons name value) results))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
129 (skip-chars-forward "; \n\t"))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
130 results))))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
131
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
132 ;;;###autoload
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
133 (defun url-insert-entities-in-string (string)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
134 "Convert HTML markup-start characters to entity references in STRING.
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
135 Also replaces the \" character, so that the result may be safely used as
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
136 an attribute value in a tag. Returns a new string with the result of the
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
137 conversion. Replaces these characters as follows:
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
138 & ==> &amp;
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
139 < ==> &lt;
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
140 > ==> &gt;
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
141 \" ==> &quot;"
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
142 (if (string-match "[&<>\"]" string)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
143 (save-excursion
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
144 (set-buffer (get-buffer-create " *entity*"))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
145 (erase-buffer)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
146 (buffer-disable-undo (current-buffer))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
147 (insert string)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
148 (goto-char (point-min))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
149 (while (progn
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
150 (skip-chars-forward "^&<>\"")
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
151 (not (eobp)))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
152 (insert (cdr (assq (char-after (point))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
153 '((?\" . "&quot;")
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
154 (?& . "&amp;")
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
155 (?< . "&lt;")
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
156 (?> . "&gt;")))))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
157 (delete-char 1))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
158 (buffer-string))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
159 string))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
160
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
161 ;;;###autoload
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
162 (defun url-normalize-url (url)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
163 "Return a 'normalized' version of URL.
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
164 Strips out default port numbers, etc."
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
165 (let (type data grok retval)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
166 (setq data (url-generic-parse-url url)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
167 type (url-type data))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
168 (if (member type '("www" "about" "mailto" "info"))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
169 (setq retval url)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
170 (url-set-target data nil)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
171 (setq retval (url-recreate-url data)))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
172 retval))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
173
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
174 ;;;###autoload
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
175 (defun url-lazy-message (&rest args)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
176 "Just like `message', but is a no-op if called more than once a second.
54935
efddc239393d (url-debug): Use with-current-buffer.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 54803
diff changeset
177 Will not do anything if `url-show-status' is nil."
54695
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
178 (if (or (null url-show-status)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
179 (active-minibuffer-window)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
180 (= url-lazy-message-time
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
181 (setq url-lazy-message-time (nth 1 (current-time)))))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
182 nil
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
183 (apply 'message args)))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
184
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
185 ;;;###autoload
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
186 (defun url-get-normalized-date (&optional specified-time)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
187 "Return a 'real' date string that most HTTP servers can understand."
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
188 (require 'timezone)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
189 (let* ((raw (if specified-time (current-time-string specified-time)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
190 (current-time-string)))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
191 (gmt (timezone-make-date-arpa-standard raw
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
192 (nth 1 (current-time-zone))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
193 "GMT"))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
194 (parsed (timezone-parse-date gmt))
57513
6052b6df37c1 (url-get-normalized-date): Use url-weekday-alist and url-monthabbrev-alist.
Richard M. Stallman <rms@gnu.org>
parents: 57427
diff changeset
195 (day (cdr-safe (assoc (substring raw 0 3) url-weekday-alist)))
54695
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
196 (year nil)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
197 (month (car
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
198 (rassoc
57513
6052b6df37c1 (url-get-normalized-date): Use url-weekday-alist and url-monthabbrev-alist.
Richard M. Stallman <rms@gnu.org>
parents: 57427
diff changeset
199 (string-to-int (aref parsed 1)) url-monthabbrev-alist)))
54695
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
200 )
57513
6052b6df37c1 (url-get-normalized-date): Use url-weekday-alist and url-monthabbrev-alist.
Richard M. Stallman <rms@gnu.org>
parents: 57427
diff changeset
201 (setq day (or (car-safe (rassoc day url-weekday-alist))
54695
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
202 (substring raw 0 3))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
203 year (aref parsed 0))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
204 ;; This is needed for plexus servers, or the server will hang trying to
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
205 ;; parse the if-modified-since header. Hopefully, I can take this out
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
206 ;; soon.
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
207 (if (and year (> (length year) 2))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
208 (setq year (substring year -2 nil)))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
209
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
210 (concat day ", " (aref parsed 2) "-" month "-" year " "
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
211 (aref parsed 3) " " (or (aref parsed 4)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
212 (concat "[" (nth 1 (current-time-zone))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
213 "]")))))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
214
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
215 ;;;###autoload
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
216 (defun url-eat-trailing-space (x)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
217 "Remove spaces/tabs at the end of a string."
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
218 (let ((y (1- (length x)))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
219 (skip-chars (list ? ?\t ?\n)))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
220 (while (and (>= y 0) (memq (aref x y) skip-chars))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
221 (setq y (1- y)))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
222 (substring x 0 (1+ y))))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
223
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
224 ;;;###autoload
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
225 (defun url-strip-leading-spaces (x)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
226 "Remove spaces at the front of a string."
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
227 (let ((y (1- (length x)))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
228 (z 0)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
229 (skip-chars (list ? ?\t ?\n)))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
230 (while (and (<= z y) (memq (aref x z) skip-chars))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
231 (setq z (1+ z)))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
232 (substring x z nil)))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
233
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
234 ;;;###autoload
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
235 (defun url-pretty-length (n)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
236 (cond
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
237 ((< n 1024)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
238 (format "%d bytes" n))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
239 ((< n (* 1024 1024))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
240 (format "%dk" (/ n 1024.0)))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
241 (t
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
242 (format "%2.2fM" (/ n (* 1024 1024.0))))))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
243
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
244 ;;;###autoload
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
245 (defun url-display-percentage (fmt perc &rest args)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
246 (if (null fmt)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
247 (if (fboundp 'clear-progress-display)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
248 (clear-progress-display))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
249 (if (and (fboundp 'progress-display) perc)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
250 (apply 'progress-display fmt perc args)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
251 (apply 'message fmt args))))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
252
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
253 ;;;###autoload
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
254 (defun url-percentage (x y)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
255 (if (fboundp 'float)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
256 (round (* 100 (/ x (float y))))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
257 (/ (* x 100) y)))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
258
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
259 ;;;###autoload
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
260 (defun url-basepath (file &optional x)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
261 "Return the base pathname of FILE, or the actual filename if X is true."
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
262 (cond
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
263 ((null file) "")
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
264 ((string-match (eval-when-compile (regexp-quote "?")) file)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
265 (if x
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
266 (file-name-nondirectory (substring file 0 (match-beginning 0)))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
267 (file-name-directory (substring file 0 (match-beginning 0)))))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
268 (x (file-name-nondirectory file))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
269 (t (file-name-directory file))))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
270
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
271 ;;;###autoload
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
272 (defun url-parse-query-string (query &optional downcase)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
273 (let (retval pairs cur key val)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
274 (setq pairs (split-string query "&"))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
275 (while pairs
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
276 (setq cur (car pairs)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
277 pairs (cdr pairs))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
278 (if (not (string-match "=" cur))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
279 nil ; Grace
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
280 (setq key (url-unhex-string (substring cur 0 (match-beginning 0)))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
281 val (url-unhex-string (substring cur (match-end 0) nil)))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
282 (if downcase
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
283 (setq key (downcase key)))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
284 (setq cur (assoc key retval))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
285 (if cur
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
286 (setcdr cur (cons val (cdr cur)))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
287 (setq retval (cons (list key val) retval)))))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
288 retval))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
289
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
290 (defun url-unhex (x)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
291 (if (> x ?9)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
292 (if (>= x ?a)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
293 (+ 10 (- x ?a))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
294 (+ 10 (- x ?A)))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
295 (- x ?0)))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
296
54803
a78c94aa182d (url-hexify-string): Don't give multibyte error for char <16.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 54770
diff changeset
297 ;; Fixme: Is this definition better, and does it ever matter?
a78c94aa182d (url-hexify-string): Don't give multibyte error for char <16.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 54770
diff changeset
298
a78c94aa182d (url-hexify-string): Don't give multibyte error for char <16.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 54770
diff changeset
299 ;; (defun url-unhex-string (str &optional allow-newlines)
a78c94aa182d (url-hexify-string): Don't give multibyte error for char <16.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 54770
diff changeset
300 ;; "Remove %XX, embedded spaces, etc in a url.
a78c94aa182d (url-hexify-string): Don't give multibyte error for char <16.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 54770
diff changeset
301 ;; If optional second argument ALLOW-NEWLINES is non-nil, then allow the
a78c94aa182d (url-hexify-string): Don't give multibyte error for char <16.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 54770
diff changeset
302 ;; decoding of carriage returns and line feeds in the string, which is normally
a78c94aa182d (url-hexify-string): Don't give multibyte error for char <16.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 54770
diff changeset
303 ;; forbidden in URL encoding."
a78c94aa182d (url-hexify-string): Don't give multibyte error for char <16.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 54770
diff changeset
304 ;; (setq str (or str ""))
a78c94aa182d (url-hexify-string): Don't give multibyte error for char <16.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 54770
diff changeset
305 ;; (setq str (replace-regexp-in-string "%[[:xdigit:]]\\{2\\}"
a78c94aa182d (url-hexify-string): Don't give multibyte error for char <16.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 54770
diff changeset
306 ;; (lambda (match)
a78c94aa182d (url-hexify-string): Don't give multibyte error for char <16.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 54770
diff changeset
307 ;; (string (string-to-number
a78c94aa182d (url-hexify-string): Don't give multibyte error for char <16.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 54770
diff changeset
308 ;; (substring match 1) 16)))
a78c94aa182d (url-hexify-string): Don't give multibyte error for char <16.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 54770
diff changeset
309 ;; str t t))
a78c94aa182d (url-hexify-string): Don't give multibyte error for char <16.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 54770
diff changeset
310 ;; (if allow-newlines
a78c94aa182d (url-hexify-string): Don't give multibyte error for char <16.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 54770
diff changeset
311 ;; (replace-regexp-in-string "[\n\r]" (lambda (match)
a78c94aa182d (url-hexify-string): Don't give multibyte error for char <16.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 54770
diff changeset
312 ;; (format "%%%.2X" (aref match 0)))
a78c94aa182d (url-hexify-string): Don't give multibyte error for char <16.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 54770
diff changeset
313 ;; str t t)
a78c94aa182d (url-hexify-string): Don't give multibyte error for char <16.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 54770
diff changeset
314 ;; str))
a78c94aa182d (url-hexify-string): Don't give multibyte error for char <16.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 54770
diff changeset
315
54695
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
316 ;;;###autoload
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
317 (defun url-unhex-string (str &optional allow-newlines)
54803
a78c94aa182d (url-hexify-string): Don't give multibyte error for char <16.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 54770
diff changeset
318 "Remove %XX embedded spaces, etc in a url.
54695
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
319 If optional second argument ALLOW-NEWLINES is non-nil, then allow the
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
320 decoding of carriage returns and line feeds in the string, which is normally
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
321 forbidden in URL encoding."
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
322 (setq str (or str ""))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
323 (let ((tmp "")
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
324 (case-fold-search t))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
325 (while (string-match "%[0-9a-f][0-9a-f]" str)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
326 (let* ((start (match-beginning 0))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
327 (ch1 (url-unhex (elt str (+ start 1))))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
328 (code (+ (* 16 ch1)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
329 (url-unhex (elt str (+ start 2))))))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
330 (setq tmp (concat
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
331 tmp (substring str 0 start)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
332 (cond
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
333 (allow-newlines
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
334 (char-to-string code))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
335 ((or (= code ?\n) (= code ?\r))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
336 " ")
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
337 (t (char-to-string code))))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
338 str (substring str (match-end 0)))))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
339 (setq tmp (concat tmp str))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
340 tmp))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
341
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
342 (defconst url-unreserved-chars
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
343 '(
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
344 ?a ?b ?c ?d ?e ?f ?g ?h ?i ?j ?k ?l ?m ?n ?o ?p ?q ?r ?s ?t ?u ?v ?w ?x ?y ?z
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
345 ?A ?B ?C ?D ?E ?F ?G ?H ?I ?J ?K ?L ?M ?N ?O ?P ?Q ?R ?S ?T ?U ?V ?W ?X ?Y ?Z
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
346 ?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
347 ?- ?_ ?. ?! ?~ ?* ?' ?\( ?\))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
348 "A list of characters that are _NOT_ reserved in the URL spec.
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
349 This is taken from RFC 2396.")
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
350
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
351 ;;;###autoload
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
352 (defun url-hexify-string (str)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
353 "Escape characters in a string."
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
354 (mapconcat
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
355 (lambda (char)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
356 ;; Fixme: use a char table instead.
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
357 (if (not (memq char url-unreserved-chars))
54803
a78c94aa182d (url-hexify-string): Don't give multibyte error for char <16.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 54770
diff changeset
358 (if (> char 255)
a78c94aa182d (url-hexify-string): Don't give multibyte error for char <16.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 54770
diff changeset
359 (error "Hexifying multibyte character %s" str)
a78c94aa182d (url-hexify-string): Don't give multibyte error for char <16.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 54770
diff changeset
360 (format "%%%02X" char))
54695
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
361 (char-to-string char)))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
362 str ""))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
363
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
364 ;;;###autoload
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
365 (defun url-file-extension (fname &optional x)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
366 "Return the filename extension of FNAME.
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
367 If optional variable X is t,
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
368 then return the basename of the file with the extension stripped off."
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
369 (if (and fname
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
370 (setq fname (url-basepath fname t))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
371 (string-match "\\.[^./]+$" fname))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
372 (if x (substring fname 0 (match-beginning 0))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
373 (substring fname (match-beginning 0) nil))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
374 ;;
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
375 ;; If fname has no extension, and x then return fname itself instead of
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
376 ;; nothing. When caching it allows the correct .hdr file to be produced
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
377 ;; for filenames without extension.
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
378 ;;
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
379 (if x
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
380 fname
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
381 "")))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
382
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
383 ;;;###autoload
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
384 (defun url-truncate-url-for-viewing (url &optional width)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
385 "Return a shortened version of URL that is WIDTH characters or less wide.
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
386 WIDTH defaults to the current frame width."
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
387 (let* ((fr-width (or width (frame-width)))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
388 (str-width (length url))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
389 (tail (file-name-nondirectory url))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
390 (fname nil)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
391 (modified 0)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
392 (urlobj nil))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
393 ;; The first thing that can go are the search strings
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
394 (if (and (>= str-width fr-width)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
395 (string-match "?" url))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
396 (setq url (concat (substring url 0 (match-beginning 0)) "?...")
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
397 str-width (length url)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
398 tail (file-name-nondirectory url)))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
399 (if (< str-width fr-width)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
400 nil ; Hey, we are done!
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
401 (setq urlobj (url-generic-parse-url url)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
402 fname (url-filename urlobj)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
403 fr-width (- fr-width 4))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
404 (while (and (>= str-width fr-width)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
405 (string-match "/" fname))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
406 (setq fname (substring fname (match-end 0) nil)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
407 modified (1+ modified))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
408 (url-set-filename urlobj fname)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
409 (setq url (url-recreate-url urlobj)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
410 str-width (length url)))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
411 (if (> modified 1)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
412 (setq fname (concat "/.../" fname))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
413 (setq fname (concat "/" fname)))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
414 (url-set-filename urlobj fname)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
415 (setq url (url-recreate-url urlobj)))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
416 url))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
417
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
418 ;;;###autoload
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
419 (defun url-view-url (&optional no-show)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
420 "View the current document's URL.
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
421 Optional argument NO-SHOW means just return the URL, don't show it in
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
422 the minibuffer.
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
423
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
424 This uses `url-current-object', set locally to the buffer."
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
425 (interactive)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
426 (if (not url-current-object)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
427 nil
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
428 (if no-show
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
429 (url-recreate-url url-current-object)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
430 (message "%s" (url-recreate-url url-current-object)))))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
431
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
432 (eval-and-compile
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
433 (defvar url-get-url-filename-chars "-%.?@a-zA-Z0-9()_/:~=&"
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
434 "Valid characters in a URL")
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
435 )
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
436
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
437 (defun url-get-url-at-point (&optional pt)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
438 "Get the URL closest to point, but don't change position.
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
439 Has a preference for looking backward when not directly on a symbol."
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
440 ;; Not at all perfect - point must be right in the name.
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
441 (save-excursion
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
442 (if pt (goto-char pt))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
443 (let (start url)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
444 (save-excursion
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
445 ;; first see if you're just past a filename
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
446 (if (not (eobp))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
447 (if (looking-at "[] \t\n[{}()]") ; whitespace or some parens
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
448 (progn
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
449 (skip-chars-backward " \n\t\r({[]})")
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
450 (if (not (bobp))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
451 (backward-char 1)))))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
452 (if (and (char-after (point))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
453 (string-match (eval-when-compile
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
454 (concat "[" url-get-url-filename-chars "]"))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
455 (char-to-string (char-after (point)))))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
456 (progn
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
457 (skip-chars-backward url-get-url-filename-chars)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
458 (setq start (point))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
459 (skip-chars-forward url-get-url-filename-chars))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
460 (setq start (point)))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
461 (setq url (buffer-substring-no-properties start (point))))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
462 (if (and url (string-match "^(.*)\\.?$" url))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
463 (setq url (match-string 1 url)))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
464 (if (and url (string-match "^URL:" url))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
465 (setq url (substring url 4 nil)))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
466 (if (and url (string-match "\\.$" url))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
467 (setq url (substring url 0 -1)))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
468 (if (and url (string-match "^www\\." url))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
469 (setq url (concat "http://" url)))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
470 (if (and url (not (string-match url-nonrelative-link url)))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
471 (setq url nil))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
472 url)))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
473
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
474 (defun url-generate-unique-filename (&optional fmt)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
475 "Generate a unique filename in `url-temporary-directory'."
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
476 (if (not fmt)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
477 (let ((base (format "url-tmp.%d" (user-real-uid)))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
478 (fname "")
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
479 (x 0))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
480 (setq fname (format "%s%d" base x))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
481 (while (file-exists-p
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
482 (expand-file-name fname url-temporary-directory))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
483 (setq x (1+ x)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
484 fname (concat base (int-to-string x))))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
485 (expand-file-name fname url-temporary-directory))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
486 (let ((base (concat "url" (int-to-string (user-real-uid))))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
487 (fname "")
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
488 (x 0))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
489 (setq fname (format fmt (concat base (int-to-string x))))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
490 (while (file-exists-p
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
491 (expand-file-name fname url-temporary-directory))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
492 (setq x (1+ x)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
493 fname (format fmt (concat base (int-to-string x)))))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
494 (expand-file-name fname url-temporary-directory))))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
495
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
496 (defun url-extract-mime-headers ()
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
497 "Set `url-current-mime-headers' in current buffer."
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
498 (save-excursion
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
499 (goto-char (point-min))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
500 (unless url-current-mime-headers
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
501 (set (make-local-variable 'url-current-mime-headers)
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
502 (mail-header-extract)))))
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
503
3fb37923e567 Initial revision
Stefan Monnier <monnier@iro.umontreal.ca>
parents:
diff changeset
504 (provide 'url-util)
54699
7784ae10206d Resolve CVS conflicts
Miles Bader <miles@gnu.org>
parents: 54695
diff changeset
505
54935
efddc239393d (url-debug): Use with-current-buffer.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 54803
diff changeset
506 ;; arch-tag: 24352abc-5a5a-412e-90cd-313b26bed5c9
efddc239393d (url-debug): Use with-current-buffer.
Stefan Monnier <monnier@iro.umontreal.ca>
parents: 54803
diff changeset
507 ;;; url-util.el ends here