annotate lisp/url/url-util.el @ 70152:c7be5461ce3b

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