annotate lisp/url/url-misc.el @ 88222:f1ded67120e9

(rmail-process-new-messages): Use rmail-header-get-header instead of mail-fetch-field.
author Henrik Enberg <henrik.enberg@telia.com>
date Thu, 19 Jan 2006 11:52:33 +0000
parents d7ddb3e565de
children
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
88155
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
1 ;;; url-misc.el --- Misc Uniform Resource Locator retrieval code
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
2
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
3 ;; Copyright (C) 1996, 1997, 1998, 1999, 2002, 2004,
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
4 ;; 2005 Free Software Foundation, Inc.
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
5
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
6 ;; Keywords: comm, data, processes
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
7
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
8 ;; This file is part of GNU Emacs.
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
9
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
10 ;; GNU Emacs is free software; you can redistribute it and/or modify
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
11 ;; it under the terms of the GNU General Public License as published by
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
12 ;; the Free Software Foundation; either version 2, or (at your option)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
13 ;; any later version.
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
14
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
15 ;; GNU Emacs is distributed in the hope that it will be useful,
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
16 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
17 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
18 ;; GNU General Public License for more details.
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
19
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
20 ;; You should have received a copy of the GNU General Public License
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
21 ;; along with GNU Emacs; see the file COPYING. If not, write to the
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
22 ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
23 ;; Boston, MA 02110-1301, USA.
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
24
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
25 ;;; Code:
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
26
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
27 (eval-when-compile (require 'cl))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
28 (require 'url-vars)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
29 (require 'url-parse)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
30 (autoload 'Info-goto-node "info" "" t)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
31 (autoload 'man "man" nil t)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
32
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
33 ;;;###autoload
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
34 (defun url-man (url)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
35 "Fetch a Unix manual page URL."
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
36 (man (url-filename url))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
37 nil)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
38
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
39 ;;;###autoload
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
40 (defun url-info (url)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
41 "Fetch a GNU Info URL."
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
42 ;; Fetch an info node
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
43 (let* ((fname (url-filename url))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
44 (node (url-unhex-string (or (url-target url) "Top"))))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
45 (if (and fname node)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
46 (Info-goto-node (concat "(" fname ")" node))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
47 (error "Malformed url: %s" (url-recreate-url url)))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
48 nil))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
49
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
50 (defun url-do-terminal-emulator (type server port user)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
51 (terminal-emulator
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
52 (generate-new-buffer (format "%s%s" (if user (concat user "@") "") server))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
53 (case type
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
54 (rlogin "rlogin")
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
55 (telnet "telnet")
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
56 (tn3270 "tn3270")
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
57 (otherwise
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
58 (error "Unknown terminal emulator required: %s" type)))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
59 (case type
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
60 (rlogin
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
61 (if user
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
62 (list server "-l" user)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
63 (list server)))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
64 (telnet
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
65 (if user (message "Please log in as user: %s" user))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
66 (if port
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
67 (list server port)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
68 (list server)))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
69 (tn3270
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
70 (if user (message "Please log in as user: %s" user))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
71 (list server)))))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
72
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
73 ;;;###autoload
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
74 (defun url-generic-emulator-loader (url)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
75 (let* ((type (intern (downcase (url-type url))))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
76 (server (url-host url))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
77 (name (url-user url))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
78 (port (url-port url)))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
79 (url-do-terminal-emulator type server port name))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
80 nil)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
81
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
82 ;;;###autoload
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
83 (defalias 'url-rlogin 'url-generic-emulator-loader)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
84 ;;;###autoload
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
85 (defalias 'url-telnet 'url-generic-emulator-loader)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
86 ;;;###autoload
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
87 (defalias 'url-tn3270 'url-generic-emulator-loader)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
88
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
89 ;; RFC 2397
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
90 ;;;###autoload
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
91 (defun url-data (url)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
92 "Fetch a data URL (RFC 2397)."
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
93 (let ((mediatype nil)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
94 ;; The mediatype may need to be hex-encoded too -- see the RFC.
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
95 (desc (url-unhex-string (url-filename url)))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
96 (encoding "8bit")
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
97 (data nil))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
98 (save-excursion
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
99 (if (not (string-match "\\([^,]*\\)?," desc))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
100 (error "Malformed data URL: %s" desc)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
101 (setq mediatype (match-string 1 desc))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
102 (if (and mediatype (string-match ";base64\\'" mediatype))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
103 (setq mediatype (substring mediatype 0 (match-beginning 0))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
104 encoding "base64"))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
105 (if (or (null mediatype)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
106 (eq ?\; (aref mediatype 0)))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
107 (setq mediatype (concat "text/plain" mediatype)))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
108 (setq data (url-unhex-string (substring desc (match-end 0)))))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
109 (set-buffer (generate-new-buffer " *url-data*"))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
110 (mm-disable-multibyte)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
111 (insert (format "Content-Length: %d\n" (length data))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
112 "Content-Type: " mediatype "\n"
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
113 "Content-Encoding: " encoding "\n"
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
114 "\n")
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
115 (if data (insert data))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
116 (current-buffer))))
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
117
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
118 (provide 'url-misc)
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
119
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
120 ;;; arch-tag: 8c544e1b-d8bc-40a6-b319-f1f37fef65a0
d7ddb3e565de sync with trunk
Henrik Enberg <henrik.enberg@telia.com>
parents:
diff changeset
121 ;;; url-misc.el ends here