]> code.delx.au - gnu-emacs/blob - share/emacs/site-lisp/w3m/w3m.el
10-09-13
[gnu-emacs] / share / emacs / site-lisp / w3m / w3m.el
1 ;;; w3m.el --- an Emacs interface to w3m -*- coding: iso-2022-7bit; -*-
2
3 ;; Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009,
4 ;; 2010 TSUCHIYA Masatoshi <tsuchiya@namazu.org>
5
6 ;; Authors: TSUCHIYA Masatoshi <tsuchiya@namazu.org>,
7 ;; Shun-ichi GOTO <gotoh@taiyo.co.jp>,
8 ;; Satoru Takabayashi <satoru-t@is.aist-nara.ac.jp>,
9 ;; Hideyuki SHIRAI <shirai@meadowy.org>,
10 ;; Keisuke Nishida <kxn30@po.cwru.edu>,
11 ;; Yuuichi Teranishi <teranisi@gohome.org>,
12 ;; Akihiro Arisawa <ari@mbf.sphere.ne.jp>,
13 ;; Katsumi Yamaoka <yamaoka@jpl.org>,
14 ;; Tsuyoshi CHO <tsuyoshi_cho@ybb.ne.jp>
15 ;; Keywords: w3m, WWW, hypermedia
16
17 ;; This file is the main part of emacs-w3m.
18
19 ;; This program is free software; you can redistribute it and/or modify
20 ;; it under the terms of the GNU General Public License as published by
21 ;; the Free Software Foundation; either version 2, or (at your option)
22 ;; any later version.
23
24 ;; This program is distributed in the hope that it will be useful,
25 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
26 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
27 ;; GNU General Public License for more details.
28
29 ;; You should have received a copy of the GNU General Public License
30 ;; along with this program; see the file COPYING. If not, write to
31 ;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
32 ;; Boston, MA 02110-1301, USA.
33
34
35 ;;; Commentary:
36
37 ;; Emacs-w3m is an Emacs interface to the w3m program. For more
38 ;; detail about w3m, see:
39 ;;
40 ;; http://w3m.sourceforge.net/
41
42
43 ;;; How to install:
44
45 ;; See the README file in any case. We also recommend you check
46 ;; whether a newer version of w3m is released.
47 ;;
48 ;; The outline of installation is: run the `configure' script and type
49 ;; `make install' in the top directory of the emacs-w3m distribution.
50
51
52 ;;; Code:
53
54 ;; Developers, you must not use the cl functions (e.g., `coerce',
55 ;; `equalp', `merge', etc.) in any emacs-w3m or shimbun modules. To
56 ;; exclude run-time cl is the policy of emacs-w3m. However, XEmacs
57 ;; employs the cl package for all time, or those functions are
58 ;; possibly provided in the other modules like APEL, so you may use
59 ;; them only in w3m-xmas.el. Note that `caaaar', for example, is not
60 ;; a cl function if it is byte compiled; see cl-macs.el.
61 (eval-when-compile
62 (require 'cl))
63
64 (eval-when-compile
65 (unless (dolist (var nil t))
66 ;; Override the `dolist' macro which may be faultily provided by
67 ;; old egg.el.
68 (load "cl-macs" nil t)))
69
70 ;; The following variables will be referred to by the external modules
71 ;; which bind such variables only when compiling themselves. And also
72 ;; some modules have the `defadvice' forms including them and run
73 ;; `byte-compile' at run-time.
74 (eval-and-compile
75 (defvar w3m-current-title nil
76 "Title of a page visiting in the current buffer.")
77 (defvar w3m-current-url nil
78 "A url of a page visiting in the current buffer."))
79
80 (require 'w3m-util)
81 (require 'w3m-proc)
82
83 ;; Silence the Emacs' byte-compiler that says ``might not be defined''.
84 (eval-when-compile
85 (defalias 'w3m-setup-menu 'ignore))
86
87 (eval-and-compile
88 (cond
89 ((featurep 'xemacs)
90 (require 'w3m-xmas))
91 ((>= emacs-major-version 21)
92 (require 'w3m-ems))
93 (t
94 (error "Emacs-w3m of this version no longer supports Emacs %s"
95 (mapconcat 'identity
96 (nbutlast (split-string emacs-version "\\."))
97 ".")))))
98
99 (require 'w3m-fb)
100 (require 'w3m-hist)
101 (require 'timezone)
102 (require 'image-mode nil t)
103
104 ;; Add-on programs:
105 (eval-and-compile
106 (autoload 'w3m-bookmark-view "w3m-bookmark"
107 "Display the bookmark" t)
108 (autoload 'w3m-bookmark-view-new-session "w3m-bookmark"
109 "Display the bookmark on a new session" t)
110 (autoload 'w3m-bookmark-add-this-url "w3m-bookmark"
111 "Add a link under point to the bookmark." t)
112 (autoload 'w3m-bookmark-add-current-url "w3m-bookmark"
113 "Add a url of the current page to the bookmark." t)
114 (autoload 'w3m-bookmark-add-all-urls "w3m-bookmark"
115 "Add urls of all pages being visited to the bookmark." t)
116 (autoload 'w3m-bookmark-add "w3m-bookmark" "Add URL to bookmark.")
117 (autoload 'w3m-search "w3m-search"
118 "Search a word using search engines." t)
119 (autoload 'w3m-search-new-session "w3m-search"
120 "Search a word using search engines in a new session." t)
121 (autoload 'w3m-search-uri-replace "w3m-search")
122 (autoload 'w3m-weather "w3m-weather"
123 "Display a weather report." t)
124 (autoload 'w3m-about-weather "w3m-weather")
125 (autoload 'w3m-antenna "w3m-antenna"
126 "Report changes of web sites." t)
127 (autoload 'w3m-antenna-add-current-url "w3m-antenna"
128 "Add a link address of the current page to the antenna database." t)
129 (autoload 'w3m-about-antenna "w3m-antenna")
130 (autoload 'w3m-dtree "w3m-dtree"
131 "Display a directory tree." t)
132 (autoload 'w3m-about-dtree "w3m-dtree")
133 (autoload 'w3m-namazu "w3m-namazu"
134 "Search files with Namazu." t)
135 (autoload 'w3m-about-namazu "w3m-namazu")
136 (autoload 'w3m-perldoc "w3m-perldoc"
137 "View Perl documents" t)
138 (autoload 'w3m-about-perldoc "w3m-perldoc")
139 (autoload 'w3m-fontify-forms "w3m-form")
140 (autoload 'w3m-fontify-textareas "w3m-form")
141 (autoload 'w3m-form-textarea-file-cleanup "w3m-form")
142 (autoload 'w3m-form-textarea-files-remove "w3m-form")
143 (autoload 'w3m-form-kill-buffer "w3m-form")
144 (autoload 'w3m-form-set-number "w3m-form")
145 (autoload 'w3m-filter "w3m-filter")
146 (autoload 'w3m-setup-tab-menu "w3m-tabmenu")
147 (autoload 'w3m-setup-bookmark-menu "w3m-bookmark")
148 (autoload 'w3m-switch-buffer "w3m-tabmenu")
149 (autoload 'w3m-cookie-set "w3m-cookie")
150 (autoload 'w3m-cookie-get "w3m-cookie")
151 (autoload 'w3m-cookie "w3m-cookie")
152 (autoload 'w3m-about-cookie "w3m-cookie")
153 (autoload 'w3m-cookie-shutdown "w3m-cookie" nil t)
154 (autoload 'report-emacs-w3m-bug "w3m-bug" nil t)
155 (autoload 'w3m-replace-symbol "w3m-symbol" nil t)
156 (autoload 'w3m-mail "w3m-mail" nil t)
157 (autoload 'w3m-link-numbering-mode "w3m-lnum" nil t)
158 (autoload 'w3m-linknum-follow "w3m-lnum" nil t)
159 (autoload 'w3m-go-to-linknum "w3m-lnum" nil t)
160 (autoload 'w3m-linknum-toggle-inline-image "w3m-lnum" nil t)
161 (autoload 'w3m-linknum-view-image "w3m-lnum" nil t)
162 (autoload 'w3m-linknum-external-view-this-url "w3m-lnum" nil t)
163 (autoload 'w3m-linknum-edit-this-url "w3m-lnum" nil t)
164 (autoload 'w3m-linknum-print-this-url "w3m-lnum" nil t)
165 (autoload 'w3m-linknum-download-this-url "w3m-lnum" nil t)
166 (autoload 'w3m-linknum-bookmark-add-this-url "w3m-lnum" nil t)
167 (autoload 'w3m-linknum-zoom-in-image "w3m-lnum" nil t)
168 (autoload 'w3m-linknum-zoom-out-image "w3m-lnum" nil t)
169 (autoload 'w3m-session-select "w3m-session"
170 "Select session from session list." t)
171 (autoload 'w3m-session-save "w3m-session"
172 "Save list of displayed session." t)
173 (autoload 'w3m-setup-session-menu "w3m-session")
174 (autoload 'w3m-session-automatic-save "w3m-session")
175 (autoload 'w3m-session-deleted-save "w3m-session")
176 (autoload 'w3m-session-last-autosave-session "w3m-session")
177 (autoload 'w3m-session-goto-session "w3m-session")
178 (autoload 'w3m-session-crash-recovery-save "w3m-session")
179 (autoload 'w3m-session-last-crashed-session "w3m-session"))
180
181 ;; Avoid byte-compile warnings.
182 (eval-when-compile
183 (autoload 'doc-view-mode "doc-view" nil t)
184 (autoload 'doc-view-mode-p "doc-view")
185 (autoload 'image-backward-hscroll "image-mode" nil t)
186 (autoload 'image-bol "image-mode" nil t)
187 (autoload 'image-eol "image-mode" nil t)
188 (autoload 'image-forward-hscroll "image-mode" nil t)
189 (autoload 'image-mode-setup-winprops "image-mode")
190 (autoload 'image-scroll-down "image-mode" nil t)
191 (autoload 'image-scroll-up "image-mode" nil t)
192 (autoload 'quit-window "window" nil t)
193 (autoload 'rfc2368-parse-mailto-url "rfc2368")
194 (autoload 'widget-convert-button "wid-edit")
195 (autoload 'widget-forward "wid-edit" nil t)
196 (autoload 'widget-get "wid-edit")
197 (unless (fboundp 'char-to-int)
198 (defalias 'char-to-int 'identity))
199 (defvar doc-view-mode-map)
200 (defvar w3m-bookmark-mode)
201 (defvar w3m-bookmark-menu-items)
202 (defvar w3m-bookmark-menu-items-pre)
203 (defvar w3m-tab-menubar-make-items-preitems)
204 (defvar w3m-session-menu-items-pre)
205 (defvar w3m-session-menu-items))
206
207 (defconst emacs-w3m-version
208 (eval-when-compile
209 (let ((rev "$Revision: 1.1499 $"))
210 (and (string-match "\\.\\([0-9]+\\) \\$\\'" rev)
211 (setq rev (- (string-to-number (match-string 1 rev)) 1136))
212 (format "1.4.%d" (+ rev 50)))))
213 "Version number of this package.")
214
215 (defgroup w3m nil
216 "Emacs-w3m - the web browser of choice."
217 :group 'hypermedia)
218
219 (defgroup w3m-face nil
220 "Faces used for emacs-w3m."
221 :group 'w3m
222 :prefix "w3m-")
223
224 (defcustom w3m-command nil
225 "*Name of the executable file of the w3m command.
226 You normally don't have to specify the value, since emacs-w3m looks
227 for the existing commands in order of w3m, w3mmee and w3m-m17n in the
228 `exec-path' directories in order if it is nil in the beginning.
229
230 If you want to use the other w3m command, specify the value of this
231 variable explicitly in the .emacs file or customize the value and save
232 it. In this case, you need to restart Emacs and emacs-w3m. That is,
233 there is currently no way to apply the changing of the w3m command to
234 all the emacs-w3m programs safely after loading the w3m.elc module."
235 :group 'w3m
236 :type '(radio (const :format "Not specified " nil)
237 (string :format "Command: %v\n" :size 0)))
238
239 (defcustom w3m-display-ins-del 'auto
240 "*Value of `display_ins_del' option."
241 :group 'w3m
242 :type '(radio (const :format "Delect automatically" auto)
243 (const :format "Use fontify" fontify)
244 (const :format "Use tag" tag)
245 (const :format "No have option" nil)))
246
247 (defvar w3m-type nil
248 "Type of the w3m command.
249 The valid values include `w3m', `w3mmee', and `w3m-m17n'.")
250 (defvar w3m-compile-options nil
251 "Compile options that the w3m command was built with.")
252 (defvar w3m-version nil
253 "Version string of the w3m command.")
254
255 ;; Set w3m-command, w3m-type, w3m-version and w3m-compile-options
256 (if noninteractive ;; Don't call the external command when compiling.
257 (unless w3m-command
258 (setq w3m-command "w3m"))
259 (when (or (null w3m-command)
260 (null w3m-type)
261 (null w3m-version)
262 (null w3m-compile-options))
263 (let ((command (or w3m-command
264 (w3m-which-command "w3m")
265 (w3m-which-command "w3mmee")
266 (w3m-which-command "w3m-m17n"))))
267 (when command
268 (setq w3m-command command)
269 (with-temp-buffer
270 (call-process command nil t nil "-version")
271 (goto-char (point-min))
272 (when (re-search-forward "version \\(w3m/0\\.[3-9]\
273 \\(?:\\.[0-9\\]\\)*\\(?:rc[0-9]+\\)?\
274 \\(?:-stable\\|\\(?:\\+cvs\\(?:-[0-9]+\\.[0-9]+\\)?\\)\\)?\
275 \\(?:-inu\\|\\(-m17n\\|\\(\\+mee\\)\\)\\)?[^,]*\\)" nil t)
276 (setq w3m-version (match-string 1))
277 (setq w3m-type
278 (cond
279 ((match-beginning 3) 'w3mmee)
280 ((match-beginning 2) 'w3m-m17n)
281 ((match-beginning 1) 'w3m)
282 (t 'other))))
283 (when (re-search-forward "options +" nil t)
284 (setq w3m-compile-options
285 (or (split-string (buffer-substring (match-end 0)
286 (point-at-eol))
287 ",")
288 (list nil)))
289 (when (member "m17n" w3m-compile-options)
290 (setq w3m-type 'w3m-m17n))))))))
291
292 (when (not (stringp w3m-command))
293 (error "\
294 Install w3m command in `exec-path' or set `w3m-command' variable correctly"))
295
296 (defcustom w3m-user-agent (concat "Emacs-w3m/" emacs-w3m-version
297 " " w3m-version)
298 "String used for the User-Agent field. See also `w3m-add-user-agent'."
299 :group 'w3m
300 :type '(string :size 0))
301
302 (defcustom w3m-add-user-agent t
303 "Non-nil means add the User-Agent field to the request header.
304 The value of `w3m-user-agent' is used for the field body."
305 :group 'w3m
306 :type 'boolean)
307
308 (defcustom w3m-language
309 (if (and (boundp 'current-language-environment)
310 ;; In XEmacs 21.5 it may be the one like "Japanese (UTF-8)".
311 (string-match "\\`Japanese"
312 (symbol-value 'current-language-environment)))
313 "Japanese")
314 "*Your preferred language used in emacs-w3m sessions."
315 :group 'w3m
316 :type '(radio (const :format "%v " "Japanese")
317 (const :tag "Other" nil))
318 :get (lambda (symbol)
319 (let ((value (format "%s" (default-value symbol)))
320 (case-fold-search t))
321 (prog1
322 (setq value (if (string-match "\\`japan" value) "Japanese"))
323 (custom-set-default symbol value))))
324 :set (lambda (symbol value)
325 (custom-set-default symbol (if (equal value "Japanese") "Japanese"))))
326
327 (defcustom w3m-command-arguments
328 (if (eq w3m-type 'w3mmee) '("-o" "concurrent=0" "-F") nil)
329 "*List of the default arguments passed to the w3m command.
330 See also `w3m-command-arguments-alist'."
331 :group 'w3m
332 :type '(repeat (string :format "Argument: %v\n" :size 0)))
333
334 (defcustom w3m-command-arguments-alist nil
335 "*Alist of regexps matching urls and additional arguments passed to w3m.
336 A typical usage of this variable is to specify whether to use the proxy
337 server for the particular hosts. The first match made will be used.
338 Here is an example of how to set this variable:
339
340 \(setq w3m-command-arguments-alist
341 '(;; Don't use the proxy server to visit local web pages.
342 (\"^http://\\\\(?:[^/]*\\\\.\\\\)*your-company\\\\.com\\\\(?:/\\\\|$\\\\)\"
343 \"-no-proxy\")
344 ;; Use the proxy server to visit any foreign urls.
345 (\"\"
346 \"-o\" \"http_proxy=http://proxy.your-company.com:8080/\")))
347
348 Where the first element matches the url that the scheme is \"http\" and
349 the hostname is either \"your-company.com\" or a name ended with
350 \".your-company.com\", and the proxy server is not used for those hosts.
351 If you are a novice on the regexps, you can use the
352 `w3m-no-proxy-domains' variable instead."
353 :group 'w3m
354 :type '(repeat (cons :format "%v" :indent 4
355 (regexp :format "%t: %v\n" :size 0)
356 (repeat :tag "Arguments passed to w3m command"
357 (string :format "Arg: %v\n" :size 0)))))
358
359 (defcustom w3m-no-proxy-domains nil
360 "*List of domain names with which emacs-w3m will not use a proxy server.
361 Each element should be exactly a domain name which means the latter
362 common part of the host names, not a regexp."
363 :group 'w3m
364 :type '(repeat (string :format "Domain name: %v\n" :size 0)))
365
366 (defcustom w3m-command-environment
367 (delq nil
368 (list
369 (if (eq w3m-type 'w3mmee)
370 (cons "W3MLANG" "ja_JP.kterm"))
371 (if (eq system-type 'windows-nt)
372 (cons "CYGWIN" "binmode tty"))))
373 "*Alist of environment variables for subprocesses to inherit."
374 :group 'w3m
375 :type '(repeat
376 (cons :format "%v" :indent 4
377 (string :format "Name: %v\n" :size 0)
378 (string :format " Value: %v\n" :size 0))))
379
380 (defcustom w3m-fill-column -1
381 "*Integer used as the value for `fill-column' in emacs-w3m buffers.
382 If it is positive, pages will be displayed within the columns of that
383 number. If it is zero or negative, the number of columns which
384 subtracted that number from the window width is applied to the maximum
385 width of pages. Note that XEmacs does not always obey this setting."
386 :group 'w3m
387 :type '(integer :size 0))
388
389 (defcustom w3m-mailto-url-function nil
390 "*Function used to handle the `mailto' urls.
391 Function is called with one argument, just a url. If it is nil, a
392 function specified by the `mail-user-agent' variable will be used for
393 composing mail messages."
394 :group 'w3m
395 :type '(radio (const :tag "Not specified" nil)
396 (function :format "%t: %v\n" :size 0)))
397
398 (defcustom w3m-mailto-url-popup-function-alist
399 '((cmail-mail-mode . pop-to-buffer)
400 (mail-mode . pop-to-buffer)
401 (message-mode . pop-to-buffer)
402 (mew-draft-mode . pop-to-buffer)
403 (mh-letter-mode . pop-to-buffer)
404 (wl-draft-mode . pop-to-buffer))
405 "*Alist of (MAJOR-MODE . FUNCTION) pairs used to pop to a mail buffer up.
406 If a user clicks on a `mailto' url and a mail buffer is composed by
407 `mail-user-agent' with the MAJOR-MODE, FUNCTION will be called with a
408 mail buffer as an argument. Note that the variables
409 `special-display-buffer-names', `special-display-regexps',
410 `same-window-buffer-names' and `same-window-regexps' will be bound to
411 nil while popping to a buffer up."
412 :group 'w3m
413 :type '(repeat (cons :format "%v" :indent 11
414 (symbol :format "Major-mode: %v\n" :size 0)
415 (function :format "%t: %v\n" :size 0))))
416
417 (defcustom w3m-use-mule-ucs
418 (and (eq w3m-type 'w3m) (featurep 'un-define))
419 "*Non-nil means use the multi-script support with Mule-UCS."
420 :group 'w3m
421 :type 'boolean
422 :require 'w3m-ucs)
423
424 (when w3m-use-mule-ucs
425 (condition-case nil
426 (require 'w3m-ucs)
427 (error (setq w3m-use-mule-ucs nil))))
428
429 (defcustom w3m-use-ange-ftp nil
430 "*Non-nil means that `ange-ftp' or `efs' is used to access FTP servers."
431 :group 'w3m
432 :type 'boolean)
433
434 (defcustom w3m-doc-view-content-types
435 (condition-case nil
436 (delq nil (mapcar (lambda (type)
437 (if (doc-view-mode-p type)
438 (format "application/%s" type)))
439 '(dvi postscript pdf)))
440 (error nil))
441 "List of content types for which to use `doc-view-mode' to view contents.
442 This overrides `w3m-content-type-alist'."
443 :group 'w3m
444 :type '(repeat (string :tag "Type" :value "application/")))
445
446 (defcustom w3m-imitate-widget-button '(eq major-mode 'gnus-article-mode)
447 "*If non-nil, imitate the widget buttons on link (anchor) buttons.
448 It is useful for moving about in a Gnus article buffer using TAB key.
449 It can also be any Lisp form that should return a boolean value."
450 :group 'w3m
451 :type '(sexp :size 0))
452
453 (defcustom w3m-treat-image-size t
454 "*Non-nil means let w3m mind the ratio of the size of images and text.
455
456 If it is non-nil, the w3m command will make a halfdump which reserves
457 rectangle spaces in which images will be put, and also `alt' texts
458 will be truncated or padded with spaces so that their display width
459 will be the same as the width of images.
460
461 See also `w3m-pixels-per-character' and `w3m-pixels-per-line'. Those
462 values will be passed to the w3m command in order to compute columns
463 and lines which images occupy."
464 :group 'w3m
465 :type 'boolean)
466
467 (defcustom w3m-pixels-per-line 64
468 "*Integer used for the `-ppl' argument of the w3m command.
469 If nil, the height of the default face is used. It is valid only when
470 `w3m-treat-image-size' is non-nil. Note that a small value may not
471 induce a good result. If you want to use emacs-w3m in a character
472 terminal and make `w3m-treat-image-size' effective, you need to set
473 this variable properly."
474 :group 'w3m
475 :type '(choice (const :tag "Auto Detect" nil)
476 (integer :tag "Specify Pixels")))
477
478 (defcustom w3m-pixels-per-character nil
479 "*Integer used for the `-ppc' argument of the w3m command.
480 If nil, the width of the default face is used. It is valid only when
481 `w3m-treat-image-size' is non-nil. If you want to use emacs-w3m in a
482 character terminal and make `w3m-treat-image-size' effective, you need
483 to set this variable properly."
484 :group 'w3m
485 :type '(radio (const :tag "Auto Detect" nil)
486 (integer :format "Specify Pixels: %v\n" :size 0)))
487
488 (defcustom w3m-image-default-background nil
489 "Color name used as transparent color of image.
490 Nil means to use the background color of the Emacs frame. Note that
491 this value is effective only to xbm and monochrome pbm images in Emacs
492 22 and greater."
493 :group 'w3m
494 :type '(radio (string :format "Color: %v\n" :size 0
495 :match (lambda (widget value)
496 (and (stringp value) (> (length value) 0))))
497 (const :tag "Use the background color of the Emacs frame" nil)
498 (const :tag "Null string" "")))
499
500 (defvar w3m-accept-japanese-characters
501 (and (not noninteractive)
502 (featurep 'mule)
503 (or (memq w3m-type '(w3mmee w3m-m17n))
504 ;; Examine whether the w3m command specified by `w3m-command'
505 ;; uses `euc-japan' for the internal character set.
506 (let ((str
507 (eval-when-compile
508 (format
509 (concat
510 "<!doctype html public \"-//W3C//DTD HTML 3.2//EN\">"
511 "<html><head><meta http-equiv=\"Content-Type\" "
512 "content=\"text/html; charset=ISO-2022-JP\">"
513 "</head><body>%s</body>\n")
514 (string 27 36 66 52 65 59 122 27 40 66)))))
515 (with-temp-buffer
516 (set-buffer-multibyte nil)
517 (insert str)
518 (let ((coding-system-for-write 'binary)
519 (coding-system-for-read 'binary)
520 (default-process-coding-system (cons 'binary 'binary)))
521 (call-process-region (point-min) (point-max) w3m-command
522 t t nil "-T" "text/html" "-halfdump")
523 (goto-char (point-min))
524 (and (re-search-forward (string ?\264 ?\301 ?\273 ?\372)
525 nil t)
526 t))))))
527 "Non-nil means that the w3m command accepts Japanese characters.")
528
529 (defcustom w3m-coding-system (if (featurep 'mule)
530 (if (eq w3m-type 'w3mmee)
531 'iso-2022-7bit-ss2
532 'iso-2022-7bit)
533 'iso-8859-1)
534 "*Default coding system used to communicate with the w3m command."
535 :group 'w3m
536 :type '(coding-system :size 0))
537
538 (defcustom w3m-terminal-coding-system
539 (if w3m-accept-japanese-characters
540 'euc-japan 'iso-8859-1)
541 "*Default coding system used when writing to w3m processes.
542 It is just a default value to set process' coding system initially.
543 \(This variable name is analogically derived from the behavior of the
544 w3m command which accepts data from Emacs just like reads from the
545 terminal.)"
546 :group 'w3m
547 :type '(coding-system :size 0))
548
549 (defcustom w3m-output-coding-system
550 (cond
551 ((not (featurep 'mule)) 'iso-8859-1)
552 ((eq w3m-type 'w3mmee) 'ctext)
553 ((eq w3m-type 'w3m-m17n)
554 (if (and (w3m-find-coding-system 'utf-8)
555 (not (and (equal "Japanese" w3m-language)
556 (featurep 'w3m-ems)
557 (= emacs-major-version 21))))
558 'utf-8
559 'iso-2022-7bit-ss2))
560 (w3m-accept-japanese-characters 'w3m-euc-japan)
561 (t 'w3m-iso-latin-1))
562 "*Coding system used when reading from w3m processes."
563 :group 'w3m
564 :type '(coding-system :size 0))
565
566 (defcustom w3m-input-coding-system
567 (if (memq w3m-type '(w3mmee w3m-m17n))
568 w3m-output-coding-system
569 (if w3m-accept-japanese-characters
570 (if w3m-use-mule-ucs
571 'w3m-euc-japan-mule-ucs
572 (if (featurep 'w3m-ems)
573 'w3m-euc-japan
574 'euc-japan))
575 (if w3m-use-mule-ucs
576 'w3m-iso-latin-1-mule-ucs
577 (if (featurep 'w3m-ems)
578 'w3m-iso-latin-1
579 'iso-8859-1))))
580 "*Coding system used when writing to w3m processes.
581 It overrides `coding-system-for-write' if it is not `binary'.
582 Otherwise, the value of the `w3m-current-coding-system' variable is
583 used instead."
584 :group 'w3m
585 :type '(coding-system :size 0))
586
587 (defcustom w3m-file-coding-system (if (featurep 'mule)
588 'iso-2022-7bit
589 'iso-8859-1)
590 "*Coding system used when writing configuration files.
591 This value will be referred to by the `w3m-save-list' function."
592 :group 'w3m
593 :type '(coding-system :size 0))
594
595 (defvar w3m-file-coding-system-for-read nil
596 "*Coding system used when reading configuration files.
597 It is strongly recommended that you do not set this variable if there
598 is no particular reason. The value will be referred to by the
599 `w3m-load-list' function.")
600
601 (defcustom w3m-file-name-coding-system
602 (if (memq system-type '(windows-nt OS/2 emx))
603 'shift_jis 'euc-japan)
604 "*Coding system used to convert pathnames when emacs-w3m accesses files."
605 :group 'w3m
606 :type '(coding-system :size 0))
607
608 (defcustom w3m-default-coding-system
609 (if (equal "Japanese" w3m-language) 'shift_jis 'iso-8859-1)
610 "*Default coding system used to encode url strings and post-data."
611 :group 'w3m
612 :type '(coding-system :size 0))
613
614 (defcustom w3m-coding-system-priority-list
615 (if (equal "Japanese" w3m-language) '(shift_jis))
616 "*Coding systems in order of priority used for emacs-w3m sessions."
617 :group 'w3m
618 :type '(repeat (coding-system :format "%t: %v\n" :size 0)))
619
620 (defcustom w3m-key-binding nil
621 "*Type of key binding set used in emacs-w3m sessions.
622 The valid values include `info' which provides Info-like keys, and
623 nil which provides Lynx-like keys."
624 :group 'w3m
625 :type '(choice
626 (const :tag "Use Info-like key mapping." info)
627 (const :tag "Use Lynx-like key mapping." nil))
628 ;; Since the following form won't be byte-compiled, you developers
629 ;; should never use CL macros like `caaaar', `when', `unless' ...
630 :set (lambda (symbol value)
631 (prog1
632 (custom-set-default symbol value)
633 (if (or noninteractive
634 ;; Loading w3m.elc is just in progress...
635 (not (featurep 'w3m)))
636 nil
637 (if (and;; Gnus binds `w3m-mode-map' for compiling.
638 (boundp 'w3m-mode-map)
639 (boundp 'w3m-info-like-map)
640 (boundp 'w3m-lynx-like-map))
641 ;; It won't be bound at the first time.
642 (eval
643 '(setq w3m-mode-map (if (eq value 'info)
644 w3m-info-like-map
645 w3m-lynx-like-map)
646 w3m-minor-mode-map (w3m-make-minor-mode-keymap))))
647 (let ((buffers (buffer-list)))
648 (save-current-buffer
649 (while buffers
650 (set-buffer (car buffers))
651 (if (eq major-mode 'w3m-mode)
652 (condition-case nil
653 (progn
654 (use-local-map (symbol-value 'w3m-mode-map))
655 (w3m-setup-toolbar)
656 (w3m-setup-menu))
657 (error)))
658 (setq buffers (cdr buffers)))))))))
659
660 (defcustom w3m-use-cygdrive (eq system-type 'windows-nt)
661 "*If non-nil, use the /cygdrive/ rule when performing `expand-file-name'."
662 :group 'w3m
663 :type 'boolean)
664
665 (eval-and-compile
666 (defconst w3m-treat-drive-letter (memq system-type '(windows-nt OS/2 emx))
667 "Say whether the system uses drive letters."))
668
669 (defcustom w3m-profile-directory
670 (concat "~/." (file-name-sans-extension
671 (file-name-nondirectory w3m-command)))
672 "*Directory where emacs-w3m config files are loaded from or saved to."
673 :group 'w3m
674 :type '(directory :size 0))
675
676 (defcustom w3m-init-file "~/.emacs-w3m"
677 "*Your emacs-w3m startup file name.
678 If a file with the `.el' or `.elc' suffixes exists, it will be read
679 instead.
680
681 Note: This file is used as the startup configuration *NOT* for the w3m
682 command but for emacs-w3m. In order to modify configurations for the
683 w3m command, edit the file named \"~/.w3m/config\" normally."
684 :group 'w3m
685 :type '(file :size 0))
686
687 (defcustom w3m-default-save-directory
688 (concat "~/." (file-name-sans-extension
689 (file-name-nondirectory w3m-command)))
690 "*Default directory where downloaded files will be saved to."
691 :group 'w3m
692 :type '(directory :size 0))
693
694 (defcustom w3m-default-directory nil
695 "*Directory used as the current directory in emacs-w3m buffers.
696 The valid values include a string specifying an existing directory,
697 a symbol of which the value specifies an existing directory,
698 a function which takes a url as an argument and returns a directory,
699 and nil. If the specified directory does not exist or it is nil,
700 the value of `w3m-profile-directory' is used.
701
702 Note that there is an exception: if a page visits a local file or
703 visits a remote file using ftp, the directory in which the file exists
704 is used as the current directory instead."
705 :group 'w3m
706 :type '(radio (directory :format "%{%t%}: %v\n" :size 0 :value "~/")
707 (symbol :format "%{%t%}: %v\n"
708 :match (lambda (widget value) value)
709 :size 0
710 :value default-directory)
711 (function :format "%{%t%}: %v\n"
712 :size 0)
713 (const nil)))
714
715 (defcustom w3m-accept-languages
716 (let ((file (expand-file-name "config" w3m-profile-directory)))
717 (or (when (file-readable-p file)
718 (with-temp-buffer
719 (insert-file-contents file)
720 (goto-char (point-min))
721 (when (re-search-forward "^accept_language[\t ]+\\(.+\\)$" nil t)
722 (delete "" (split-string (match-string 1)
723 "[ \t\r\f\n]*,[ \t\r\f\n]*")))))
724 (when (string= w3m-language "Japanese")
725 '("ja" "en"))))
726 "*List of acceptable languages in descending order of priority.
727 The default value is set according to the accept_language entry of the
728 w3m configuration file (normally \"~/.w3m/config\")."
729 :group 'w3m
730 :type '(repeat (string :format "Lang: %v\n" :size 0)))
731
732 (defcustom w3m-delete-duplicated-empty-lines t
733 "*Non-nil means display two or more continuous empty lines into single."
734 :group 'w3m
735 :type 'boolean)
736
737 (defvar w3m-display-inline-images nil
738 "Internal variable controls whether to show images in emacs-w3m buffers.
739 This variable is buffer-local which defaults to the value of
740 `w3m-default-display-inline-images'. Don't set it directly; modify
741 the `w3m-default-display-inline-images' variable or use the\
742 `\\<w3m-mode-map>\\[w3m-toggle-inline-images]' command
743 to change the appearance of images.
744 See also `w3m-toggle-inline-images-permanently'.")
745 (make-variable-buffer-local 'w3m-display-inline-images)
746
747 (defcustom w3m-default-display-inline-images nil
748 "*Non-nil means display images inline in emacs-w3m buffers.
749 You can toggle the visibility of images by the\
750 `\\<w3m-mode-map>\\[w3m-toggle-inline-images]' command.
751 See also `w3m-toggle-inline-images-permanently'."
752 :group 'w3m
753 :type 'boolean)
754
755 (defcustom w3m-toggle-inline-images-permanently t
756 "*Non-nil means let the visibility of images continue permanently.
757 The visibility of images is initialized according to
758 `w3m-default-display-inline-images' at the first time, and except that
759 it may be toggled by the `\\<w3m-mode-map>\\[w3m-toggle-inline-images]'\
760 command, it does not change hereafter, if
761 it is non-nil. Otherwise, whether images are visible is initialized
762 according to `w3m-default-display-inline-images' whenever you visit a
763 new page or reload the current page in an emacs-w3m buffer."
764 :group 'w3m
765 :type 'boolean)
766
767 (defcustom w3m-icon-directory
768 (let (dir)
769 (or
770 (catch 'found-dir
771 (let* ((path (locate-library "w3m"))
772 (paths (if path
773 (cons (file-name-directory path) load-path)
774 load-path)))
775 (while paths
776 (setq path (car paths)
777 paths (cdr paths))
778 (if path
779 (progn
780 (if (file-directory-p
781 (setq dir
782 (expand-file-name "../../etc/images/w3m/" path)))
783 (throw 'found-dir dir))
784 (if (file-directory-p
785 (setq dir
786 (expand-file-name "../etc/images/w3m/" path)))
787 (throw 'found-dir dir))
788 (if (file-directory-p
789 (setq dir
790 (expand-file-name "../../etc/w3m/icons/" path)))
791 (throw 'found-dir dir))
792 (if (file-directory-p
793 (setq dir
794 (expand-file-name "../etc/w3m/icons/" path)))
795 (throw 'found-dir dir)))))))
796 (and (fboundp 'locate-data-directory)
797 (or (locate-data-directory "images/w3m")
798 (locate-data-directory "w3m")))
799 (and (file-directory-p
800 (setq dir (expand-file-name "images/w3m/" data-directory)))
801 dir)
802 (and (file-directory-p
803 (setq dir (expand-file-name "w3m/icons/" data-directory)))
804 dir)))
805 "*Directory where emacs-w3m should find icon files."
806 :group 'w3m
807 :type '(radio (const :tag "Not specified")
808 (directory :format "%t: %v\n" :size 0)))
809
810 (defcustom w3m-broken-proxy-cache nil
811 "*Set it to t if the proxy server seems not to work properly in caching.
812 Note that this may be the double-edged sword; setting it to t will
813 likely be harmful if the proxy server sends bad requests (e.g., not
814 including the Host header, see RFC2616 section 14.23) to foreign
815 servers when the w3m command specifies the \"no-cache\" directive. Also
816 note that it may not be effective if you are using old w3m command."
817 :group 'w3m
818 :type 'boolean)
819
820 (defcustom w3m-quick-start t
821 "*Non-nil means let emacs-w3m start quickly w/o requiring confirmation.
822 When you invoke the `w3m' command, it attempts to visit the page of a
823 string like url around the cursor or the value of `w3m-home-page'.
824 You won't be asked for the confirmation then if this value is non-nil.
825 Otherwise, you will be prompted for that url with the editing form."
826 :group 'w3m
827 :type 'boolean)
828
829 (defcustom w3m-home-page
830 (or (getenv "HTTP_HOME")
831 (getenv "WWW_HOME")
832 "about:")
833 "*This variable specifies the url string to open when emacs-w3m starts.
834 Don't say HP, which is the abbreviated name of a certain company. ;-)"
835 :group 'w3m
836 :type '(radio
837 :convert-widget w3m-widget-type-convert-widget
838 `(,@(if (getenv "HTTP_HOME")
839 `((const :format "HTTP_HOME: \"%v\"\n"
840 ,(getenv "HTTP_HOME"))))
841 ,@(if (getenv "WWW_HOME")
842 `((const :format "WWW_HOME: \"%v\"\n"
843 (getenv "WWW_HOME"))))
844 (const :tag "About emacs-w3m" "about:")
845 (const :tag "Blank page" "about:blank")
846 (string :format "URL: %v\n" :size 0))))
847
848 (defcustom w3m-arrived-file
849 (expand-file-name ".arrived" w3m-profile-directory)
850 "*Name of the file to keep the arrived URLs database."
851 :group 'w3m
852 :type '(file :size 0))
853
854 (defcustom w3m-keep-arrived-urls 500
855 "*Maximum number of URLs which the arrived URLs database keeps."
856 :group 'w3m
857 :type '(integer :size 0))
858
859 (defcustom w3m-prefer-cache nil
860 "*Non-nil means that cached contents are used without checking headers."
861 :group 'w3m
862 :type 'boolean)
863
864 (defcustom w3m-keep-cache-size 300
865 "*Maximum number of pages to be cached in emacs-w3m."
866 :group 'w3m
867 :type '(integer :size 0))
868
869 (defcustom w3m-follow-redirection 9
870 "*Maximum number of redirections which emacs-w3m honors and follows.
871 If nil, redirections are followed by the w3m command. Don't set it to
872 nil if you allow to use cookies (i.e., you have set `w3m-use-cookies'
873 to non-nil) since cookies may be shared among many redirected pages."
874 :group 'w3m
875 :type '(radio (const :format "Ignore redirections " nil)
876 (integer :size 0)))
877
878 (defcustom w3m-redirect-with-get t
879 "*If non-nil, use the GET method after redirection.
880 It controls how emacs-w3m works when a server responds the code 301 or
881 302. Here is an extract from RFC2616:
882
883 Note: RFC 1945 and RFC 2068 specify that the client is not allowed
884 to change the method on the redirected request. However, most
885 existing user agent implementations treat 302 as if it were a 303
886 response, performing a GET on the Location field-value regardless
887 of the original request method."
888 :group 'w3m
889 :type 'boolean)
890
891 (defcustom w3m-resize-image-scale 50
892 "*Number of steps in percent used when resizing images."
893 :group 'w3m
894 :type '(integer :size 0))
895
896 (defface w3m-anchor
897 '((((class color) (background light)) (:foreground "blue"))
898 (((class color) (background dark)) (:foreground "cyan"))
899 (t (:underline t)))
900 "Face used for displaying anchors."
901 :group 'w3m-face)
902 ;; backward-compatibility alias
903 (put 'w3m-anchor-face 'face-alias 'w3m-anchor)
904
905 (defface w3m-arrived-anchor
906 '((((class color) (background light)) (:foreground "navy"))
907 (((class color) (background dark)) (:foreground "LightSkyBlue"))
908 (t (:underline t)))
909 "Face used for displaying anchors which have already arrived."
910 :group 'w3m-face)
911 ;; backward-compatibility alias
912 (put 'w3m-arrived-anchor-face 'face-alias 'w3m-arrived-anchor)
913
914 (defface w3m-current-anchor
915 '((t (:underline t :bold t)))
916 "Face used to highlight the current anchor."
917 :group 'w3m-face)
918 ;; backward-compatibility alias
919 (put 'w3m-current-anchor-face 'face-alias 'w3m-current-anchor)
920
921 (defface w3m-image
922 '((((class color) (background light)) (:foreground "ForestGreen"))
923 (((class color) (background dark)) (:foreground "PaleGreen"))
924 (t (:underline t)))
925 "Face used for displaying alternate strings of images."
926 :group 'w3m-face)
927 ;; backward-compatibility alias
928 (put 'w3m-image-face 'face-alias 'w3m-image)
929
930 (defface w3m-image-anchor
931 '((((class color) (background light)) (:background "light yellow"))
932 (((class color) (background dark)) (:background "dark green"))
933 (t (:underline t)))
934 "Face used for displaying alternate strings of images which are in anchors."
935 :group 'w3m-face)
936 ;; backward-compatibility alias
937 (put 'w3m-image-anchor-face 'face-alias 'w3m-image-anchor)
938
939 (defface w3m-history-current-url
940 ;; The following strange code compounds the attributes of the
941 ;; `secondary-selection' face and the `w3m-arrived-anchor' face,
942 ;; and generates the new attributes for this face.
943 (let ((base 'secondary-selection)
944 (fn (if (featurep 'xemacs)
945 'face-custom-attributes-get
946 'custom-face-attributes-get));; What a perverseness it is.
947 ;; Both `face-custom-attributes-get' in XEmacs and
948 ;; `custom-face-attributes-get' in CUSTOM 1.9962 attempt to
949 ;; require `font' in Emacs/w3 and `cl' arbitrarily. :-/
950 (features (cons 'font features))
951 base-attributes attributes attribute)
952 (setq base-attributes (funcall fn base nil)
953 attributes (funcall fn 'w3m-arrived-anchor nil))
954 (while base-attributes
955 (setq attribute (car base-attributes))
956 (unless (memq attribute '(:foreground :underline))
957 (setq attributes (plist-put attributes attribute
958 (cadr base-attributes))))
959 (setq base-attributes (cddr base-attributes)))
960 (list (list t attributes)))
961 "Face used to highlight the current url in the \"about://history/\" page."
962 :group 'w3m-face)
963 ;; backward-compatibility alias
964 (put 'w3m-history-current-url-face 'face-alias 'w3m-history-current-url)
965
966 (defface w3m-bold '((t (:bold t)))
967 "Face used for displaying bold text."
968 :group 'w3m-face)
969 ;; backward-compatibility alias
970 (put 'w3m-bold-face 'face-alias 'w3m-bold)
971
972 (defface w3m-italic '((((type tty)) (:underline t))
973 (t (:italic t)))
974 "Face used for displaying italic text.
975 By default it will be a underline face on a non-window system."
976 :group 'w3m-face)
977 ;; backward-compatibility alias
978 (put 'w3m-italic-face 'face-alias 'w3m-italic)
979
980 (defface w3m-underline '((t (:underline t)))
981 "Face used for displaying underlined text."
982 :group 'w3m-face)
983 ;; backward-compatibility alias
984 (put 'w3m-underline-face 'face-alias 'w3m-underline)
985
986 (defface w3m-strike-through
987 `((((class color))
988 ,(if (featurep 'xemacs)
989 '(:strikethru t)
990 '(:strike-through t)))
991 (t (:underline t)))
992 "Face used for displaying strike-through text."
993 :group 'w3m-face)
994 ;; backward-compatibility alias
995 (put 'w3m-strike-through-face 'face-alias 'w3m-strike-through)
996
997 (defface w3m-insert
998 '((((class color) (background light))
999 (:foreground "purple"))
1000 (((class color) (background dark))
1001 (:foreground "orchid"))
1002 (t (:underline t)))
1003 "Face used for displaying insert text."
1004 :group 'w3m-face)
1005 ;; backward-compatibility alias
1006 (put 'w3m-insert-face 'face-alias 'w3m-insert)
1007
1008 (defcustom w3m-mode-hook nil
1009 "*Hook run after `w3m-mode' initialization.
1010 This hook is evaluated by the `w3m-mode' function."
1011 :group 'w3m
1012 :type 'hook)
1013
1014 (defcustom w3m-fontify-before-hook nil
1015 "*Hook run when starting to fontify emacs-w3m buffers.
1016 This hook is evaluated by the `w3m-fontify' function."
1017 :group 'w3m
1018 :type 'hook)
1019
1020 (defcustom w3m-fontify-after-hook nil
1021 "*Hook run after fontifying emacs-w3m buffers.
1022 This hook is evaluated by the `w3m-fontify' function."
1023 :group 'w3m
1024 :type 'hook)
1025
1026 (defcustom w3m-display-hook
1027 '(w3m-move-point-for-localcgi
1028 w3m-history-highlight-current-url)
1029 "*Hook run after displaying pages in emacs-w3m buffers.
1030 Each function is called with a url string as the argument. This hook
1031 is evaluated by the `w3m-goto-url' function."
1032 :group 'w3m
1033 :type 'hook
1034 :initialize 'w3m-custom-hook-initialize)
1035
1036 (defcustom w3m-after-cursor-move-hook
1037 '(w3m-highlight-current-anchor
1038 w3m-print-this-url
1039 w3m-auto-show)
1040 "*Hook run each time after the cursor moves in emacs-w3m buffers.
1041 This hook is called by the `w3m-check-current-position' function by
1042 way of `post-command-hook'."
1043 :group 'w3m
1044 :type 'hook
1045 :initialize 'w3m-custom-hook-initialize)
1046
1047 (defcustom w3m-delete-buffer-hook
1048 '(w3m-pack-buffer-numbers)
1049 "*Hook run when every emacs-w3m buffer is deleted."
1050 :group 'w3m
1051 :type 'hook
1052 :initialize 'w3m-custom-hook-initialize)
1053
1054 (defcustom w3m-select-buffer-hook nil
1055 "*Hook run when a different emacs-w3m buffer is selected."
1056 :group 'w3m
1057 :type 'hook)
1058
1059 (defcustom w3m-async-exec t
1060 "*Non-nil means execute the w3m command asynchronously in Emacs process."
1061 :group 'w3m
1062 :type 'boolean)
1063
1064 ;; As far as we know, Emacs 21 under Mac OS X[1] and XEmacs under
1065 ;; Solaris[2] won't run the asynchronous operations correctly when
1066 ;; both `w3m-async-exec' and `w3m-process-connection-type' are non-nil;
1067 ;; [1]the final kilobyte or so might get lost from raw data downloaded
1068 ;; from a web site; [2]XEmacs hangs up.
1069
1070 (defcustom w3m-process-connection-type
1071 (not (or (and (memq system-type '(darwin macos))
1072 (let ((ver (shell-command-to-string "uname -r")))
1073 (and (string-match "^\\([0-9]+\\)\\." ver)
1074 (< (string-to-number (match-string 1 ver)) 7))))
1075 (and (featurep 'xemacs)
1076 (string-match "solaris" system-configuration))))
1077 "*Value for `process-connection-type' used when communicating with w3m."
1078 :group 'w3m
1079 :type 'boolean)
1080
1081 (defcustom w3m-async-exec-with-many-urls
1082 ;; XEmacs 21.5 tends to freeze when retrieving many urls at a time. :-<
1083 (not (and (featurep 'xemacs) (not (featurep 'sxemacs))
1084 (= emacs-major-version 21) (= emacs-minor-version 5)))
1085 "Non-nil means allow retrieving many urls asynchronously.
1086 The value affects how emacs-w3m will work with group:* urls and the
1087 `w3m-session-select' feature. If it is nil, the asynchronous operation
1088 is inhibited in those cases even if `w3m-async-exec' is non-nil."
1089 :group 'w3m
1090 :type 'boolean)
1091
1092 (defcustom w3m-default-content-type "text/html"
1093 "*Default value assumed as the content type of local files."
1094 :group 'w3m
1095 :type '(string :size 0))
1096
1097 (defvar w3m-image-viewer
1098 (or (w3m-which-command "display")
1099 (w3m-which-command "eeyes")
1100 (w3m-which-command "xloadimage")
1101 (w3m-which-command "xv"))
1102 "*Command used to view image files externally.
1103 Note that this option is installed temporally. It will be abolished
1104 when we implement the mailcap parser to set `w3m-content-type-alist'.")
1105
1106 ;; FIXME: we need to improve so that to set up the value of this
1107 ;; variable may be performed by parsing the mailcap file.
1108 (defcustom w3m-content-type-alist
1109 (let* ((fiber-viewer (when (and (eq system-type 'windows-nt)
1110 (w3m-which-command "fiber"))
1111 (list "fiber.exe" "-s" 'file)))
1112 (external-browser
1113 (if (and (eq system-type 'windows-nt) (w3m-which-command "fiber"))
1114 'w3m-w32-browser-with-fiber
1115 (or (when (condition-case nil (require 'browse-url) (error nil))
1116 (if (or (not (boundp 'browse-url-browser-function))
1117 (eq 'w3m-browse-url
1118 (symbol-value 'browse-url-browser-function)))
1119 (cond
1120 ((and (memq system-type '(windows-nt ms-dos cygwin))
1121 (fboundp 'browse-url-default-windows-browser))
1122 'browse-url-default-windows-browser)
1123 ((and (memq system-type '(darwin))
1124 (fboundp 'browse-url-default-macosx-browser))
1125 'browse-url-default-macosx-browser)
1126 ((fboundp 'browse-url-default-browser)
1127 'browse-url-default-browser)
1128 ((fboundp 'browse-url-netscape)
1129 'browse-url-netscape))
1130 (symbol-value 'browse-url-browser-function)))
1131 (when (w3m-which-command "netscape")
1132 (list "netscape" 'url)))))
1133 (image-viewer (or fiber-viewer
1134 (when w3m-image-viewer
1135 (list w3m-image-viewer 'file))))
1136 (video-viewer (or fiber-viewer
1137 (when (w3m-which-command "mpeg_play")
1138 (list "mpeg_play" 'file))))
1139 (dvi-viewer (or fiber-viewer
1140 (cond ((w3m-which-command "xdvi") (list "xdvi" 'file))
1141 ((w3m-which-command "dvitty")
1142 (list "dvitty" 'file)))))
1143 (ps-viewer (or fiber-viewer
1144 (cond
1145 ((w3m-which-command "gv") (list "gv" 'file))
1146 ((w3m-which-command "gs") (list "gs" 'file)))))
1147 (pdf-viewer (or fiber-viewer
1148 (cond
1149 ((w3m-which-command "xpdf") (list "xpdf" 'file))
1150 ((w3m-which-command "acroread")
1151 (list "acroread" 'file))))))
1152 `(("text/plain" "\\.\\(?:txt\\|tex\\|el\\)\\'" nil nil)
1153 ("text/html" "\\.s?html?\\'" ,external-browser nil)
1154 ("text/sgml" "\\.sgml?\\'" nil "text/plain")
1155 ("text/xml" "\\.xml\\'" nil "text/plain")
1156 ("image/jpeg" "\\.jpe?g\\'" ,image-viewer nil)
1157 ("image/png" "\\.png\\'" ,image-viewer nil)
1158 ("image/gif" "\\.gif\\'" ,image-viewer nil)
1159 ("image/tiff" "\\.tif?f\\'" ,image-viewer nil)
1160 ("image/x-xwd" "\\.xwd\\'" ,image-viewer nil)
1161 ("image/x-xbm" "\\.xbm\\'" ,image-viewer nil)
1162 ("image/x-xpm" "\\.xpm\\'" ,image-viewer nil)
1163 ("image/x-bmp" "\\.bmp\\'" ,image-viewer nil)
1164 ("video/mpeg" "\\.mpe?g\\'" ,video-viewer nil)
1165 ("video/quicktime" "\\.mov\\'" ,video-viewer nil)
1166 ("application/dvi" "\\.dvi\\'" ,dvi-viewer nil)
1167 ("application/postscript" "\\.e?ps\\'" ,ps-viewer nil)
1168 ("application/pdf" "\\.pdf\\'" ,pdf-viewer nil)
1169 ("application/x-pdf" "\\.pdf\\'" ,pdf-viewer nil)
1170 ("application/xml" "\\.xml\\'" nil w3m-detect-xml-type)
1171 ("application/rdf+xml" "\\.rdf\\'" nil "text/plain")
1172 ("application/rss+xml" "\\.rss\\'" nil "text/plain")
1173 ("application/xhtml+xml" nil nil "text/html")))
1174 "*Alist of content types, regexps, commands to view, and filters.
1175 Each element is a list which consists of the following data:
1176
1177 1. Content type.
1178
1179 2. Regexp matching a url or a file name.
1180
1181 3. Method to view contents. The following three types may be used:
1182 a. Lisp function which takes the url to view as an argument.
1183 b. (\"COMMAND\" [ARG...]) -- where \"COMMAND\" is the external command
1184 and ARG's are the arguments passed to the command if any. The
1185 symbols `file' and `url' that appear in ARG's will be replaced
1186 respectively with the name of a temporary file which contains
1187 the contents and the string of the url to view.
1188 c. nil which means to download the url into the local file.
1189
1190 4. Content type that overrides the one specified by `1. Content type'.
1191 Valid values include:
1192 a. Lisp function that takes three arguments URL, CONTENT-TYPE, and
1193 CHARSET, and returns a content type.
1194 b. String that specifies a content type.
1195 c. nil that means not to override the content type."
1196 :group 'w3m
1197 :type '(repeat
1198 (group
1199 :indent 2
1200 (string :format "Type: %v\n" :size 0)
1201 (radio :format "%{Regexp%}: %v" :extra-offset 8
1202 :sample-face underline
1203 (const :tag "Not specified" nil)
1204 (regexp :format "String: %v\n" :size 0))
1205 (radio :format "%{Viewer%}: %v" :extra-offset 8
1206 :sample-face underline
1207 (const :tag "Not specified" nil)
1208 (cons :tag "External viewer" :extra-offset 2
1209 (string :format "Command: %v\n" :size 0)
1210 (repeat :format "Arguments:\n%v%i\n" :extra-offset 2
1211 (restricted-sexp
1212 :format "%v\n"
1213 :match-alternatives (stringp 'file 'url)
1214 :size 0)))
1215 (function :format "%t: %v\n" :size 0))
1216 (radio :format "%{Filter%}: %v" :extra-offset 8
1217 :sample-face underline
1218 (const :tag "Not specified" nil)
1219 (string :format "Equivalent type: %v\n" :size 0)
1220 (function :format "Function: %v\n" :size 0)))))
1221
1222 ;; FIXME: we need to rearrange the complicated and redundant relation of
1223 ;; `w3m-encoding-type-alist', `w3m-decoder-alist', and `w3m-encoding-alist'.
1224 (defcustom w3m-encoding-type-alist
1225 '(("\\.gz\\'" . "gzip")
1226 ("\\.bz2?\\'" . "bzip"))
1227 "*Alist of file suffixes and content encoding types."
1228 :group 'w3m
1229 :type '(repeat
1230 (cons :format "%v" :indent 14
1231 (string :format "Regexp of Suffixes: %v\n" :size 0)
1232 (string :format "Encoding Type: %v\n" :size 0))))
1233
1234 (defcustom w3m-decoder-alist
1235 `((gzip "gzip" ("-d")) ;; Don't use "gunzip" and "bunzip2"
1236 (bzip "bzip2" ("-d")) ;; for broken OS and implementations.
1237 (deflate
1238 ,(if (not noninteractive)
1239 (let ((exec-path
1240 (let ((prefix (file-name-directory
1241 (directory-file-name
1242 (file-name-directory
1243 (w3m-which-command w3m-command))))))
1244 (list (expand-file-name "libexec/w3m" prefix)
1245 (expand-file-name "lib/w3m" prefix)))))
1246 (w3m-which-command "inflate")))
1247 nil))
1248 "Alist of encoding types, decoder commands, and arguments."
1249 :group 'w3m
1250 :type '(repeat
1251 (group :indent 4
1252 (radio :format "Encoding: %v"
1253 (const :format "%v " gzip)
1254 (const :format "%v " bzip)
1255 (const deflate))
1256 (string :format "Command: %v\n" :size 0)
1257 (repeat :tag "Arguments" :extra-offset 2
1258 (string :format "%v\n" :size 0)))))
1259
1260 (defcustom w3m-charset-coding-system-alist
1261 (let ((rest
1262 '((us_ascii . raw-text)
1263 (us-ascii . raw-text)
1264 (gb2312 . cn-gb-2312)
1265 (cn-gb . cn-gb-2312)
1266 (iso-2022-jp-2 . iso-2022-7bit-ss2)
1267 (iso-2022-jp-3 . iso-2022-7bit-ss2)
1268 (tis-620 . tis620)
1269 (windows-874 . tis-620)
1270 (cp874 . tis-620)
1271 (x-ctext . ctext)
1272 (unknown . undecided)
1273 (x-unknown . undecided)
1274 (windows-1250 . cp1250)
1275 (windows-1251 . cp1251)
1276 (windows-1252 . cp1252)
1277 (windows-1253 . cp1253)
1278 (windows-1254 . cp1254)
1279 (windows-1255 . cp1255)
1280 (windows-1256 . cp1256)
1281 (windows-1257 . cp1257)
1282 (windows-1258 . cp1258)
1283 (euc-jp . euc-japan)
1284 (shift-jis . shift_jis)
1285 (shift_jis . shift_jis)
1286 (sjis . shift_jis)
1287 (x-euc-jp . euc-japan)
1288 (x-shift-jis . shift_jis)
1289 (x-shift_jis . shift_jis)
1290 (x-sjis . shift_jis)))
1291 dest)
1292 (while rest
1293 (or (w3m-find-coding-system (car (car rest)))
1294 (setq dest (cons (car rest) dest)))
1295 (setq rest (cdr rest)))
1296 dest)
1297 "Alist of MIME charsets and coding systems.
1298 Both charsets and coding systems must be symbols."
1299 :group 'w3m
1300 :type '(repeat (cons :format "%v" :indent 2
1301 (symbol :format "%t: %v\n" :size 0)
1302 (coding-system :format "%t: %v\n" :size 0))))
1303
1304 (defcustom w3m-correct-charset-alist
1305 '(("windows-874" . "tis-620")
1306 ("cp874" . "tis-620")
1307 ("cp1250" . "windows-1250")
1308 ("cp1251" . "windows-1251")
1309 ("cp1252" . "windows-1252")
1310 ("cp1253" . "windows-1253")
1311 ("cp1254" . "windows-1254")
1312 ("cp1255" . "windows-1255")
1313 ("cp1256" . "windows-1256")
1314 ("cp1257" . "windows-1257")
1315 ("cp1258" . "windows-1258")
1316 ("shift-jis" . "shift_jis")
1317 ("sjis" . "shift_jis")
1318 ("x-euc-jp" . "euc-jp")
1319 ("x-shift-jis" . "shift_jis")
1320 ("x-shift_jis" . "shift_jis")
1321 ("x-sjis" . "shift_jis"))
1322 "Alist of MIME charsets; strange ones and standard ones."
1323 :group 'w3m
1324 :type '(repeat (cons :format "%v" :indent 11
1325 (string :format "From: %v\n" :size 0)
1326 (string :format "To: %v\n" :size 0))))
1327
1328 (defcustom w3m-horizontal-scroll-columns 10
1329 "*Number of steps in columns used when scrolling a window horizontally."
1330 :group 'w3m
1331 :type '(integer :size 0))
1332
1333 (defcustom w3m-horizontal-shift-columns 2
1334 "*Number of steps in columns used when shifting a window horizontally.
1335 The term `shifting' means a fine level scrolling."
1336 :group 'w3m
1337 :type '(integer :size 0))
1338
1339 (defcustom w3m-view-recenter 1
1340 "Recenter window contents when going to an anchor.
1341 An integer is passed to `recenter', for instance the default 1
1342 means put the anchor on the second line of the screen.
1343 t means `recenter' with no arguments, which puts it in the middle
1344 of the screen.
1345 nil means don't recenter, let the display follow point in the
1346 usual way."
1347 :group 'w3m
1348 ;; radio items in the same order as in the docstring, and `integer' first
1349 ;; because it's the default
1350 :type '(radio (integer :format "%{%t%}: %v\n" :value 1 :size 1)
1351 (const :format "%t\n" t)
1352 (const :format "%t\n" nil)))
1353
1354 (defcustom w3m-use-form t
1355 "*Non-nil means make it possible to use form extensions. (EXPERIMENTAL)"
1356 :group 'w3m
1357 :type 'boolean
1358 :require 'w3m-form)
1359
1360 (defcustom w3m-submit-form-safety-check nil
1361 "Non-nil means ask you for confirmation when submitting a form."
1362 :group 'w3m
1363 :type 'boolean)
1364
1365 (defcustom w3m-use-cookies nil
1366 "*Non-nil means enable emacs-w3m to use cookies. (EXPERIMENTAL)"
1367 :group 'w3m
1368 :type 'boolean)
1369
1370 (defcustom w3m-use-filter nil
1371 "*Non-nil means use filter programs to convert web contents.
1372 See also `w3m-filter-rules'."
1373 :group 'w3m
1374 :type 'boolean
1375 :require 'w3m-filter)
1376
1377 (defcustom w3m-use-symbol
1378 (when (and (featurep 'mule)
1379 (eq w3m-type 'w3m-m17n))
1380 (if (eq w3m-output-coding-system 'utf-8)
1381 (and (w3m-mule-unicode-p)
1382 (or (featurep 'xemacs)
1383 (< emacs-major-version 23))
1384 'w3m-device-on-window-system-p)
1385 t))
1386 "*Non-nil means replace symbols that the <_SYMBOL> tags lead into.
1387 It is meaningful only when the w3m-m17n command is used and (X)Emacs
1388 handles unicode charsets."
1389 :group 'w3m
1390 :type 'boolean
1391 :require 'w3m-symbol)
1392
1393 (defcustom w3m-edit-function 'find-file
1394 "*Function used for editing local files.
1395 It is used when either `w3m-edit-current-url' or `w3m-edit-this-url'
1396 is invoked for local pages."
1397 :group 'w3m
1398 :type '(radio
1399 (const :tag "Edit it in the current window" find-file)
1400 (const :tag "Edit it in another window" find-file-other-window)
1401 (const :tag "Edit it in another frame" find-file-other-frame)
1402 (const :tag "View it in another window" view-file-other-window)
1403 (function :format "Other function: %v\n" :size 0
1404 :value view-file)))
1405
1406 (defcustom w3m-edit-function-alist
1407 '(("\\`[^?]+/hiki\\.cgi\\?" . hiki-edit-url))
1408 "*Alist of functions used for editing pages.
1409 This option is referred to decide which function should be used to
1410 edit a specified page, when either `w3m-edit-current-url' or
1411 `w3m-edit-this-url' is invoked. When no suitable function is found
1412 from this alist, `w3m-edit-function' is used."
1413 :group 'w3m
1414 :type '(repeat (cons :format "%v" :indent 3
1415 (regexp :format "URL: %v\n" :size 0)
1416 (function))))
1417
1418 (defcustom w3m-url-local-directory-alist
1419 (when (boundp 'yahtml-path-url-alist)
1420 (mapcar
1421 (lambda (pair)
1422 (cons (cdr pair) (car pair)))
1423 (symbol-value 'yahtml-path-url-alist)))
1424 "*Alist of URLs and local directories.
1425 If directory names of a given URL and the car of an element are the
1426 same, emacs-w3m assumes that the file exists in the local directory
1427 where the cdr of an element points to. The default value will be set
1428 to a value of the `yahtml-path-url-alist' variable which exchanged the
1429 car and the cdr in each element if it is available."
1430 :type '(repeat
1431 (cons :format "%v" :indent 3
1432 (string :format "URL: %v\n" :size 0)
1433 (directory :format "%t: %v\n" :size 0)))
1434 :group 'w3m)
1435
1436 (defcustom w3m-track-mouse t
1437 "*Whether to track the mouse and message the url under the mouse.
1438 See also `show-help-function' if you are using GNU Emacs.
1439
1440 A tip for XEmacs users:
1441
1442 You can also use the `balloon-help' feature by the
1443 `M-x balloon-help-mode' command with arg 1. If the window manager
1444 decorates the balloon-help frame, and that is not to your taste, you
1445 may strip it off with the following directives:
1446
1447 For ol[v]wm use this in .Xdefaults:
1448 olvwm.NoDecor: balloon-help
1449 or
1450 olwm.MinimalDecor: balloon-help
1451
1452 For fvwm version 1 use this in your .fvwmrc:
1453 NoTitle balloon-help
1454 or
1455 Style \"balloon-help\" NoTitle, NoHandles, BorderWidth 0
1456
1457 For twm use this in your .twmrc:
1458 NoTitle { \"balloon-help\" }
1459
1460 See the balloon-help.el file for more information."
1461 :group 'w3m
1462 :type 'boolean)
1463
1464 (defcustom w3m-show-decoded-url
1465 '(("\\`http://\\(?:[^./?#]+\\.\\)*wikipedia\\.org/" . utf-8)
1466 ("\\`http://\\(?:[^./?#]+\\.\\)*nikkei\\.co\\.jp/" . nil)
1467 ("\\`http://\\(?:[^./?#]+\\.\\)*hatena\\.ne\\.jp/" . euc-jp)
1468 ("\\`http://\\(?:[^./?#]+\\.\\)*ohmynews\\.co\\.jp/" . utf-8)
1469 (t . t))
1470 "*Non-nil means show decoded URIs in the echo area, the balloon, etc.
1471 This variable can take one of the following five kinds of forms:
1472
1473 1. t
1474 Decode URIs using the encoding guessed from the value of
1475 `w3m-coding-system-priority-list'.
1476
1477 2. Coding system
1478 Decode URIs using this value.
1479
1480 3. List of coding systems:
1481 Decode URIs using the encoding assumed based on this list.
1482
1483 4. Alist of predicates and forms described below:
1484 Each element looks like the `(PREDICATE . ENCODING)' form. PREDICATE
1485 should be a regexp, a function or a Lisp form, and ENCODING should be
1486 one of the forms described here excluding this form. If PREDICATE is
1487 a regexp, it will be tested whether it matches to the target url.
1488 If it is a function, it will be called with the target url. If it
1489 is a Lisp form, it will be simply evaluated. Elements are tested in
1490 turn until the result of the test of the predicate is true and the
1491 encoding which is associated to the predicate is used for decoding
1492 URIs.
1493
1494 5. nil
1495 Don't decode URIs."
1496 :group 'w3m
1497 :type
1498 '(choice
1499 :format "%{%t%}: %[Value Menu%]\n %v"
1500 (coding-system :tag "Specify encoding" :format "Use this encoding: %v"
1501 :match (lambda (widget value)
1502 (w3m-find-coding-system value)))
1503 (const :tag "Prefer the encoding of the current page"
1504 :format "%t: %{t%}\n" :sample-face widget-field-face
1505 t)
1506 (group :tag "List of prefered encodings"
1507 :match (lambda (widget value)
1508 (and (car-safe value)
1509 (symbolp (car-safe value))))
1510 (repeat :format "List of prefered encodings:\n%v%i\n"
1511 :inline t
1512 (coding-system :tag "Encoding")))
1513 (group :tag "Rules to select an encoding of URIs on the current page"
1514 :match (lambda (widget value) value)
1515 (repeat
1516 :format
1517 "Rules to select an encoding of URIs on the current page:\n%v%i\n"
1518 :inline t
1519 (cons
1520 :format "%v" :indent 2
1521 (choice
1522 :format "\n %[Value Menu for the car%]\n %v"
1523 (regexp :tag "Regexp matches the current page")
1524 (function :tag "Predicate checks for the current page")
1525 (sexp :tag "Expression checks for the current page"))
1526 (choice
1527 :format "%[Value Menu for the cdr%]\n %v"
1528 (coding-system :tag "Specify encoding"
1529 :format "Use this encoding: %v"
1530 :match (lambda (widget value)
1531 (if (featurep 'xemacs)
1532 nil ;; ??
1533 (w3m-find-coding-system value))))
1534 (const :tag "Prefer the encoding of the current page"
1535 :format "%t: %{t%}\n" :sample-face widget-field-face
1536 t)
1537 (group :tag "List of prefered encodings"
1538 (repeat :tag "List of prefered encodings"
1539 :inline t
1540 :extra-offset 4
1541 (coding-system :tag "Encoding")))
1542 (const :tag "Don't decode URIs"
1543 :format "%t: %{nil%}\n" :sample-face widget-field-face
1544 nil)))))
1545 (const :tag "Don't decode URIs"
1546 :format "%t: %{nil%}\n" :sample-face widget-field-face
1547 nil)))
1548
1549 (defcustom w3m-use-title-buffer-name nil
1550 "Non-nil means use name of buffer included current title."
1551 :group 'w3m
1552 :type 'boolean)
1553
1554 (defcustom w3m-use-japanese-menu
1555 (and (equal "Japanese" w3m-language)
1556 ;; Emacs 21, XEmacs 21.4 and SXEmacs don't seem to support
1557 ;; non-ASCII text in the popup menu.
1558 (not (featurep 'sxemacs))
1559 (if (featurep 'xemacs)
1560 (or (> emacs-major-version 21)
1561 (and (= emacs-major-version 21)
1562 (>= emacs-minor-version 5)))
1563 (or (>= emacs-major-version 22)
1564 (featurep 'meadow))))
1565 "Non-nil means use Japanese characters for Menu if possible."
1566 :group 'w3m
1567 :type 'boolean)
1568
1569 (defcustom w3m-menu-on-forefront nil
1570 "Non-nil means place the emacs-w3m menus on the forefront of the menu bar."
1571 :group 'w3m
1572 :type 'boolean
1573 :set (lambda (symbol value)
1574 (prog1
1575 (custom-set-default symbol value)
1576 (unless noninteractive
1577 (w3m-menu-on-forefront value)))))
1578
1579 (defcustom w3m-use-tab t
1580 "Non-nil means make emacs-w3m a tab browser.
1581 It makes it possible to show all emacs-w3m buffers in a single window
1582 with the tabs line, and you can choose one by clicking a mouse on it.
1583 See also `w3m-use-tab-menubar'."
1584 :group 'w3m
1585 :type 'boolean)
1586
1587 (defcustom w3m-add-tab-number nil
1588 "Non-nil means put sequential number to a title on tab."
1589 :group 'w3m
1590 :type 'boolean)
1591
1592 (defcustom w3m-use-tab-menubar t
1593 "Non-nil means use the TAB pull-down menu in the menubar.
1594 It makes it possible to show all emacs-w3m buffers in a single window,
1595 and you can choose one by clicking a mouse on it. This feature
1596 requires that Emacs has been built to be able to display multilingual
1597 text in the menubar if you often visit web sites written in non-ascii
1598 text. See also `w3m-use-tab'."
1599 :group 'w3m
1600 :type 'boolean)
1601
1602 (defcustom w3m-new-session-url "about://bookmark/"
1603 "*Default url to be opened in a tab or a session which is created newly."
1604 :group 'w3m
1605 :type '(radio
1606 :convert-widget w3m-widget-type-convert-widget
1607 `((const :tag "About emacs-w3m" "about:")
1608 (const :tag "Blank page" "about:blank")
1609 (const :tag "Bookmark" "about://bookmark/")
1610 (const :tag ,(format "Home page (%s)" w3m-home-page)
1611 ,w3m-home-page)
1612 (string :format "URL: %v\n" :size 0
1613 :value "http://emacs-w3m.namazu.org"))))
1614
1615 (defcustom w3m-make-new-session nil
1616 "*Non-nil means making new emacs-w3m buffers when visiting new pages.
1617 If it is non-nil and there are already emacs-w3m buffers, the `w3m'
1618 command makes a new emacs-w3m buffer if a user specifies a url string
1619 in the minibuffer, and the `w3m-safe-view-this-url' command also makes
1620 a new buffer if a user invokes it in a buffer not being running the
1621 `w3m-mode'."
1622 :group 'w3m
1623 :type 'boolean)
1624
1625 (defcustom w3m-use-favicon t
1626 "*Non-nil means show favicon images if they are available.
1627 It will be set to nil automatically if ImageMagick's `convert' program
1628 does not support the ico format."
1629 :get (lambda (symbol)
1630 (and (not noninteractive)
1631 (default-value symbol)
1632 (w3m-favicon-usable-p)))
1633 :set (lambda (symbol value)
1634 (custom-set-default symbol (and (not noninteractive)
1635 value
1636 (w3m-favicon-usable-p))))
1637 :group 'w3m
1638 :type 'boolean)
1639
1640 (defcustom w3m-show-graphic-icons-in-mode-line t
1641 "Non-nil means show graphic status indicators in the mode-line.
1642 If it is nil, also the favicon won't be shown in the mode-line even if
1643 `w3m-use-favicon' is non-nil."
1644 :set (lambda (symbol value)
1645 (prog1
1646 (custom-set-default symbol value)
1647 (if (and (not noninteractive)
1648 ;; Make sure it is not the first time.
1649 (featurep 'w3m)
1650 (fboundp 'w3m-initialize-graphic-icons))
1651 (w3m-initialize-graphic-icons))))
1652 :group 'w3m
1653 :type 'boolean)
1654
1655 (defcustom w3m-show-graphic-icons-in-header-line t
1656 "Non-nil means show graphic status indicators in the header-line.
1657 If it is nil, also the favicon won't be shown in the header-line even
1658 if `w3m-use-favicon' is non-nil. This variable is currently
1659 meaningless under XEmacs."
1660 :group 'w3m
1661 :type 'boolean)
1662
1663 (defcustom w3m-pop-up-windows t
1664 "Non-nil means split the windows when a new emacs-w3m session is created.
1665 This variable is similar to `pop-up-windows' and quite overridden by
1666 `w3m-pop-up-frames' as if `pop-up-frames' influences. Furthermore, if
1667 `w3m-use-tab' is non-nil or there is the buffers selection window (for
1668 the `w3m-select-buffer' feature), this variable is ignored when
1669 creating the second or more emacs-w3m session."
1670 :group 'w3m
1671 :type 'boolean)
1672
1673 (defcustom w3m-pop-up-frames nil
1674 "Non-nil means pop to a new frame up for an emacs-w3m session.
1675 This variable is similar to `pop-up-frames' and does override
1676 `w3m-pop-up-windows'. If `w3m-use-tab' is non-nil or there is the
1677 buffers selection window (for the `w3m-select-buffer' feature), this
1678 variable is ignored when creating the second or more emacs-w3m session."
1679 :group 'w3m
1680 :type 'boolean)
1681
1682 (defcustom w3m-view-this-url-new-session-in-background nil
1683 "*Obsolete."
1684 :group 'w3m
1685 :type 'boolean)
1686
1687 (defcustom w3m-new-session-in-background
1688 w3m-view-this-url-new-session-in-background
1689 "*Say whether not to focus on a new tab or a new session in target.
1690 It influences only when a new emacs-w3m buffer is created."
1691 :group 'w3m
1692 :type 'boolean)
1693
1694 (defcustom w3m-popup-frame-parameters nil
1695 "Alist of frame parameters used when creating a new emacs-w3m frame.
1696 It allows not only the alist form but also XEmacs' plist form."
1697 :group 'w3m
1698 :type '(choice (group :inline t :tag "Frame Parameters (Emacs)"
1699 (repeat :inline t :tag "Frame Parameters (Emacs)"
1700 (cons :format "%v" :indent 3
1701 (symbol :format "Parameter: %v\n"
1702 :size 0)
1703 (sexp :format "%t: %v\n" :size 0))))
1704 (group :inline t :tag "Frame Plist (XEmacs)"
1705 (repeat :inline t :tag "Frame Plist (XEmacs)"
1706 (group :indent 2 :inline t
1707 (symbol :format "Property: %v\n"
1708 :size 0)
1709 (sexp :format "%t: %v\n" :size 0))))))
1710
1711 (defcustom w3m-auto-show t
1712 "*Non-nil means provide the ability to horizontally scroll the window.
1713 Automatic horizontal scrolling is made when the point gets away from
1714 both ends of the window, but nothing occurs if `truncate-lines' is set
1715 to nil.
1716
1717 This feature works with the specially made program in emacs-w3m; usual
1718 `auto-hscroll-mode', `automatic-hscrolling', `auto-show-mode' or
1719 `hscroll-mode' will all be invalidated in emacs-w3m buffers."
1720 :group 'w3m
1721 :type 'boolean)
1722
1723 (defcustom w3m-horizontal-scroll-division 4
1724 "*Integer used by the program making the point certainly visible.
1725 The cursor definitely does not go missing even when it has been driven
1726 out of the window while wandering around anchors and forms in an
1727 emacs-w3m buffer.
1728
1729 Suppose that the value of this variable is N. When the point is
1730 outside the left of the window, emacs-w3m scrolls the window so that
1731 the point may be displayed on the position within 1/N of the width of
1732 the window from the left. Similarly, when the point is outside the
1733 right of the window, emacs-w3m scrolls the window so that the point
1734 may be displayed on the position of 1/N of the width of the window
1735 from the right.
1736
1737 This feature doesn't work if `w3m-auto-show' is nil. The value must
1738 be a larger integer than 1."
1739 :group 'w3m
1740 :type '(integer :size 0)
1741 :set (lambda (symbol value)
1742 (custom-set-default symbol (if (and (integerp value) (> value 1))
1743 value
1744 4))))
1745
1746 (defcustom w3m-show-error-information t
1747 "*Non-nil means show an error information as a web page.
1748 Page is made when the foreign server doesn't respond to a request to
1749 retrieve data."
1750 :group 'w3m
1751 :type 'boolean)
1752
1753 (defcustom w3m-use-refresh t
1754 "*Non-nil means honor the REFRESH attribute in META tags.
1755 Emacs-w3m arbitrarily takes you to a url specified by that attribute.
1756 Note that they may be malicious traps."
1757 :group 'w3m
1758 :type 'boolean)
1759
1760 (defcustom w3m-mbconv-command "mbconv"
1761 "*Name of the \"mbconv\" command provided by the \"libmoe\" package.
1762 The \"libmoe\" package is used when you use the w3mmee command instead
1763 of the w3m command. See also `w3m-command'."
1764 :group 'w3m
1765 :type '(string :size 0))
1766
1767 (defcustom w3m-local-find-file-regexps
1768 (cons nil
1769 (concat "\\."
1770 (regexp-opt (append '("htm"
1771 "html"
1772 "shtm"
1773 "shtml"
1774 "xhtm"
1775 "xhtml"
1776 "txt")
1777 (and (w3m-image-type-available-p 'jpeg)
1778 '("jpeg" "jpg"))
1779 (and (w3m-image-type-available-p 'gif)
1780 '("gif"))
1781 (and (w3m-image-type-available-p 'png)
1782 '("png"))
1783 (and (w3m-image-type-available-p 'xbm)
1784 '("xbm"))
1785 (and (w3m-image-type-available-p 'xpm)
1786 '("xpm")))
1787 t) ;; with surrounding parens (for old Emacsen).
1788 "\\'"))
1789 "*Cons of two regexps matching and not matching with local file names.
1790 If a url of the `file:' scheme in which you entered matches the first
1791 form and does not match the latter form, it will be opened by the
1792 function specified by the `w3m-local-find-file-function' variable.
1793 Nil for the regexp matches any file names.
1794
1795 For instance, the value `(nil . \"\\\\.[sx]?html?\\\\'\")' allows
1796 \"file:///some/where/w3m.el\", not \"file:///any/where/index.html\", to
1797 open by the function specified by `w3m-local-find-file-function'. The
1798 latter will be opened as a normal web page. Furthermore, if you would
1799 like to view some types of contents in the local system using the
1800 viewers specified by the `w3m-content-type-alist' variable, you can
1801 add regexps matching those file names to the second element of this
1802 variable. For example:
1803
1804 \(setq w3m-local-find-file-regexps
1805 '(nil . \"\\\\.\\\\(?:[sx]?html?\\\\|dvi\\\\|ps\\\\|pdf\\\\)\\\\'\"))
1806
1807 It is effective only when the `w3m-local-find-file-function' variable
1808 is set properly."
1809 :group 'w3m
1810 :type '(cons (radio :tag "Match"
1811 (const :format "All " nil)
1812 (regexp :format "%t: %v\n" :size 0))
1813 (radio :tag "Nomatch"
1814 (const :format "All " nil)
1815 (regexp :format "%t: %v\n" :size 0))))
1816
1817 (defcustom w3m-local-find-file-function
1818 '(if (w3m-popup-frame-p)
1819 'find-file-other-frame
1820 'find-file-other-window)
1821 "*Function used to open local files.
1822 If a url of the `file:' scheme in which you entered agrees with the
1823 rule of the `w3m-local-find-file-regexps' variable (which see), it is
1824 used to open the file.
1825
1826 Function should take one argument, the string naming the local file.
1827 It can also be any Lisp form returning a function. Set this to nil if
1828 you want to always use emacs-w3m to see local files."
1829 :group 'w3m
1830 :type '(sexp :size 0))
1831
1832 (defcustom w3m-local-directory-view-method 'w3m-cgi
1833 "*Symbol of the method to view a local directory tree.
1834 The valid values include `w3m-cgi' using the CGI program specified by
1835 the `w3m-dirlist-cgi-program' variable (which see), and `w3m-dtree'
1836 using the w3m-dtree Lisp module."
1837 :group 'w3m
1838 :type '(radio (const :format "Dirlist CGI " w3m-cgi)
1839 (const :tag "Directory tree" w3m-dtree)))
1840
1841 (defcustom w3m-dirlist-cgi-program
1842 (cond ((eq system-type 'windows-nt)
1843 "c:/usr/local/lib/w3m/dirlist.cgi")
1844 ((memq system-type '(OS/2 emx))
1845 (expand-file-name "dirlist.cmd" (getenv "W3M_LIB_DIR")))
1846 (t nil))
1847 "*Name of the CGI program to list a local directory.
1848 If it is nil, the dirlist.cgi module of the w3m command will be used."
1849 :group 'w3m
1850 :type `(radio
1851 (const :tag "w3m internal CGI" nil)
1852 (file :format "path of 'dirlist.cgi': %v\n"
1853 :size 0
1854 :value ,(if (not noninteractive)
1855 (expand-file-name
1856 (concat "../lib/"
1857 (file-name-nondirectory w3m-command)
1858 "/dirlist.cgi")
1859 (file-name-directory
1860 (w3m-which-command w3m-command)))))))
1861
1862 (defcustom w3m-add-referer
1863 (if (boundp 'w3m-add-referer-regexps)
1864 (symbol-value 'w3m-add-referer-regexps)
1865 (cons "\\`http:" "\\`http://\\(?:localhost\\|127\\.0\\.0\\.1\\)/"))
1866 "*Rule of sending referers.
1867 There are five choices as the valid values of this option.
1868
1869 \(1\) nil: this means that emacs-w3m never send referers.
1870 \(2\) t: this means that emacs-w3m always send referers.
1871 \(3\) lambda: this means that emacs-w3m send referers only when both
1872 the current page and the target page are provided by the same
1873 server.
1874 \(4\) a cons cell keeping two regular expressions: this means that
1875 emacs-w3m send referers when the url of the current page matches
1876 the first regular expression and does not match the second regular
1877 expression. Nil for the regexp matches any url.
1878 \(5\) a function: emacs-w3m send referers when this function which has
1879 two arguments, URL and REFERER, returns non-nil.
1880
1881 If you become nervous about leak of your private WEB browsing history,
1882 set `nil' or `lambda' to this option. When your computer belongs to a
1883 secret network, you may set a pair of regular expressions to inhibit
1884 sending referers which will disclose your private informations, as
1885 follows:
1886
1887 \(setq w3m-add-referer
1888 '(\"\\\\`http:\"
1889 . \"\\\\`http://\\\\(?:[^./]+\\\\.\\\\)*example\\\\.net/\")\)
1890 "
1891 :group 'w3m
1892 :type '(choice
1893 (const :tag "Never send referers" nil)
1894 (const :tag "Always send referers" t)
1895 (const :tag "Send referers when accessing the same server" lambda)
1896 (cons :tag "Send referers when URI matches:"
1897 (list :inline t :format "%v"
1898 (radio :indent 2 :sample-face underline
1899 :tag "Allow"
1900 (regexp :format "%t: %v\n" :size 0)
1901 (const :tag "Don't allow all" nil))
1902 (radio :indent 2 :sample-face underline
1903 :tag "Don't allow"
1904 (regexp :format "%t: %v\n" :size 0)
1905 (const :tag "Allow all" nil))))
1906 (function :tag "Send referers when your function returns non-nil")))
1907
1908 (defcustom w3m-touch-command (w3m-which-command "touch")
1909 "*Name of the executable file of the touch command.
1910 Note that the command is required to be able to modify file's
1911 timestamp with the `-t' option."
1912 :group 'w3m
1913 :type '(string :size 0))
1914
1915 (defcustom w3m-puny-utf-16be
1916 (cond
1917 ((w3m-find-coding-system 'utf-16-be-no-signature)
1918 'utf-16-be-no-signature)
1919 ((w3m-find-coding-system 'utf-16be)
1920 'utf-16be)
1921 (t nil))
1922 "*Coding system for PUNY coding. if nil, don't use PUNY code."
1923 :group 'w3m
1924 :type '(radio (coding-system :tag "UTF-16BE without BOM")
1925 (const "Don't use" nil)))
1926
1927 (defcustom w3m-uri-replace-alist
1928 '(("\\`gg:" w3m-search-uri-replace "google")
1929 ("\\`ggg:" w3m-search-uri-replace "google groups")
1930 ("\\`ya:" w3m-search-uri-replace "yahoo")
1931 ("\\`al:" w3m-search-uri-replace "altavista")
1932 ("\\`bts:" w3m-search-uri-replace "debian-bts")
1933 ("\\`dpkg:" w3m-search-uri-replace "debian-pkg")
1934 ("\\`archie:" w3m-search-uri-replace "iij-archie")
1935 ("\\`alc:" w3m-search-uri-replace "alc")
1936 ("\\`urn:ietf:rfc:\\([0-9]+\\)" w3m-pattern-uri-replace
1937 "http://www.ietf.org/rfc/rfc\\1.txt"))
1938 "*Alist of regexps matching URIs, and some types of replacements.
1939 It can be used universally to replace URI strings in the local rule to
1940 the valid forms in the Internet.
1941
1942 Each element looks like the `(REGEXP FUNCTION OPTIONS...)' form.
1943 FUNCTION takes one or more arguments, a uri and OPTIONS. You can use
1944 the grouping constructs \"\\\\(...\\\\)\" in REGEXP, and they can be
1945 referred by the \"\\N\" forms in a replacement (which is one of OPTIONS).
1946
1947 Here are some predefined functions which can be used for those ways:
1948
1949 `w3m-pattern-uri-replace'
1950 Replace a URI using PATTERN (which is just an OPTION). It is
1951 allowed that PATTERN contains the \"\\N\" forms in the same manner
1952 of `replace-match'.
1953
1954 `w3m-search-uri-replace'
1955 Generate the valid forms to query words to some specified search
1956 engines. For example, the element
1957
1958 (\"\\\\`gg:\" w3m-search-uri-replace \"google\")
1959
1960 makes it possible to replace the URI \"gg:emacs\" to the form to
1961 query the word \"emacs\" to the Google site.\
1962 "
1963 :group 'w3m
1964 :type '(repeat
1965 :convert-widget w3m-widget-type-convert-widget
1966 `((choice
1967 :format "%[Value Menu%] %v" :tag "Replacing URI with"
1968 (list :indent 4 :tag "Replacement Using Pattern"
1969 (regexp :format "%t: %v\n" :size 0)
1970 (function-item :format "" w3m-pattern-uri-replace)
1971 (string :format "Pattern: %v\n" :size 0))
1972 (list :format "%t:\n%v" :indent 4 :tag "Quick Search"
1973 (regexp :format "Prefix URI %t: %v\n"
1974 :size 0 :value "")
1975 (function-item :format "" w3m-search-uri-replace)
1976 (string :format "Quick Search Engine: %v\n"
1977 :size 0 :value ""))
1978 ,@(progn
1979 (require 'w3m-search)
1980 (mapcar
1981 (lambda (elem)
1982 (let* ((engine (car elem))
1983 (prefix (mapconcat 'identity
1984 (split-string (downcase engine))
1985 "-")))
1986 `(list
1987 :format "Quick Search:\n%v"
1988 :indent 4
1989 :tag ,(concat "Quick Search: " prefix)
1990 (regexp :tag "Prefix URL Regexp"
1991 ,(concat "\\`" (regexp-quote prefix) ":"))
1992 (function-item :format "" w3m-search-uri-replace)
1993 (string :tag "Quick Search Engine" ,engine))))
1994 w3m-search-engine-alist))
1995 (list :indent 4 :tag "User Defined Function"
1996 (regexp :format "%t: %v\n" :size 0)
1997 (function
1998 :format "%t: %v\n" :size 0
1999 ;; Fix a bug in Emacs versions prior to 22.
2000 :value-to-internal
2001 (lambda (widget value)
2002 (if (stringp value)
2003 (if (string-match "\\`\".*\"\\'" value)
2004 (substring value 1 -1)
2005 value)
2006 (prin1-to-string value))))
2007 (repeat :extra-offset 2 :tag "Options"
2008 (sexp :format "%t: %v\n" :size 0)))))))
2009
2010 (defcustom w3m-relationship-estimate-rules
2011 `((w3m-relationship-simple-estimate
2012 "\\`http://\\(?:www\\|blogsearch\\|groups\\|news\\|images\\)\
2013 \\.google\\.[^/]+/\\(?:\\(?:blog\\|code\\)?search\\|groups\\|news\\|images\
2014 \\|cse\\?cx=\\|custom\\?\\(?:q\\|hl\\)=\\)"
2015 ,(concat "<a[^>]+?href=" w3m-html-string-regexp "[^>]*>[\t\n ]*"
2016 "\\(?:\\(?:</?span[^>]*>[\t\n ]*\\)*<span[^>]+>Next</span>"
2017 "\\|\\(?:</?span[^>]*>[\t\n ]*\\)*"
2018 "<b>\\(?:\e$B2<0lJG\e(B\\|\e$B<!$X\e(B\\|\e$(C4Y@=\e(B\\)</b>\\)")
2019 ,(concat "<a[^>]+?href=" w3m-html-string-regexp "[^>]*>[\t\n ]*"
2020 "\\(?:\\(?:</?span[^>]*>[\t\n ]*\\)*<span[^>]+>Previous</span>"
2021 "\\|\\(?:</?span[^>]*>[\t\n ]*\\)*"
2022 "<b>\\(?:\e$B>e0lJG\e(B\\|\e$BA0$X\e(B\\|\e$(C@L@|\e(B\\)</b>\\)")
2023 nil nil)
2024 (w3m-relationship-simple-estimate
2025 "\\`http://www\\.google\\.[^/]+/gwt/n\\?u="
2026 ,(concat "<a[^>]+?href=" w3m-html-string-regexp
2027 "[ \t\n]+accesskey=\"3\">")
2028 ,(concat "<a[^>]+?href=" w3m-html-string-regexp
2029 "[ \t\n]+accesskey=\"1\">")
2030 nil nil)
2031 (w3m-relationship-simple-estimate
2032 "\\`http://beta\\.search\\.yahoo\\.co\\.jp/"
2033 ,(concat "<a href=" w3m-html-string-regexp
2034 "><img src=http://i\\.yimg\\.jp/images/common/ar_next\\.gif")
2035 ,(concat "<a href=" w3m-html-string-regexp
2036 "><img src=http://i\\.yimg\\.jp/images/common/ar_prev\\.gif")
2037 nil nil)
2038 (w3m-relationship-simple-estimate
2039 "\\`http://www\\.zdnet\\.co\\.jp/news/"
2040 ,(concat "<a href=" w3m-html-string-regexp ">\e$B<!$N%Z!<%8\e(B</a>")
2041 ,(concat "<a href=" w3m-html-string-regexp ">\e$BA0$N%Z!<%8\e(B</a>")
2042 nil nil)
2043 (w3m-relationship-simple-estimate
2044 "\\`http://freshmeat\\.net/\\(search\\|browse\\)/"
2045 ,(concat "<A HREF=" w3m-html-string-regexp ">\\[&raquo;\\]</A>")
2046 ,(concat "<A HREF=" w3m-html-string-regexp ">\\[&laquo;\\]</A>")
2047 nil nil)
2048 (w3m-relationship-oddmuse-estimate)
2049 (w3m-relationship-magicpoint-estimate)
2050 (w3m-relationship-slashdot-estimate)
2051 (w3m-relationship-alc-estimate))
2052 "*Rules to estimate relationships between a retrieved page and others."
2053 :group 'w3m
2054 :type '(repeat
2055 (choice
2056 :format "%[Value Menu%] %v"
2057 (list :tag "Estimate relationships from anchors matching"
2058 :indent 1
2059 (const :format "Function: %v\n"
2060 w3m-relationship-simple-estimate)
2061 (regexp :tag "URL")
2062 (regexp :tag "Next")
2063 (regexp :tag "Prev")
2064 (radio :format "Start: %v"
2065 (const :format "%v " nil) regexp)
2066 (radio :format "Contents: %v"
2067 (const :format "%v " nil) regexp))
2068 (list :tag "Estimate with a user defined function"
2069 :indent 1
2070 function
2071 (repeat :tag "Args" :extra-offset 1 (sexp :format "%v"))))))
2072
2073 (defcustom w3m-enable-google-feeling-lucky t
2074 "Non-nil enables you to enter any words as well as a url when prompted.
2075 In that case, emacs-w3m uses Google to search for the words."
2076 :group 'w3m
2077 :type 'boolean)
2078
2079 (defcustom w3m-google-feeling-lucky-charset
2080 (cond
2081 ((or (featurep 'un-define) (fboundp 'utf-translate-cjk-mode))
2082 "UTF-8")
2083 ((equal "Japanese" w3m-language)
2084 "SHIFT_JIS")
2085 ((w3m-find-coding-system 'utf-8)
2086 "UTF-8")
2087 (t "US-ASCII"))
2088 "*Character set for \"I'm Feeling Lucky on Google\"."
2089 :group 'w3m
2090 :type '(string :size 0))
2091
2092 (defconst w3m-entity-table
2093 (let ((table (make-hash-table :test 'equal)))
2094 (dolist (entity '(("nbsp" . " ")
2095 ("gt" . ">")
2096 ("lt" . "<")
2097 ("amp" . "&")
2098 ("quot" . "\"")
2099 ("apos" . "'")
2100 ("circ" . "^")
2101 ("tilde" . "~")))
2102 (puthash (car entity) (cdr entity) table))
2103 (dolist (entity
2104 '(;("nbsp" . 160)
2105 ("iexcl" . 161) ("cent" . 162) ("pound" . 163) ("curren" . 164)
2106 ("yen" . 165) ("brvbar" . 166) ("sect" . 167) ("uml" . 168)
2107 ("copy" . 169) ("ordf" . 170) ("laquo" . 171) ("not" . 172)
2108 ("shy" . 173) ("reg" . 174) ("macr" . 175) ("deg" . 176)
2109 ("plusmn" . 177) ("sup2" . 178) ("sup3" . 179) ("acute" . 180)
2110 ("micro" . 181) ("para" . 182) ("middot" . 183) ("cedil" . 184)
2111 ("sup1" . 185) ("ordm" . 186) ("raquo" . 187) ("frac14" . 188)
2112 ("frac12" . 189) ("frac34" . 190) ("iquest" . 191)
2113 ("Agrave" . 192) ("Aacute" . 193) ("Acirc" . 194)
2114 ("Atilde" . 195) ("Auml" . 196) ("Aring" . 197) ("AElig" . 198)
2115 ("Ccedil" . 199) ("Egrave" . 200) ("Eacute" . 201)
2116 ("Ecirc" . 202) ("Euml" . 203) ("Igrave" . 204) ("Iacute" . 205)
2117 ("Icirc" . 206) ("Iuml" . 207) ("ETH" . 208) ("Ntilde" . 209)
2118 ("Ograve" . 210) ("Oacute" . 211) ("Ocirc" . 212)
2119 ("Otilde" . 213) ("Ouml" . 214) ("times" . 215) ("Oslash" . 216)
2120 ("Ugrave" . 217) ("Uacute" . 218) ("Ucirc" . 219) ("Uuml" . 220)
2121 ("Yacute" . 221) ("THORN" . 222) ("szlig" . 223) ("agrave" . 224)
2122 ("aacute" . 225) ("acirc" . 226) ("atilde" . 227) ("auml" . 228)
2123 ("aring" . 229) ("aelig" . 230) ("ccedil" . 231) ("egrave" . 232)
2124 ("eacute" . 233) ("ecirc" . 234) ("euml" . 235) ("igrave" . 236)
2125 ("iacute" . 237) ("icirc" . 238) ("iuml" . 239) ("eth" . 240)
2126 ("ntilde" . 241) ("ograve" . 242) ("oacute" . 243)
2127 ("ocirc" . 244) ("otilde" . 245) ("ouml" . 246) ("divide" . 247)
2128 ("oslash" . 248) ("ugrave" . 249) ("uacute" . 250)
2129 ("ucirc" . 251) ("uuml" . 252) ("yacute" . 253) ("thorn" . 254)
2130 ("yuml" . 255)))
2131 (puthash (car entity)
2132 (char-to-string (make-char 'latin-iso8859-1 (cdr entity)))
2133 table))
2134 (dolist (entity
2135 '(("Alpha" . 65) ("Beta" . 66) ("Gamma" . 67) ("Delta" . 68)
2136 ("Epsilon" . 69) ("Zeta" . 70) ("Eta" . 71) ("Theta" . 72)
2137 ("Iota" . 73) ("Kappa" . 74) ("Lambda" . 75) ("Mu" . 76)
2138 ("Nu" . 77) ("Xi" . 78) ("Omicron" . 79) ("Pi" . 80)
2139 ("Rho" . 81) ; No ("Sigmaf" . 82)
2140 ("Sigma" . 83) ("Tau" . 84) ("Upsilon" . 85) ("Phi" . 86)
2141 ("Chi" . 87) ("Psi" . 88) ("Omega" . 89)
2142 ("alpha" . 97) ("beta" . 98) ("gamma" . 99) ("delta" . 100)
2143 ("epsilon" . 101) ("zeta" . 102) ("eta" . 103) ("theta" . 104)
2144 ("iota" . 105) ("kappa" . 106) ("lambda" . 107) ("mu" . 108)
2145 ("nu" . 109) ("xi" . 110) ("omicron" . 111) ("pi" . 112)
2146 ("rho" . 113) ("sigmaf" . 114) ("sigma" . 115) ("tau" . 116)
2147 ("upsilon" . 117) ("phi" . 118) ("chi" . 119) ("psi" . 120)
2148 ("omega" . 121)))
2149 (puthash (car entity)
2150 (char-to-string (make-char 'greek-iso8859-7 (cdr entity)))
2151 table))
2152 (when (w3m-mule-unicode-p)
2153 (let ((latin-extended-a
2154 '((32 . (("OElig" . 114) ("oelig" . 115)))
2155 (33 . (("Scaron" . 32) ("scaron" . 33) ("Yuml" . 56)))))
2156 (latin-extended-b '((33 . (("fnof" . 82)))))
2157 ;;(spacing-modifier-letters '(36 . (("circ" . 120) ("tilde" . 124))))
2158 (general-punctuation
2159 '((114 .
2160 (("ensp" . 98) ("emsp" . 99) ("thinsp" . 105) ("zwnj" . 108)
2161 ("zwj" . 109) ("lrm" . 110) ("rlm" . 111) ("ndash" . 115)
2162 ("mdash" . 116) ("lsquo" . 120) ("rsquo" . 121)
2163 ("sbquo" . 122) ("ldquo" . 124) ("rdquo" . 125)
2164 ("bdquo" . 126)))
2165 (115 .
2166 (("dagger" . 32) ("Dagger" . 33) ("permil" . 48)
2167 ("lsaquo" . 57) ("rsaquo" . 58)
2168 ("bull" . 34) ("hellip" . 38) ("prime" . 50) ("Prime" . 51)
2169 ("oline" . 62) ("frasl" . 68)))
2170 (116 .
2171 (("euro" . 76)))))
2172 (greek '((39 . (("thetasym" . 81) ("upsih" . 82) ("piv" . 86)))))
2173 (letterlike-symbols
2174 '((117 .
2175 (("weierp" . 88) ("image" . 81) ("real" . 92)
2176 ("trade" . 98) ("alefsym" . 117)))))
2177 (arrows
2178 '((118 .
2179 (("larr" . 112) ("uarr" . 113) ("rarr" . 114) ("darr" . 115)
2180 ("harr" . 116)))
2181 (119 .
2182 (("crarr" . 53) ("lArr" . 80) ("uArr" . 81) ("rArr" . 81)
2183 ("dArr" . 83) ("hArr" . 84)))))
2184 (mathematical-operators
2185 '((120 .
2186 (("forall" . 32) ("part" . 34) ("exist" . 35) ("empty" . 37)
2187 ("nabla" . 39) ("isin" . 40) ("notin" . 41) ("ni" . 43)
2188 ("prod" . 47) ("sum" . 49) ("minus" . 50) ("lowast" . 55)
2189 ("radic" . 58) ("prop" . 61) ("infin" . 62) ("ang" . 64)
2190 ("and" . 71) ("or" . 72) ("cap" . 73) ("cup" . 74)
2191 ("int" . 75) ("there4" . 84) ("sim" . 92) ("cong" . 101)
2192 ("asymp" . 104)))
2193 (121 .
2194 (("ne" . 32) ("equiv" . 33) ("le" . 36) ("ge" . 37)
2195 ("sub" . 66) ("sup" . 67) ("nsub" . 68) ("sube" . 70)
2196 ("supe" . 71) ("oplus" . 85) ("otimes" . 87)
2197 ("perp" . 101)))
2198 (122 . (("sdot" . 37)))))
2199 (miscellaneous-technical
2200 '((122 . (("lceil" . 104) ("rceil" . 105) ("lfloor" . 106)
2201 ("rfloor" . 107)))
2202 (123 . (("lang" . 41) ("rang" . 42)))))
2203 (suit
2204 '(("loz" . (34 . 42)) ("spades" . (35 . 96)) ("clubs" . (35 . 99))
2205 ("hearts" . (35 . 101)) ("diams" . (35 . 102)))))
2206 (dolist (entities `(,@latin-extended-a
2207 ,@latin-extended-b
2208 ,@general-punctuation
2209 ,@greek ,@letterlike-symbols ,@arrows
2210 ,@mathematical-operators
2211 ,@miscellaneous-technical))
2212 (let ((code1 (car entities)))
2213 (dolist (entity (cdr entities))
2214 (puthash (car entity)
2215 (char-to-string
2216 (make-char 'mule-unicode-0100-24ff
2217 code1 (cdr entity)))
2218 table))))
2219 (dolist (entity suit)
2220 (puthash (car entity)
2221 (char-to-string
2222 (make-char 'mule-unicode-2500-33ff
2223 (car (cdr entity)) (cdr (cdr entity))))
2224 table))))
2225 table)
2226 "Table of html character entities and values.")
2227
2228 (defvar w3m-extra-numeric-character-reference
2229 (mapcar
2230 (lambda (item)
2231 (cons (car item) (string (w3m-ucs-to-char (cdr item)))))
2232 '((#x80 . #x20AC) (#x82 . #x201A) (#x83 . #x0192) (#x84 . #x201E)
2233 (#x85 . #x2026) (#x86 . #x2020) (#x87 . #x2021) (#x88 . #x02C6)
2234 (#x89 . #x2030) (#x8A . #x0160) (#x8B . #x2039) (#x8C . #x0152)
2235 (#x8E . #x017D) (#x91 . #x2018) (#x92 . #x2019) (#x93 . #x201C)
2236 (#x94 . #x201D) (#x95 . #x2022) (#x96 . #x2013) (#x97 . #x2014)
2237 (#x98 . #x02DC) (#x99 . #x2122) (#x9A . #x0161) (#x9B . #x203A)
2238 (#x9C . #x0153) (#x9E . #x017E) (#x9F . #x0178)))
2239 "*Alist of (numeric . string) pairs for numeric character reference
2240 other than ISO 10646.")
2241
2242 (defconst w3m-entity-reverse-table
2243 (let ((table (make-hash-table :test 'equal)))
2244 (maphash (lambda (key val) (puthash val key table))
2245 w3m-entity-table)
2246 table)
2247 "Revision table of html character entities and values.")
2248
2249 (defconst w3m-entity-regexp
2250 (let (buf)
2251 (maphash (lambda (key val) (push key buf))
2252 w3m-entity-table)
2253 (concat "&\\("
2254 (let ((max-specpdl-size (* 1024 1024))) ;; For old Emacsen.
2255 (regexp-opt buf))
2256 "\\|#\\(?:[xX][0-9a-fA-F]+\\|[0-9]+\\)\\)\\(\\'\\|[^0-9a-zA-Z]\\)"))
2257 "Regexp matching html character entities.")
2258
2259 (defconst w3m-encoding-alist
2260 (eval-when-compile
2261 (apply 'nconc
2262 (mapcar (lambda (elem)
2263 (mapcar (lambda (x) (cons x (car elem)))
2264 (cdr elem)))
2265 '((gzip . ("gzip" "x-gzip" "compress" "x-compress"))
2266 (bzip . ("x-bzip" "bzip" "bzip2"))
2267 (deflate . ("x-deflate" "deflate"))))))
2268 "Alist of content encoding types and decoder symbols.
2269 Decoders are specified by `w3m-decoder-alist' (which see).")
2270
2271 (defconst w3m-emacs-w3m-icon "\
2272 R0lGODlhUwAOAPIAAFUq/H8AvwC/AP8AAAAAv79/Af///wAAACH/C05FVFNDQVBFMi4wAwEA
2273 AAAh+QQAIQD/ACwAAAAAUwAOAAADxmi63P4wykmrvXiWvbP/4NIpY2ieUFlSQRssrRG7DGET
2274 DQEAzL5PAoEiSCo0RoOBIblkKmKyV/RFsymsBqzh99vyvBKiYbQaG5vKZFoZfUqhUO0C2613
2275 gUJzsVhy+tkuNG2DWjd0Xw0+iEGMYgJGHWVjbH8KTlAMcThZm1iHEYwakKMOlU2WgFKZUp6d
2276 m3YKdwtiEmRnfZS5qG5Ub6yuVzg+C1xfAES0EbZ7u6fOTlOqrcFzxcSyjRXLqGoLptAo4eLj
2277 5OUNCQAh+QQAIQD/ACwAAAAAUwAOAAADImi63P4wykmrvTjrzbv/YCiOZGmeaKqubOu+cCzP
2278 dG3fagIAIfkEACEA/wAsAAAAAFMADgAAAz5outz+MMpJq7046827/2AYBWSwkAZaimyFpiZs
2279 rm0tvXj82rxT0rmekLE7xYZIRVF5TA5XQWfyJ61ar9hsAgAh+QQAIQD/ACwAAAAAUwAOAAAD
2280 Vmi63P4wykmrvTjrzbv/YBgFZLCQBloyREs0rxiiqVmba6voBi//tKCN5lsUf7OSUEGM9VxO
2281 ZNLR3MV4R6mHxqg+rVrpavktZ8MgpfHKNqLf8Lh8XkkAACH5BAAhAP8ALAAAAABTAA4AAANw
2282 aLrc/jDKSau9OOvNu/9gGAVksJAGWjJESzQEADCyLGJoaurm2io/Q9BgsxFnx5slx9zlhoug
2283 cWpULktNxfMFdHGrtJq1kmNsu2jhFznulE+7oHytoLY1q6w6/RPXZ1N3F1hRXHNRRWx+goyN
2284 jo+QCQAh+QQAIQD/ACwAAAAAUwAOAAADhWi63P4wykmrvTjrzbv/YBgFZLCQBloyREs0BAAw
2285 sjwJgoKHaGr6plVLMTQUDTYbcraU7ESKnvTXOy6KyqzyloMCV77o7+jCMhu1M2797EJ7jOrL
2286 OC+aI2tvBX4a1/8KWoFnC096EitTRIB0S2dJTAA7hocjYI2YZJALNQxslaChoqOkDgkAIfkE
2287 ACEA/wAsAAAAAFMADgAAA6doutz+MMpJq714lr2z/+DSKWNonlBZUkEbLK0RuwxhEw0BAMy+
2288 TwKBIkgqNFaSmOy1fNFsCqhBavj9qjyshGgYIZERpZippC6k1/QVKOwa3UVw2DVWlHHRG37d
2289 8y2CgFwCRh1gbxVKDHd5jFN7WQ+AGoSUJokwTFKajwpqDlwSXm9yLDNkmXibWJBWWQBEoBGi
2290 RSB0Z6m4Z60Lfn+SFLMowsPExcbFCQAh+QQAIQD/ACwAAAAAUwAOAAADxmi63P4wykmrvXiW
2291 vbP/4NIpY2ieUFlSQRssrRG7DGETDQEAzL5PAoEiSCo0RoOBIblkKmKyV/RFsymsBqzh99vy
2292 vBKiYbQaG5vKZFoZfUqhUO0C2613gUJzsVhy+tkuNG2DWjd0Xw0+iEGMYgJGHWVjbH8KTlAM
2293 cThZm1iHEYwakKMOlU2WgFKZUp6dm3YKdwtiEmRnfZS5qG5Ub6yuVzg+C1xfAES0EbZ7u6fO
2294 TlOqrcFzxcSyjRXLqGoLptAo4eLj5OUNCQA7"
2295 "A small image to be displayed in the about: page.
2296 It is encoded in the optimized interlaced endlessly animated gif format
2297 and base64. Emacs can display only the 1st frame of an animation, but
2298 XEmacs can fully display it with the help of the gifsicle program.")
2299
2300 (defcustom w3m-process-modeline-format " loaded: %s"
2301 "*Format used when displaying the progress of the external w3m process.
2302 It shows a percentage of the data loaded from the web server."
2303 :group 'w3m
2304 :type '(choice (string :tag "Format") function))
2305
2306 (defcustom w3m-ignored-image-url-regexp nil
2307 "*Regexp matching image urls which you don't want to view.
2308 It is effective even if `w3m-display-inline-images' is non-nil.
2309 For instance, the value \"^http://www\\.google\\.com/\" conceals
2310 Google's logo and navigation images, but display YouTube's
2311 thumbnail."
2312 :group 'w3m
2313 :type '(radio (const :format "Accept any image\n" nil)
2314 (regexp :format "URL regexp: %v\n" :size 0)))
2315
2316 (defcustom w3m-refresh-minimum-interval 60
2317 "*Minimum seconds to wait for refresh, when visiting a page by
2318 history-back or history-next."
2319 :group 'w3m
2320 :type '(integer :size 0))
2321
2322 (defvar w3m-modeline-process-status-on "<PRC>"
2323 "Modeline control for displaying the status when the process is running.
2324 The value will be modified for displaying the graphic icon.")
2325
2326 (defvar w3m-modeline-image-status-on "[IMG]"
2327 "Modeline control to display the status when inline images are turned on.
2328 The value will be modified for displaying the graphic icon.")
2329
2330 (defvar w3m-modeline-status-off "[ - ]"
2331 "Modeline control for displaying the status for the default.
2332 The value will be modified for displaying the graphic icon.")
2333
2334 (defvar w3m-modeline-ssl-image-status-on "[IMG(SSL)]"
2335 "Modeline control for displaying the status when images and SSL are on.
2336 The value will be modified for displaying the graphic icon.")
2337
2338 (defvar w3m-modeline-ssl-status-off "[SSL]"
2339 "Modeline control for displaying the status when SSL is turned on.
2340 The value will be modified for displaying the graphic icon.")
2341
2342 (defvar w3m-modeline-separator " / "
2343 "String used to separate a status and a title in the modeline.")
2344
2345 (defvar w3m-modeline-favicon nil
2346 "Modeline control for displaying a favicon.
2347 This variable will be made buffer-local.")
2348
2349 (defvar w3m-favicon-image nil
2350 "Favicon image of the page.
2351 This variable will be made buffer-local")
2352
2353 (defvar w3m-current-process nil
2354 "Flag used to say whether the external process is running in the buffer.
2355 This variable will be made buffer-local.")
2356 (make-variable-buffer-local 'w3m-current-process)
2357
2358 (defvar w3m-refresh-timer nil
2359 "Variable used to keep a timer object for refreshing a page.
2360 It will be supplied by the REFRESH attribute in the META tag, and made
2361 buffer-local in each emacs-w3m buffer.")
2362 (make-variable-buffer-local 'w3m-refresh-timer)
2363
2364 (defvar w3m-mail-user-agents '(gnus-user-agent
2365 message-user-agent
2366 mew-user-agent
2367 vm-user-agent
2368 wl-user-agent)
2369 "List of mail user agents that `w3m-mail' supports.
2370 See also w3m-mail.el.")
2371
2372 (defvar w3m-current-base-url nil
2373 "URL specified by <base...> tag in <head> element of the page source.")
2374 (defvar w3m-current-forms nil
2375 "Variable used to keep forms data for the current emacs-w3m buffer.")
2376 (defvar w3m-current-coding-system nil
2377 "Coding system used when decoding the current emacs-w3m buffer.")
2378 (defvar w3m-current-content-charset nil
2379 "Content charset of the page specified by the server or the META tag.")
2380 (defvar w3m-icon-data nil
2381 "Cons of icon data and its image-type for the current emacs-w3m buffer.
2382 It is used for favicon data. The type is often `ico'.")
2383 (defvar w3m-next-url nil
2384 "URL as the next document in the author-defined sequence.")
2385 (defvar w3m-previous-url nil
2386 "URL as the previous document in the author-defined sequence.")
2387 (defvar w3m-start-url nil
2388 "URL as the first document in the author-defined sequence.")
2389 (defvar w3m-contents-url nil
2390 "URL as the table of contents for the current page.")
2391 (defvar w3m-max-anchor-sequence nil
2392 "Maximum number of the anchor sequence in the current page.")
2393 (defvar w3m-current-refresh nil
2394 "Cons of number of seconds and a url specified by the REFRESH attribute.")
2395 (defvar w3m-current-ssl nil
2396 "SSL certification indicator for the current emacs-w3m buffer.")
2397 (defvar w3m-name-anchor-from-hist nil
2398 "List of the points of where `w3m-search-name-anchor' come from.")
2399
2400 (make-variable-buffer-local 'w3m-current-url)
2401 (make-variable-buffer-local 'w3m-current-base-url)
2402 (make-variable-buffer-local 'w3m-current-title)
2403 (make-variable-buffer-local 'w3m-current-forms)
2404 (make-variable-buffer-local 'w3m-current-coding-system)
2405 (make-variable-buffer-local 'w3m-current-content-charset)
2406 (make-variable-buffer-local 'w3m-icon-data)
2407 (make-variable-buffer-local 'w3m-next-url)
2408 (make-variable-buffer-local 'w3m-previous-url)
2409 (make-variable-buffer-local 'w3m-start-url)
2410 (make-variable-buffer-local 'w3m-contents-url)
2411 (make-variable-buffer-local 'w3m-max-anchor-sequence)
2412 (make-variable-buffer-local 'w3m-current-refresh)
2413 (make-variable-buffer-local 'w3m-current-ssl)
2414 (make-variable-buffer-local 'w3m-name-anchor-from-hist)
2415
2416 (defun w3m-clear-local-variables ()
2417 (setq w3m-current-url nil
2418 w3m-current-base-url nil
2419 w3m-current-title nil
2420 w3m-current-coding-system nil
2421 w3m-current-content-charset nil
2422 w3m-icon-data nil
2423 w3m-next-url nil
2424 w3m-previous-url nil
2425 w3m-start-url nil
2426 w3m-contents-url nil
2427 w3m-max-anchor-sequence nil
2428 w3m-current-refresh nil
2429 w3m-current-ssl nil
2430 w3m-name-anchor-from-hist nil))
2431
2432 (defun w3m-copy-local-variables (from-buffer)
2433 (let (url base title cs char icon next prev start toc hseq refresh ssl)
2434 (with-current-buffer from-buffer
2435 (setq url w3m-current-url
2436 base w3m-current-base-url
2437 title w3m-current-title
2438 cs w3m-current-coding-system
2439 char w3m-current-content-charset
2440 icon w3m-icon-data
2441 next w3m-next-url
2442 prev w3m-previous-url
2443 start w3m-start-url
2444 toc w3m-contents-url
2445 hseq w3m-max-anchor-sequence
2446 refresh w3m-current-refresh
2447 ssl w3m-current-ssl))
2448 (setq w3m-current-url url
2449 w3m-current-base-url base
2450 w3m-current-title title
2451 w3m-current-coding-system cs
2452 w3m-current-content-charset char
2453 w3m-icon-data icon
2454 w3m-next-url next
2455 w3m-previous-url prev
2456 w3m-start-url start
2457 w3m-contents-url toc
2458 w3m-max-anchor-sequence hseq
2459 w3m-current-refresh refresh
2460 w3m-current-ssl ssl)))
2461
2462 (defvar w3m-verbose nil
2463 "*Flag controls whether to log messages in the *Messages* buffer.
2464 If it is nil, a lot of messages issued by emacs-w3m will be displayed
2465 only in the echo area.")
2466
2467 (defvar w3m-safe-url-regexp nil
2468 "Regexp matching urls which are considered to be safe.
2469 The nil value means all urls are considered to be safe.
2470
2471 Note: The value, that might be bound to a certain value while rendering
2472 contents, will be held by the `w3m-safe-url-regexp' text property that
2473 is set over the rendered contents in a buffer. So, programs that use
2474 the value to test whether a url of a link in a buffer is safe should
2475 use the value of the text property, not the value of this variable.
2476 See the function definitions of `w3m-toggle-inline-image',
2477 `w3m-toggle-inline-images', `w3m-safe-view-this-url', and
2478 `w3m-mouse-safe-view-this-url'.")
2479
2480 (defvar w3m-current-buffer nil)
2481 (defvar w3m-cache-buffer nil)
2482 (defvar w3m-cache-articles nil)
2483 (defvar w3m-cache-hashtb nil)
2484 (defvar w3m-input-url-history nil)
2485
2486 (defconst w3m-arrived-db-size 1023)
2487 (defvar w3m-arrived-db nil
2488 "Hash table, the arrived URLs database.
2489 The name of each symbol represents a url, the arrival time in the
2490 Emacs style (a list of three integers) is stored as the value, and
2491 informations including a title, a modification time, a content charset
2492 and a content type are stored as the properties of the symbol. The
2493 nil value means it has not been initialized.")
2494
2495 (defvar w3m-arrived-setup-functions nil
2496 "Hook functions run after setting up the arrived URLs database.")
2497 (defvar w3m-arrived-shutdown-functions nil
2498 "Hook functions run after saving the arrived URLs database.")
2499
2500 (defconst w3m-image-type-alist
2501 '(("image/jpeg" . jpeg)
2502 ("image/gif" . gif)
2503 ("image/png" . png)
2504 ("image/x-xbm" . xbm)
2505 ("image/x-xpm" . xpm))
2506 "Alist of content types and image types defined as the Emacs' features.")
2507
2508 (defconst w3m-toolbar-buttons
2509 '("back" "parent" "forward" "reload" "open" "home" "search" "image"
2510 "copy" "weather" "antenna" "history" "db-history")
2511 "List of prefix strings for the toolbar buttons.")
2512
2513 (defconst w3m-toolbar
2514 (if (equal "Japanese" w3m-language)
2515 (let ((a (decode-coding-string "\e$B%\"\e(B" 'iso-2022-jp))) ;; \e$B%"\e(B
2516 `([w3m-toolbar-back-icon w3m-view-previous-page
2517 (w3m-history-previous-link-available-p)
2518 "\e$BA0$N%Z!<%8$KLa$k\e(B"]
2519 [w3m-toolbar-parent-icon w3m-view-parent-page
2520 (w3m-parent-page-available-p)
2521 "\e$B>e$N%G%#%l%/%H%j$X0\F0$9$k\e(B"]
2522 [w3m-toolbar-forward-icon w3m-view-next-page
2523 (w3m-history-next-link-available-p)
2524 "\e$B<!$N%Z!<%8$K?J$`\e(B"]
2525 [w3m-toolbar-reload-icon w3m-reload-this-page
2526 w3m-current-url
2527 "\e$B%5!<%P$+$i%Z!<%8$r$b$&0lEYFI$_9~$`\e(B"]
2528 [w3m-toolbar-open-icon w3m-goto-url t "URL \e$B$rF~NO$7$F%Z!<%8$r3+$/\e(B"]
2529 [w3m-toolbar-home-icon w3m-gohome w3m-home-page
2530 "\e$B%[!<%`%Z!<%8$X%8%c%s%W\e(B"]
2531 [w3m-toolbar-search-icon w3m-search t "\e$B%$%s%?!<%M%C%H>e$r8!:w\e(B"]
2532 [w3m-toolbar-image-icon w3m-toggle-inline-images t
2533 "\e$B2hA|$NI=<($r%H%0%k$9$k\e(B"]
2534 [w3m-toolbar-copy-icon w3m-copy-buffer t
2535 "\e$B$3$N%;%C%7%g%s$N%3%T!<$r:n$k\e(B"]
2536 [w3m-toolbar-weather-icon w3m-weather t "\e$BE75$M=Js$r8+$k\e(B"]
2537 [w3m-toolbar-antenna-icon w3m-antenna t
2538 ,(concat a "\e$B%s%F%J$G<u?.$9$k\e(B")]
2539 [w3m-toolbar-history-icon w3m-history t "\e$B%R%9%H%j!<\e(B"]
2540 [w3m-toolbar-db-history-icon w3m-db-history t
2541 "\e$B2a5n$KK,Ld$7$?\e(B URL \e$B$NMzNr$r8+$k\e(B"]))
2542 '([w3m-toolbar-back-icon w3m-view-previous-page
2543 (w3m-history-previous-link-available-p)
2544 "Back to Previous Page"]
2545 [w3m-toolbar-parent-icon w3m-view-parent-page
2546 (w3m-parent-page-available-p)
2547 "View the parent page"]
2548 [w3m-toolbar-forward-icon w3m-view-next-page
2549 (w3m-history-next-link-available-p)
2550 "Forward to Next Page"]
2551 [w3m-toolbar-reload-icon w3m-reload-this-page
2552 w3m-current-url
2553 "Reload This Page"]
2554 [w3m-toolbar-open-icon w3m-goto-url t "Go to..."]
2555 [w3m-toolbar-home-icon w3m-gohome w3m-home-page "Go to Home Page"]
2556 [w3m-toolbar-search-icon w3m-search t "Search the Internet"]
2557 [w3m-toolbar-image-icon w3m-toggle-inline-images t "Toggle Images"]
2558 [w3m-toolbar-copy-icon w3m-copy-buffer t "Make a Copy of This Session"]
2559 [w3m-toolbar-weather-icon w3m-weather t "Weather Forecast"]
2560 [w3m-toolbar-antenna-icon w3m-antenna t "Investigate with Antenna"]
2561 [w3m-toolbar-history-icon w3m-history t "Show a History"]
2562 [w3m-toolbar-db-history-icon w3m-db-history t "View Arrived URLs"]))
2563 "Toolbar definition for emacs-w3m.")
2564
2565 ;; "View" is page viewing
2566 ;; "Show" is link list showing
2567 (defconst w3m-menubar
2568 (let ((a (when w3m-use-japanese-menu
2569 (decode-coding-string "\e$B%\"\e(B" 'iso-2022-jp)))) ;; \e$B%"\e(B
2570 `("w3m"
2571 [,(w3m-make-menu-item "\e$B$3$N\e(B URL \e$B$r?7$7$$%;%C%7%g%s$G3+$/\e(B"
2572 "Open This URL in a new session")
2573 w3m-view-this-url-new-session (or (w3m-anchor) (w3m-image))]
2574 [,(w3m-make-menu-item "\e$B$3$N\e(B URL \e$B$r%@%&%s%m!<%I$9$k\e(B" "Download This URL")
2575 w3m-download-this-url (or (w3m-anchor) (w3m-image))]
2576 [,(w3m-make-menu-item "\e$B%@%&%s%m!<%I\e(B..." "Download to...")
2577 w3m-download t]
2578 "----" ;; separator
2579 [,(w3m-make-menu-item "\e$BA0$N%Z!<%8$KLa$k\e(B" "Back to Previous Page")
2580 w3m-view-previous-page
2581 (w3m-history-previous-link-available-p)]
2582 [,(w3m-make-menu-item "\e$B<!$N%Z!<%8$K0\F0$9$k\e(B" "Forward to Next Page")
2583 w3m-view-next-page
2584 (w3m-history-next-link-available-p)]
2585 [,(w3m-make-menu-item "\e$B>e$N3,AX$K0\F0$9$k\e(B" "Up to Parent Page")
2586 w3m-view-parent-page
2587 (w3m-parent-page-available-p)]
2588 "----" ;; separator
2589 [,(w3m-make-menu-item "\e$B$3$N%Z!<%8$r30It%V%i%&%6$G3+$/\e(B"
2590 "Open This Page in an External Browser")
2591 w3m-external-view-current-url w3m-current-url]
2592 [,(w3m-make-menu-item "\e$B$3$N\e(B URL \e$B$r30It%V%i%&%6$G3+$/\e(B"
2593 "Open This URL in an External Browser")
2594 w3m-external-view-this-url (or (w3m-anchor) (w3m-image))]
2595 [,(w3m-make-menu-item "\e$B$3$N%Z!<%8$N%=!<%9$r%3%^%s%I$KAw$k\e(B..."
2596 "Pipe Page Source to Command...")
2597 w3m-pipe-source w3m-current-url]
2598 "----" ;; separator
2599 (,(w3m-make-menu-item "\e$B:FI=<(\e(B" "Redisplay")
2600 [,(w3m-make-menu-item "\e$B$3$N%Z!<%8$r:F<hF@$9$k\e(B" "Reload This Page")
2601 w3m-reload-this-page w3m-current-url]
2602 [,(w3m-make-menu-item "\e$B$9$Y$F$N%Z!<%8$r:F<hF@$9$k\e(B" "Reload All Pages")
2603 w3m-reload-all-pages (cdr (w3m-list-buffers))]
2604 "----" ;; separator
2605 [,(w3m-make-menu-item "\e$B2hA|I=<($N@ZBX\e(B(\e$BA4It\e(B)" "Toggle Images")
2606 w3m-toggle-inline-images (w3m-display-graphic-p)]
2607 [,(w3m-make-menu-item "\e$B2hA|I=<($N@ZBX\e(B(\e$B$3$N2hA|\e(B)" "Toggle This Image")
2608 w3m-toggle-inline-image (w3m-image)]
2609 [,(w3m-make-menu-item "\e$B2hA|I=<($r;_$a$k\e(B" "Turn off Images")
2610 w3m-turnoff-inline-images (w3m-display-graphic-p)]
2611 "----" ;; separator
2612 [,(w3m-make-menu-item "\e$B:FIA2h$9$k\e(B" "Redisplay This Page")
2613 w3m-redisplay-this-page w3m-current-url]
2614 [,(w3m-make-menu-item "Charset \e$B$r;XDj$7$F:FIA2h$9$k\e(B"
2615 "Redisplay This Page with Charset")
2616 w3m-redisplay-with-charset w3m-current-url]
2617 [,(w3m-make-menu-item "Content-type \e$B$r;XDj$7$F:FIA2h$9$k\e(B"
2618 "Redisplay This Page with Content-type")
2619 w3m-redisplay-with-content-type w3m-current-url]
2620 [,(w3m-make-menu-item "\e$B;XDj$7$?\e(B Charset \e$B$H\e(B Content-type \e$B$rGK4~$9$k\e(B"
2621 "Reset Charset and Content-type")
2622 w3m-redisplay-and-reset w3m-current-url]
2623 ) ;; end redisplay
2624 [,(w3m-make-menu-item "\e$B%[!<%`%Z!<%8$X0\F0\e(B" "Go to Home Page")
2625 w3m-gohome w3m-home-page]
2626 (,(w3m-make-menu-item "\e$B%V%C%/%^!<%/\e(B" "Bookmark")
2627 [,(w3m-make-menu-item "\e$B%V%C%/%^!<%/$rI=<(\e(B" "View Bookmark")
2628 w3m-bookmark-view t]
2629 [,(w3m-make-menu-item "\e$B?7$7$$%;%C%7%g%s$G%V%C%/%^!<%/$rI=<(\e(B"
2630 "View Bookmark in a New Session")
2631 w3m-bookmark-view-new-session t])
2632 [,(w3m-make-menu-item "\e$B0\F0\e(B..." "Go to...")
2633 w3m-goto-url t]
2634 "----" ;; separator
2635 (,(w3m-make-menu-item "\e$BMzNr\e(B" "History")
2636 [,(w3m-make-menu-item "\e$BLZ9=B$$GMzNr$rI=<(\e(B" "Show a Visited URLs Tree")
2637 w3m-history t]
2638 [,(w3m-make-menu-item "\e$B%j%9%H$GMzNr$rI=<(\e(B" "Show an Arrived URLs List")
2639 w3m-db-history t]
2640 ) ;; end history
2641 [,(w3m-make-menu-item "\e$B%$%s%?!<%M%C%H$G$N8!:w\e(B..."
2642 "Search the Internet...")
2643 w3m-search t]
2644 [,(w3m-make-menu-item "\e$B?7$7$$%;%C%7%g%s$G8!:w\e(B..."
2645 "Search the Internet in a New Session...")
2646 w3m-search-new-session t]
2647 [,(w3m-make-menu-item "\e$BE75$M=Js\e(B" "Weather Forecast")
2648 w3m-weather t]
2649 [,(w3m-make-menu-item (concat a "\e$B%s%F%J$G<hF@\e(B")
2650 "Investigate with Antenna")
2651 w3m-antenna t]
2652 (,(w3m-make-menu-item "\e$B%X%k%W\e(B" "Resource")
2653 [,(w3m-make-menu-item "\e$B%W%m%;%9$rCf;_$9$k\e(B" "Cancel Process")
2654 w3m-process-stop w3m-current-process]
2655 [,(w3m-make-menu-item "\e$B%=!<%9$r8+$k\e(B" "View Source")
2656 w3m-view-source t]
2657 [,(w3m-make-menu-item "\e$B%X%C%@!<$r8+$k\e(B" "View Header")
2658 w3m-view-header t]
2659 ) ;; end resource
2660 "----" ;; separator
2661 [,(w3m-make-menu-item "\e$B$3$N%Z!<%8$r%a!<%k$GAw$k\e(B" "Mail this page")
2662 w3m-mail (memq mail-user-agent w3m-mail-user-agents)]
2663 "----" ;; separator
2664 [,(w3m-make-menu-item "\e$B%P%0%l%]!<%H$rAw$k\e(B" "Send a Bug Report")
2665 report-emacs-w3m-bug t]
2666 "----" ;; separator
2667 [,(w3m-make-menu-item "\e$B$3$N\e(B URL \e$B$rI=<($9$k\e(B" "Print the Current URL")
2668 w3m-print-current-url t]
2669 [,(w3m-make-menu-item "w3m \e$B$rJD$8$k\e(B" "Close w3m")
2670 w3m-close-window t]
2671 [,(w3m-make-menu-item "w3m \e$B$r=*N;$9$k\e(B" "Quit w3m")
2672 w3m-quit t]
2673 )) ;; end w3m
2674 "Menubar definition for emacs-w3m.")
2675
2676 (defvar w3m-rmouse-menubar
2677 `("w3m"
2678 [,(w3m-make-menu-item "\e$BA0$N%Z!<%8$KLa$k\e(B" "Back to Previous Page")
2679 w3m-view-previous-page
2680 (w3m-history-previous-link-available-p)]
2681 [,(w3m-make-menu-item "\e$B<!$N%Z!<%8$K0\F0$9$k\e(B" "Forward to Next Page")
2682 w3m-view-next-page
2683 (w3m-history-next-link-available-p)]
2684 [,(w3m-make-menu-item "\e$B>e$N3,AX$K0\F0$9$k\e(B" "Up to Parent Page")
2685 w3m-view-parent-page
2686 (w3m-parent-page-available-p)]
2687 "----" ;; separator
2688 [,(w3m-make-menu-item "\e$B$3$N%Z!<%8$r:F<hF@$9$k\e(B" "Reload This Page")
2689 w3m-reload-this-page w3m-current-url]
2690 [,(w3m-make-menu-item "\e$B$9$Y$F$N%Z!<%8$r:F<hF@$9$k\e(B" "Reload All Pages")
2691 w3m-reload-all-pages (cdr (w3m-list-buffers))]
2692 [,(w3m-make-menu-item "\e$B%W%m%;%9$rCf;_$9$k\e(B" "Cancel Process")
2693 w3m-process-stop w3m-current-process])
2694 "*Menubar for click the right mouse button.")
2695
2696 (defvar w3m-cid-retrieve-function-alist nil)
2697 (defvar w3m-force-redisplay t)
2698
2699 (defvar w3m-work-buffer-list nil)
2700 (defconst w3m-work-buffer-name " *w3m-work*")
2701 (defconst w3m-select-buffer-name " *w3m buffers*")
2702
2703 (defconst w3m-dump-head-source-command-arguments
2704 (cond ((eq w3m-type 'w3mmee)
2705 (list "-dump=extra,head,source"))
2706 (t
2707 (list
2708 '(if w3m-accept-languages
2709 '("-o"
2710 (concat "accept_language="
2711 (mapconcat 'identity w3m-accept-languages ","))))
2712 "-dump_extra")))
2713 "Arguments passed to the w3m command to run \"dump_extra\".")
2714
2715 (defvar w3m-halfdump-command nil
2716 "Alternative w3m command used to run \"halfdump\".
2717 If it is nil, the command specified to `w3m-command' is used.")
2718
2719 (defconst w3m-halfdump-command-arguments
2720 (cond ((eq w3m-type 'w3mmee)
2721 (list '(if w3m-treat-image-size
2722 "-dump=half-buffer,single-row-image"
2723 "-dump=half-buffer")
2724 '(if (eq w3m-input-coding-system 'ctext)
2725 (list "-I" "x-ctext")
2726 (when (and (eq w3m-input-coding-system 'binary)
2727 charset)
2728 (list "-I" 'charset)))
2729 "-o" "concurrent=0"))
2730 ((eq w3m-type 'w3m-m17n)
2731 (list "-halfdump"
2732 "-o" "ext_halfdump=1"
2733 "-o" "strict_iso2022=0"
2734 "-o" "fix_width_conv=1"
2735 "-o" "use_jisx0201=0"
2736 "-o" "ucs_conv=1"
2737 '(if (eq w3m-input-coding-system 'binary)
2738 (if charset (list "-I" 'charset))
2739 (list "-I" (cond
2740 ((eq w3m-input-coding-system 'utf-8)
2741 "UTF-8")
2742 ((eq w3m-input-coding-system 'iso-8859-1)
2743 "ISO-8859-1")
2744 (t
2745 "ISO-2022-JP-2"))))
2746 "-O"
2747 '(cond
2748 ((eq w3m-output-coding-system 'utf-8)
2749 "UTF-8")
2750 ((eq w3m-output-coding-system 'iso-8859-1)
2751 "ISO-8859-1")
2752 (t
2753 "ISO-2022-JP-2"))))
2754 ((eq w3m-input-coding-system 'w3m-euc-japan)
2755 (list "-halfdump" "-I" "e"))
2756 (t (list "-halfdump")))
2757 "Arguments passed to the w3m command to run \"halfdump\".")
2758
2759 (defconst w3m-halfdump-command-common-arguments
2760 (list "-T" "text/html" "-t" tab-width "-cols" '(w3m-display-width)
2761 '(cond
2762 ((and (eq w3m-display-ins-del 'fontify)
2763 (w3m-device-on-window-system-p))
2764 (list "-o" "display_ins_del=2"))
2765 ((or (eq w3m-display-ins-del 'tag)
2766 (and (eq w3m-display-ins-del 'fontify)
2767 (not (w3m-device-on-window-system-p))))
2768 (list "-o" "display_ins_del=1"))))
2769 "Arguments used in common by the w3m command variants to run \"halfdump\".")
2770
2771 (defconst w3m-arrived-ignored-regexp
2772 "\\`about:\\(?://\\(?:header\\|source\\|history\\|\
2773 db-history\\|antenna\\|namazu\\|dtree\\)/.*\\)?\\'\
2774 \\|\\`about:/*blank/?\\'"
2775 "Regexp matching urls which aren't stored in the arrived URLs database.")
2776
2777 (defconst w3m-history-ignored-regexp
2778 "\\`about:\\(?://\\(?:header\\|source\\|history\\|\
2779 db-history\\|antenna\\|namazu\\|dtree\\)/.*\\)?\\'\
2780 \\|\\`about:/*blank/?\\'"
2781 "Regexp matching urls which aren't stored in the history.")
2782
2783 (defvar w3m-mode-map nil "Keymap for emacs-w3m buffers.")
2784 (defvar w3m-link-map nil "Keymap used on links.")
2785 (defvar w3m-doc-view-map nil
2786 "Keymap used in `doc-view-mode' that emacs-w3m launches.
2787 `doc-view-mode-map' gets to be its parent keymap.")
2788
2789 (defvar w3m-mode-setup-functions nil
2790 "Hook functions run after setting up the `w3m-mode'.")
2791 (defvar w3m-display-functions nil
2792 "Hook functions run after displaying pages in emacs-w3m buffers.
2793 Each function is called with a url string as the argument. This hook
2794 is evaluated just before evaluating `w3m-display-hook'.")
2795
2796 (defvar w3m-load-hook nil
2797 "*Hook run after loading the w3m.elc module.
2798 It is not recommended that you use this hook instead of writing into
2799 `w3m-init-file' for customization.")
2800
2801
2802 ;; Generic functions:
2803 (defun w3m-url-to-file-name (url)
2804 "Return the file name which is pointed to by URL.
2805 When URL does not point to any local files, it returns nil. The
2806 actual performance of this function is to strip off the scheme part
2807 and the net_loc part from URL. It is meaningless to give an argument
2808 whose net_loc part is not empty, a null string or the localhost name
2809 to this function."
2810 (cond
2811 ((string-match "\\`\\(\\(file:/\\{0,2\\}\\)\\|about://dtree\\)/" url)
2812 (setq url (substring url (match-end 1)))
2813 (when (and (match-beginning 2) ;; file:
2814 (< (match-end 2) 7) ;; file:// or file:/
2815 (string-match "\\`\\(/[^/]+[^/:|]\\)/" url))
2816 (cond ((file-directory-p (match-string 0 url))
2817 ) ;; The directory "/hostname/" exists.
2818 ((string-match (concat "\\`/\\(localhost\\|127\\.0\\.0\\.1\\|"
2819 (regexp-quote (system-name)) "\\)/")
2820 url)
2821 ;; Strip the localhost name.
2822 (setq url (substring url (match-end 1))))
2823 (t
2824 ;; Make it a Tramp url: /hostname:/...
2825 ;; See `tramp-default-method' and `tramp-default-method-alist'.
2826 (setq url (concat (substring url 0 (match-end 1))
2827 ":"
2828 (substring url (match-end 1)))))))
2829 ;; Process abs_path part in Windows.
2830 (when (and w3m-treat-drive-letter
2831 (string-match
2832 "\\`/\\(?:\\([a-zA-Z]\\)[|:]?\\|cygdrive/\\([a-zA-Z]\\)\\)/"
2833 url))
2834 (setq url (concat (or (match-string 1 url) (match-string 2 url))
2835 ":/"
2836 (substring url (match-end 0)))))
2837 (if (string-match "\\`/[^/:]\\{2,\\}:/" url)
2838 ;; Don't check for a Tramp url.
2839 url
2840 (if (file-exists-p url)
2841 url
2842 (let ((x (w3m-url-decode-string url w3m-file-name-coding-system)))
2843 (if (file-exists-p x) x url)))))
2844 ((string-match "\\`\\(?:[~/]\\|[a-zA-Z]:/\\|\\.\\.?/\\)" url) url)
2845 (t
2846 (catch 'found-file
2847 (dolist (pair w3m-url-local-directory-alist)
2848 (and (string-match (concat "\\`"
2849 (regexp-quote
2850 (file-name-as-directory (car pair))))
2851 url)
2852 (let ((file (expand-file-name (substring url (match-end 0))
2853 (cdr pair))))
2854 (when (or (file-exists-p file)
2855 (file-exists-p
2856 (setq file (w3m-url-decode-string
2857 file w3m-file-name-coding-system))))
2858 (throw 'found-file file)))))))))
2859
2860 (defun w3m-expand-file-name-as-url (file &optional directory)
2861 "Return a url string which points to the FILE.
2862 Optional DIRECTORY is a directory to start with if FILE is relative
2863 \(i.e., FILE doesn't start with slash). It defaults to the current
2864 directory."
2865 (setq file (expand-file-name file directory))
2866 (concat "file://"
2867 (if (string-match "\\`\\([a-zA-Z]\\):" file)
2868 (format (if w3m-use-cygdrive "/cygdrive/%s%s" "/%s|%s")
2869 (match-string 1 file)
2870 (substring file (match-end 0)))
2871 file)))
2872
2873
2874 ;;; Managing the arrived URLs database:
2875 (defmacro w3m-arrived-intern (url &optional soft)
2876 "Normalize URL by stripping last / and intern it into `w3m-arrived-db'.
2877 If SOFT is non-nil, use `intern-soft' instead."
2878 (let ((fn (if soft 'intern-soft 'intern))
2879 (str (if (consp url)
2880 `(let* ((url ,url)
2881 (len (length url)))
2882 (if (and (not (zerop len))
2883 (eq (aref url (1- len)) ?/))
2884 (substring url 0 -1)
2885 url))
2886 `(if (let ((len (length ,url)))
2887 (and (not (zerop len))
2888 (eq (aref ,url (1- len)) ?/)))
2889 (substring ,url 0 -1)
2890 ,url))))
2891 `(,fn ,str w3m-arrived-db)))
2892
2893 (defun w3m-arrived-add (url &optional title modification-time
2894 arrival-time content-charset content-type)
2895 "Add URL to the arrived URLs database.
2896 Optional TITLE, MODIFICATION-TIME, ARRIVAL-TIME, CONTENT-CHARSET and
2897 CONTENT-TYPE are also be added."
2898 (unless (string-match w3m-arrived-ignored-regexp url)
2899 (let ((ident (w3m-arrived-intern url)))
2900 (if (string-match "\\`\\([^#]+\\)#" url)
2901 (w3m-arrived-add (substring url 0 (match-end 1))
2902 title modification-time arrival-time
2903 content-charset content-type)
2904 (when title
2905 (put ident 'title title))
2906 (when modification-time
2907 (put ident 'last-modified modification-time))
2908 (when content-charset
2909 (put ident 'content-charset content-charset))
2910 (when content-type
2911 (put ident 'content-type content-type)))
2912 (set ident arrival-time))))
2913
2914 (defun w3m-arrived-p (url)
2915 "Return non-nil if a page of URL has arrived."
2916 (or (string-match w3m-arrived-ignored-regexp url)
2917 (w3m-arrived-intern url t)))
2918
2919 (defun w3m-arrived-time (url)
2920 "Return the arrival time of a page of URL if it has arrived.
2921 Otherwise return nil."
2922 (let ((v (w3m-arrived-intern url t)))
2923 (and v (boundp v) (symbol-value v))))
2924 (defsetf w3m-arrived-time (url) (value)
2925 (list 'w3m-arrived-add url nil nil value))
2926
2927 (defun w3m-arrived-put (url property value)
2928 "Store VALUE in the arrived URLs database as the PROPERTY of URL.
2929 Return VALUE if a page of URL has arrived. Otherwise, VALUE is
2930 ignored and return nil."
2931 (let ((symbol (w3m-arrived-intern url t)))
2932 (and symbol (put symbol property value))))
2933
2934 (defun w3m-arrived-get (url property)
2935 "Return the value of URL's PROPERTY stored in the arrived URLs database.
2936 If a page of URL has not arrived, return nil."
2937 (let ((symbol (w3m-arrived-intern url t)))
2938 (and symbol (get symbol property))))
2939
2940 (defsetf w3m-arrived-get w3m-arrived-put)
2941
2942 (defmacro w3m-arrived-title (url)
2943 "Return the title of URL having stored in the arrived URLs database."
2944 `(w3m-arrived-get ,url 'title))
2945
2946 (defmacro w3m-arrived-last-modified (url)
2947 "Return the mod time of URL having stored in the arrived URLs database.
2948 If a page of URL has not arrived yet, return nil."
2949 `(w3m-arrived-get ,url 'last-modified))
2950
2951 (defmacro w3m-arrived-content-charset (url)
2952 "Return the content charset of URL stored in the arrived URLs database.
2953 If it has not been specified or a page of URL has not arrived yet,
2954 return nil."
2955 `(w3m-arrived-get ,url 'content-charset))
2956
2957 (defmacro w3m-arrived-content-type (url)
2958 "Return the content type of URL stored in the arrived URLs database.
2959 If it has not been specified or a page of URL has not arrived yet,
2960 return nil."
2961 `(w3m-arrived-get ,url 'content-type))
2962
2963 (defun w3m-arrived-load-list ()
2964 "Load the arrived URLs database file.
2965 The file is specified by `w3m-arrived-file'. If the data is in old
2966 format, they will simply be ignored."
2967 (let ((list (w3m-load-list w3m-arrived-file)))
2968 (when (or
2969 ;; Before the revision 1.120, every element of the list was
2970 ;; a string that represented an arrived URL.
2971 (stringp (car list))
2972 ;; Before the revision 1.135, every element was a cons
2973 ;; cell: its car kept a URL, and its cdr kept a time when
2974 ;; the URL was arrived.
2975 ;; Before the revision 1.178, every element was a 4-tuple
2976 ;; that consisted of a URL, a title, a modification time,
2977 ;; and an arrival time.
2978 ;; An element of the modern database is a 6-tuple that
2979 ;; consisted of a URL, a title, a modification time, an
2980 ;; arrival time, a charset, and a content type.
2981 ;; Thus, the following condition eliminates the revision
2982 ;; 1.177 and olders.
2983 (<= (length (car list)) 4))
2984 (setq list nil)
2985 (when (file-exists-p w3m-arrived-file)
2986 (delete-file w3m-arrived-file)))
2987 list))
2988
2989 (defun w3m-arrived-setup ()
2990 "Load the arrived URLs database file and set up the hashed database.
2991 It is performed only when `w3m-arrived-db' has not been initialize yet.
2992 The file is specified by `w3m-arrived-file'."
2993 (unless w3m-arrived-db
2994 (setq w3m-arrived-db (make-vector w3m-arrived-db-size 0))
2995 (let ((list (w3m-arrived-load-list)))
2996 (dolist (elem list)
2997 ;; Ignore an element that lacks an arrival time information.
2998 (when (nth 3 elem)
2999 (w3m-arrived-add (if (string-match "\\`/" (car elem))
3000 (w3m-expand-file-name-as-url (car elem))
3001 (car elem))
3002 (nth 1 elem)
3003 (nth 2 elem)
3004 (nth 3 elem)
3005 (when (stringp (nth 4 elem)) (nth 4 elem))
3006 (nth 5 elem))))
3007 (unless w3m-input-url-history
3008 (setq w3m-input-url-history (mapcar (function car) list))))
3009 (run-hooks 'w3m-arrived-setup-functions)))
3010
3011 (defun w3m-arrived-shutdown ()
3012 "Save the arrived URLs database in the file.
3013 The database `w3m-arrived-db' will be cleared after saving. The file
3014 is specified by `w3m-arrived-file'."
3015 (when w3m-arrived-db
3016 ;; Re-read the database file, and if there are data which another
3017 ;; Emacs process registered, merge them to the current database.
3018 (dolist (elem (w3m-arrived-load-list))
3019 (when (w3m-time-newer-p (nth 3 elem) (w3m-arrived-time (car elem)))
3020 (w3m-arrived-add (if (string-match "\\`/" (car elem))
3021 (w3m-expand-file-name-as-url (car elem))
3022 (car elem))
3023 (nth 1 elem)
3024 (nth 2 elem)
3025 (nth 3 elem)
3026 (when (stringp (nth 4 elem)) (nth 4 elem))
3027 (nth 5 elem))))
3028 ;; Convert current database to a list.
3029 (let (list)
3030 (mapatoms
3031 (lambda (sym)
3032 (and sym
3033 (boundp sym)
3034 (symbol-value sym) ; Ignore an entry lacks an arrival time.
3035 (push (list (symbol-name sym)
3036 (get sym 'title)
3037 (get sym 'last-modified)
3038 (symbol-value sym)
3039 (get sym 'content-charset)
3040 (get sym 'content-type))
3041 list)))
3042 w3m-arrived-db)
3043 (w3m-save-list w3m-arrived-file
3044 (w3m-sub-list
3045 (sort list
3046 (lambda (a b)
3047 (if (equal (nth 3 a) (nth 3 b))
3048 (string< (car a) (car b))
3049 (w3m-time-newer-p (nth 3 a) (nth 3 b)))))
3050 w3m-keep-arrived-urls)
3051 nil t))
3052 (setq w3m-arrived-db nil)
3053 (run-hooks 'w3m-arrived-shutdown-functions)))
3054
3055 (add-hook 'kill-emacs-hook 'w3m-arrived-shutdown)
3056 (add-hook 'kill-emacs-hook 'w3m-cookie-shutdown)
3057 (add-hook 'w3m-arrived-shutdown-functions 'w3m-session-automatic-save)
3058 (add-hook 'w3m-arrived-shutdown-functions 'w3m-session-crash-recovery-remove)
3059 (add-hook 'w3m-arrived-shutdown-functions 'w3m-cleanup-temp-files)
3060
3061 ;;; Generic macros and inline functions:
3062 (defun w3m-attributes (url &optional no-cache handler)
3063 "Return a list of attributes corresponding to URL.
3064 Return nil if it failed in retrieving of the header.
3065 Otherwise, return a list which includes the following elements:
3066
3067 0. Type of contents.
3068 1. Charset of contents.
3069 2. Size in bytes.
3070 3. Encoding of contents.
3071 4. Last modification time.
3072 5. Real URL.
3073
3074 If the optional argument NO-CACHE is non-nil, cache is not used."
3075 (if (not handler)
3076 (condition-case nil
3077 (w3m-process-with-wait-handler
3078 (w3m-attributes url no-cache handler))
3079 (w3m-process-timeout nil))
3080 (setq url (w3m-url-strip-fragment url))
3081 (cond
3082 ((string= "about://emacs-w3m.gif" url)
3083 (list "image/gif" nil nil nil nil url url))
3084 ((string-match "\\`about://source/" url)
3085 (lexical-let ((src (substring url (match-end 0))))
3086 (w3m-process-do
3087 (attrs (w3m-attributes src no-cache handler))
3088 (list "text/plain"
3089 (or (w3m-arrived-content-charset (w3m-url-strip-authinfo src))
3090 (cadr attrs))
3091 (nth 2 attrs)
3092 (nth 3 attrs)
3093 (nth 4 attrs)
3094 (concat "about://source/" (nth 5 attrs))))))
3095 ((string-match "\\`about:" url)
3096 (list "text/html" w3m-coding-system nil nil nil url))
3097 ((string-match "\\`cid:" url)
3098 (let ((w3m-current-buffer (current-buffer)))
3099 (w3m-process-do-with-temp-buffer
3100 (type (w3m-cid-retrieve url nil nil))
3101 (list type nil nil nil nil url url))))
3102 ((string-match "\\`data:" url)
3103 (let ((w3m-current-buffer (current-buffer)))
3104 (w3m-process-do-with-temp-buffer
3105 (type (w3m-data-retrieve url nil nil))
3106 (list type nil nil nil nil url url))))
3107 ((w3m-url-local-p url)
3108 (w3m-local-attributes url))
3109 (t
3110 (w3m-w3m-attributes url no-cache handler)))))
3111
3112 (defmacro w3m-content-type (url &optional no-cache handler)
3113 (if handler
3114 `(let ((handler ,handler))
3115 (w3m-process-do
3116 (attrs (w3m-attributes ,url ,no-cache handler))
3117 (car attrs)))
3118 `(car (w3m-attributes ,url ,no-cache))))
3119 (defmacro w3m-content-charset (url &optional no-cache handler)
3120 (if handler
3121 `(let ((handler ,handler))
3122 (w3m-process-do
3123 (attrs (w3m-attributes ,url ,no-cache handler))
3124 (nth 1 attrs)))
3125 `(nth 1 (w3m-attributes ,url ,no-cache))))
3126 (defmacro w3m-content-length (url &optional no-cache handler)
3127 (if handler
3128 `(let ((handler ,handler))
3129 (w3m-process-do
3130 (attrs (w3m-attributes ,url ,no-cache handler))
3131 (nth 2 attrs)))
3132 `(nth 2 (w3m-attributes ,url ,no-cache))))
3133 (defmacro w3m-content-encoding (url &optional no-cache handler)
3134 (if handler
3135 `(let ((handler ,handler))
3136 (w3m-process-do
3137 (attrs (w3m-attributes ,url ,no-cache handler))
3138 (nth 3 attrs)))
3139 `(nth 3 (w3m-attributes ,url ,no-cache))))
3140 (defmacro w3m-last-modified (url &optional no-cache handler)
3141 (if handler
3142 `(let ((handler ,handler))
3143 (w3m-process-do
3144 (attrs (w3m-attributes ,url ,no-cache handler))
3145 (nth 4 attrs)))
3146 `(nth 4 (w3m-attributes ,url ,no-cache))))
3147 (defmacro w3m-real-url (url &optional no-cache handler)
3148 (if handler
3149 `(let ((handler ,handler))
3150 (w3m-process-do
3151 (attrs (w3m-attributes ,url ,no-cache handler))
3152 (nth 5 attrs)))
3153 `(nth 5 (w3m-attributes ,url ,no-cache))))
3154
3155 (defmacro w3m-make-help-echo (property)
3156 "Make a function returning a string used for the `help-echo' message.
3157 PROPERTY is a symbol (which doesn't need to be quoted) of a text
3158 property (in XEmacs, it is an extent) with the value of a string which
3159 should be in the place where having to show a help message. If you
3160 need to know what function will be made, use `macroexpand'."
3161 (if (featurep 'xemacs)
3162 (let ((str `(get-text-property (extent-start-position extent)
3163 ',property)))
3164 `(lambda (extent)
3165 (if (and w3m-track-mouse
3166 (eq (extent-object extent) (current-buffer)))
3167 (w3m-url-readable-string ,str))))
3168 `(lambda (window object pos)
3169 (if w3m-track-mouse
3170 (let ((deactivate-mark nil))
3171 (message nil) ; Clear the echo area.
3172 (w3m-url-readable-string
3173 (get-text-property pos ',property
3174 (window-buffer window))))))))
3175
3176 (defmacro w3m-make-balloon-help (property)
3177 "Make a function returning a string used for the `balloon-help' message.
3178 Functions made are used only when emacs-w3m is running under XEmacs.
3179 It returns an interned symbol of a function. PROPERTY is a symbol
3180 \(which doesn't need to be quoted) of an extent with the value of a
3181 string which should be in the place where having to show a help
3182 message."
3183 (when (featurep 'xemacs)
3184 (let ((str `(get-text-property (extent-start-position extent)
3185 ',property)))
3186 `(let ((fn (intern (format "w3m-balloon-help-for-%s"
3187 ',property))))
3188 (prog1
3189 fn
3190 (unless (fboundp fn)
3191 (defalias fn
3192 (lambda (extent)
3193 (if (and w3m-track-mouse
3194 (eq (extent-object extent) (current-buffer)))
3195 (w3m-url-readable-string ,str)))))
3196 (when (and (featurep 'bytecomp)
3197 (not (compiled-function-p (symbol-function fn))))
3198 (byte-compile fn)))))))
3199
3200 (defvar w3m-current-message nil
3201 "The string currently displayed by `w3m-message' in the echo area.")
3202 (defvar w3m-message-silent nil
3203 "When set to `t', w3m-message is just ignored.")
3204
3205 (defun w3m-message (&rest args)
3206 "Print a one-line message at the bottom of the screen.
3207 It displays a given message without logging, when the cursor is
3208 neither in the minibuffer or in the echo area and `w3m-verbose' is
3209 nil. When the cursor is either in the minibuffer or in the echo area
3210 and `w3m-verbose' is nil, it behaves as `format' and simply returns a
3211 string. When `w3m-verbose' is non-nil, it behaves identically as
3212 `message', that displays a given message with logging."
3213 ;; Always clear previous message in order to shrink the window height
3214 ;; for the echo area.
3215 (unless (or (featurep 'xemacs)
3216 (< emacs-major-version 22)
3217 (< (string-width (or (current-message) "")) (window-width)))
3218 (message nil))
3219 (unless w3m-message-silent
3220 (if w3m-verbose
3221 (apply (function message) args)
3222 (if (when w3m-process-background
3223 (or (window-minibuffer-p (selected-window))
3224 (when (current-message)
3225 (not (equal (current-message) w3m-current-message)))))
3226 (apply (function format) args)
3227 (w3m-static-if (featurep 'xemacs)
3228 (progn
3229 (setq w3m-current-message (apply (function format) args))
3230 (display-message 'no-log w3m-current-message))
3231 (let (message-log-max)
3232 (setq w3m-current-message (apply (function message) args))))))))
3233
3234 (defun w3m-time-parse-string (string)
3235 "Parse the time-string STRING into a time in the Emacs style."
3236 (ignore-errors
3237 (let ((x (timezone-fix-time string nil nil)))
3238 (encode-time (aref x 5) (aref x 4) (aref x 3)
3239 (aref x 2) (aref x 1) (aref x 0)
3240 (aref x 6)))))
3241
3242 ;; When a buggy timezone.el is loaded, we use parse-time.el instead.
3243 (unless (equal (w3m-time-parse-string "Thursday, 01-Jan-1970 00:00:00 GMT")
3244 '(0 0))
3245 (ignore-errors
3246 (require 'parse-time))
3247 (defun w3m-time-parse-string (string)
3248 "Parse the time-string STRING and return its time as Emacs style."
3249 (ignore-errors
3250 (let ((fn (when (fboundp 'parse-time-string)
3251 'parse-time-string)))
3252 (when fn
3253 (apply (function encode-time) (funcall fn string)))))))
3254
3255 (defun w3m-sub-list (list n)
3256 "Return a list of the first N elements of LIST.
3257 If N is negative, return a list of the last N elements of LIST."
3258 (if (integerp n)
3259 (if (< n 0)
3260 ;; N is negative, extract the last items
3261 (if (>= (- n) (length list))
3262 (copy-sequence list)
3263 (nthcdr (+ (length list) n) (copy-sequence list)))
3264 ;; N is positive, extract the first items
3265 (if (>= n (length list))
3266 (copy-sequence list)
3267 (nreverse (nthcdr (- (length list) n) (reverse list)))))
3268 (copy-sequence list)))
3269
3270 (defun w3m-load-list (file &optional coding-system)
3271 "Read an emacs-w3m data file FILE and return contents as a list.
3272 It is used for loading `w3m-arrived-file', `w3m-cookie-file',
3273 `w3m-favicon-cache-file' and `w3m-antenna-file' (which see).
3274 CODING-SYSTEM is used to read FILE which defaults to the value of
3275 `w3m-file-coding-system-for-read'."
3276 (when (and (file-readable-p file)
3277 ;; XEmacs 21.4 might crash when inserting a directory.
3278 (not (file-directory-p file)))
3279 (with-temp-buffer
3280 (when (condition-case nil
3281 (let ((coding-system-for-read
3282 (or coding-system w3m-file-coding-system-for-read)))
3283 (insert-file-contents file))
3284 (error
3285 (message "Error while loading %s" file)
3286 nil))
3287 ;; point is not always moved to the beginning of the buffer
3288 ;; after `insert-file-contents' is done.
3289 (goto-char (point-min))
3290 (condition-case err
3291 (read (current-buffer))
3292 (error
3293 (message "Error while reading %s; %s"
3294 file (error-message-string err))
3295 nil))))))
3296
3297 (defun w3m-save-list (file list &optional coding-system escape-ctl-chars)
3298 "Save a LIST form into the emacs-w3m data file FILE.
3299 Contents will be encoded with CODING-SYSTEM which defaults to the
3300 value of `w3m-file-coding-system'. Optional ESCAPE-CTL-CHARS if it is
3301 non-nil, control chars will be represented with ^ as `cat -v' does."
3302 (when (and list (file-writable-p file))
3303 (with-temp-buffer
3304 (let ((coding-system-for-write (or coding-system w3m-file-coding-system))
3305 (standard-output (current-buffer))
3306 (print-fn (if escape-ctl-chars
3307 'w3m-prin1
3308 'prin1))
3309 element print-length print-level)
3310 (insert (format "\
3311 ;;; %s -*- mode: emacs-lisp%s -*-
3312 ;; This file is generated automatically by emacs-w3m v%s.
3313
3314 "
3315 (file-name-nondirectory file)
3316 (if coding-system-for-write
3317 (format "; coding: %s" coding-system-for-write)
3318 "")
3319 emacs-w3m-version))
3320 (insert "(")
3321 (while list
3322 (setq element (car list)
3323 list (cdr list))
3324 (if (consp element)
3325 (progn
3326 (insert "(")
3327 (funcall print-fn (car element))
3328 (insert "\n")
3329 (while (setq element (cdr element))
3330 (insert " ")
3331 (funcall print-fn (car element))
3332 (insert "\n"))
3333 (backward-delete-char 1)
3334 (insert ")\n "))
3335 (funcall print-fn element)
3336 (insert "\n")))
3337 (skip-chars-backward "\n ")
3338 (delete-region (point) (point-max))
3339 (insert ")\n")
3340 (let ((mode (and (file-exists-p file)
3341 (file-modes file))))
3342 (write-region (point-min) (point-max) file nil 'nomsg)
3343 (when mode (set-file-modes file mode)))))))
3344
3345 (defun w3m-url-encode-string (str &optional coding encode-space)
3346 (apply (function concat)
3347 (mapcar
3348 (lambda (ch)
3349 (cond
3350 ((eq ch ?\n) ; newline
3351 "%0D%0A")
3352 ((string-match "[-a-zA-Z0-9_:/.]" (char-to-string ch)) ; xxx?
3353 (char-to-string ch)) ; printable
3354 ((and (char-equal ch ?\x20); space
3355 encode-space)
3356 "+")
3357 (t
3358 (format "%%%02X" ch)))) ; escape
3359 ;; Coerce a string into a list of chars.
3360 (append (encode-coding-string (or str "")
3361 (or coding
3362 w3m-default-coding-system
3363 w3m-coding-system
3364 'iso-2022-7bit))
3365 nil))))
3366
3367 (defun w3m-url-decode-string (str &optional coding)
3368 (let ((start 0)
3369 (buf)
3370 (case-fold-search t))
3371 (while (string-match "%\\(?:\\([0-9a-f][0-9a-f]\\)\\|0d%0a\\)" str start)
3372 (push (substring str start (match-beginning 0)) buf)
3373 (push (if (match-beginning 1)
3374 (vector (string-to-number (match-string 1 str) 16))
3375 "\n")
3376 buf)
3377 (setq start (match-end 0)))
3378 (setq str (apply 'concat (nreverse (cons (substring str start) buf))))
3379 (w3m-decode-coding-string-with-priority str coding)))
3380
3381 (defun w3m-url-readable-string (url)
3382 "Return a readable string for a given encoded URL.
3383 If `w3m-show-decoded-url' has a non-nil value, it is referred to to
3384 decide a decoding scheme."
3385 (when (stringp url)
3386 (setq url (w3m-puny-decode-url url))
3387 (let ((rule
3388 (cond ((string-match "[^\000-\177]" url)
3389 ;; It looks not to have been encoded.
3390 nil)
3391 ((and (listp w3m-show-decoded-url)
3392 (consp (car w3m-show-decoded-url)))
3393 (catch 'found-rule
3394 (save-match-data
3395 (dolist (elem w3m-show-decoded-url)
3396 (when (if (stringp (car elem))
3397 (string-match (car elem) url)
3398 (if (functionp (car elem))
3399 (funcall (car elem) url)
3400 (eval (car elem))))
3401 (throw 'found-rule (cdr elem)))))))
3402 (t w3m-show-decoded-url))))
3403 (if rule
3404 (w3m-url-decode-string url
3405 (if (eq t rule)
3406 w3m-coding-system-priority-list
3407 rule))
3408 url))))
3409
3410 (defun w3m-url-transfer-encode-string (url &optional coding)
3411 "Encode non-ascii characters in URL into the sequence of escaped octets.
3412 CODING which defaults to `w3m-current-coding-system' (which see) is a
3413 coding system used when encoding non-ascii characters.
3414
3415 This function is designed for conversion for safe transmission of URL,
3416 i.e., it handles only non-ASCII characters that can not be transmitted
3417 safely through the network. For the other general purpose, you should
3418 use `w3m-url-encode-string' instead."
3419 (setq url (w3m-puny-encode-url url))
3420 (let ((start 0)
3421 (buf))
3422 (while (string-match "[^\x21-\x7e]+" url start)
3423 (setq buf
3424 (cons (apply 'concat
3425 (mapcar
3426 (lambda (c) (format "%%%02X" c))
3427 (append (encode-coding-string
3428 (match-string 0 url)
3429 (or coding
3430 w3m-current-coding-system)))))
3431 (cons (substring url start (match-beginning 0))
3432 buf))
3433 start (match-end 0)))
3434 (apply 'concat
3435 (nreverse (cons (substring url start) buf)))))
3436
3437
3438 ;;; HTML character entity handling:
3439 (defun w3m-entity-value (name)
3440 "Get a char corresponding to NAME from the html char entities database.
3441 The database is kept in `w3m-entity-table'."
3442 ;; Return a value of the specified entity, or nil if it is unknown.
3443 (or (gethash name w3m-entity-table)
3444 (and (eq (aref name 0) ?#)
3445 (let ((num (if (memq (aref name 1) '(?X ?x))
3446 (string-to-number (substring name 2) 16)
3447 (string-to-number (substring name 1)))))
3448 (or (cdr (assq num w3m-extra-numeric-character-reference))
3449 (string (w3m-ucs-to-char num)))))))
3450
3451 (defun w3m-fontify-bold ()
3452 "Fontify bold text in the buffer containing halfdump."
3453 (goto-char (point-min))
3454 (while (search-forward "<b>" nil t)
3455 (let ((start (match-beginning 0)))
3456 (delete-region start (match-end 0))
3457 (when (re-search-forward "</b[ \t\r\f\n]*>" nil t)
3458 (delete-region (match-beginning 0) (match-end 0))
3459 (w3m-add-face-property start (match-beginning 0) 'w3m-bold)))))
3460
3461 (defun w3m-fontify-italic ()
3462 "Fontify italic text in the buffer containing halfdump."
3463 (goto-char (point-min))
3464 (while (search-forward "<i>" nil t)
3465 (let ((start (match-beginning 0)))
3466 (delete-region start (match-end 0))
3467 (when (re-search-forward "</i[ \t\r\f\n]*>" nil t)
3468 (delete-region (match-beginning 0) (match-end 0))
3469 (w3m-add-face-property start (match-beginning 0) 'w3m-italic)))))
3470
3471 (defun w3m-fontify-underline ()
3472 "Fontify underline text in the buffer containing halfdump."
3473 (goto-char (point-min))
3474 (while (search-forward "<u>" nil t)
3475 (let ((start (match-beginning 0)))
3476 (delete-region start (match-end 0))
3477 (when (re-search-forward "</u[ \t\r\f\n]*>" nil t)
3478 (delete-region (match-beginning 0) (match-end 0))
3479 (w3m-add-face-property start (match-beginning 0) 'w3m-underline)))))
3480
3481 (defun w3m-fontify-strike-through ()
3482 "Fontify strike-through text in the buffer containing halfdump."
3483 (goto-char (point-min))
3484 (cond
3485 ((and (eq w3m-display-ins-del 'fontify)
3486 (w3m-device-on-window-system-p))
3487 (while (search-forward "<s>" nil t)
3488 (let ((start (match-beginning 0)))
3489 (delete-region start (match-end 0))
3490 (when (re-search-forward "</s[ \t\r\f\n]*>" nil t)
3491 (delete-region (match-beginning 0) (match-end 0))
3492 (w3m-add-face-property start (match-beginning 0)
3493 'w3m-strike-through)))))
3494 ((w3m-device-on-window-system-p)
3495 (while (re-search-forward
3496 (concat "<U>\\(?:\\(?::\\(?:\\(?:DEL\\|S\\)]\\)\\|"
3497 "\\[\\(?:\\(?:DEL\\|S\\):\\)\\)</U>\\)")
3498 nil t)
3499 (w3m-add-face-property (match-beginning 0) (match-end 0)
3500 'w3m-strike-through)))))
3501
3502 (defun w3m-fontify-insert ()
3503 "Fontify insert text in the buffer containing halfdump."
3504 (goto-char (point-min))
3505 (cond
3506 ((and (eq w3m-display-ins-del 'fontify)
3507 (w3m-device-on-window-system-p))
3508 (while (search-forward "<ins>" nil t)
3509 (let ((start (match-beginning 0)))
3510 (delete-region start (match-end 0))
3511 (when (re-search-forward "</ins[ \t\r\f\n]*>" nil t)
3512 (delete-region (match-beginning 0) (match-end 0))
3513 (w3m-add-face-property start (match-beginning 0) 'w3m-insert)))))
3514 ((w3m-device-on-window-system-p)
3515 (while (re-search-forward "<U>\\(?:\\(?::INS]\\|\\[INS:\\)</U>\\)"
3516 nil t)
3517 (w3m-add-face-property (match-beginning 0) (match-end 0) 'w3m-insert)))))
3518
3519 (defun w3m-decode-anchor-string (str)
3520 ;; FIXME: This is a quite ad-hoc function to process encoded url string.
3521 ;; More discussion about timing &-sequence decode is required. The
3522 ;; following article (written in Japanese) is the origin of this issue:
3523 ;;
3524 ;; [emacs-w3m:00150] <URL:http://emacs-w3m.namazu.org/ml/msg00149.html>
3525 ;;
3526 ;; Takaaki MORIYAMA wrote in the article that the string "&amp;" which
3527 ;; is replaced from "&" and embedded in the w3m's halfdump should be
3528 ;; restored into "&" some time.
3529 (let ((start 0) (buf))
3530 (while (string-match "\\(&amp;\\)\\|\\([\t\r\f\n]+\\)" str start)
3531 (setq buf (cons (if (match-beginning 1) "&" " ")
3532 (cons (substring str start (match-beginning 0)) buf))
3533 start (match-end 0)))
3534 (apply (function concat)
3535 (nreverse (cons (substring str start) buf)))))
3536
3537 (defun w3m-image-type (content-type)
3538 "Return an image type which corresponds to CONTENT-TYPE."
3539 (cdr (assoc content-type w3m-image-type-alist)))
3540
3541 (defun w3m-imitate-widget-button ()
3542 "Return a boolean value corresponding to the variable of the same name."
3543 (if (listp w3m-imitate-widget-button)
3544 (condition-case nil
3545 (eval w3m-imitate-widget-button)
3546 (error nil))
3547 (and w3m-imitate-widget-button t)))
3548
3549 (defun w3m-fontify-anchors ()
3550 "Fontify anchor tags in the buffer which contains halfdump."
3551 (let ((help (w3m-make-help-echo w3m-balloon-help))
3552 (balloon (w3m-make-balloon-help w3m-balloon-help))
3553 prenames start end)
3554 (goto-char (point-min))
3555 (setq w3m-max-anchor-sequence 0) ;; reset max-hseq
3556 (while (re-search-forward "<_id[ \t\r\f\n]+" nil t)
3557 (setq start (match-beginning 0))
3558 (setq prenames (get-text-property start 'w3m-name-anchor))
3559 (w3m-parse-attributes (id)
3560 (delete-region start (point))
3561 (w3m-add-text-properties start (point-max)
3562 (list 'w3m-name-anchor
3563 (cons
3564 (w3m-decode-entities-string
3565 (w3m-url-transfer-encode-string
3566 id))
3567 prenames)))))
3568 (goto-char (point-min))
3569 (while (re-search-forward "<a[ \t\r\f\n]+" nil t)
3570 (setq start (match-beginning 0))
3571 (setq prenames (get-text-property start 'w3m-name-anchor2))
3572 (w3m-parse-attributes (href name id charset
3573 (rel :case-ignore) (hseq :integer))
3574 (unless name
3575 (setq name id))
3576 (when rel
3577 (setq rel (split-string rel))
3578 (cond
3579 ((member "next" rel) (setq w3m-next-url href))
3580 ((or (member "prev" rel) (member "previous" rel))
3581 (setq w3m-previous-url href))
3582 ((member "start" rel) (setq w3m-start-url href))
3583 ((member "contents" rel) (setq w3m-contents-url href))))
3584 (delete-region start (point))
3585 (cond
3586 (href
3587 (when (re-search-forward "[ \t\r\f\n]*\\(</a>\\)" nil t)
3588 (setq end (match-beginning 0))
3589 (delete-region (match-beginning 1) (match-end 1))
3590 (setq href (w3m-expand-url (w3m-decode-anchor-string href)))
3591 (unless (w3m-url-local-p href)
3592 (w3m-string-match-url-components href)
3593 (setq href (if (match-beginning 8)
3594 (let ((tmp (match-string 9 href)))
3595 (concat (w3m-url-transfer-encode-string
3596 (substring href 0 (match-beginning 8))
3597 (w3m-charset-to-coding-system charset))
3598 "#" tmp))
3599 (w3m-url-transfer-encode-string
3600 href
3601 (w3m-charset-to-coding-system charset)))))
3602 (setq hseq (or (and (null hseq) 0) (abs hseq)))
3603 (setq w3m-max-anchor-sequence (max hseq w3m-max-anchor-sequence))
3604 (w3m-add-face-property start end (if (w3m-arrived-p href)
3605 'w3m-arrived-anchor
3606 'w3m-anchor))
3607 (w3m-add-text-properties start end
3608 (list 'w3m-href-anchor href
3609 'w3m-balloon-help href
3610 'mouse-face 'highlight
3611 'w3m-anchor-sequence hseq
3612 'help-echo help
3613 'balloon-help balloon
3614 'keymap w3m-link-map))
3615 (when (w3m-imitate-widget-button)
3616 (require 'wid-edit)
3617 (let ((widget-button-face (if (w3m-arrived-p href)
3618 'w3m-arrived-anchor
3619 'w3m-anchor))
3620 (widget-mouse-face 'highlight)
3621 w)
3622 (setq w (widget-convert-button 'default start end
3623 :button-keymap nil
3624 :help-echo href))
3625 (w3m-static-unless (featurep 'xemacs)
3626 (overlay-put (widget-get w :button-overlay) 'evaporate t))))
3627 (when name
3628 (w3m-add-text-properties start (point-max)
3629 (list 'w3m-name-anchor2
3630 (cons
3631 (w3m-decode-entities-string
3632 (w3m-url-transfer-encode-string
3633 name))
3634 prenames))))))
3635 (name
3636 (w3m-add-text-properties start (point-max)
3637 (list 'w3m-name-anchor2
3638 (cons
3639 (w3m-decode-entities-string
3640 (w3m-url-transfer-encode-string
3641 name))
3642 prenames)))))))
3643 (when w3m-icon-data
3644 (setq w3m-icon-data (cons (and (car w3m-icon-data)
3645 (w3m-expand-url (car w3m-icon-data)))
3646 (or (w3m-image-type (cdr w3m-icon-data))
3647 'ico))))
3648 (when w3m-next-url
3649 (setq w3m-next-url (w3m-expand-url w3m-next-url)))
3650 (when w3m-previous-url
3651 (setq w3m-previous-url (w3m-expand-url w3m-previous-url)))
3652 (when w3m-start-url
3653 (setq w3m-start-url (w3m-expand-url w3m-start-url)))
3654 (when w3m-contents-url
3655 (setq w3m-contents-url (w3m-expand-url w3m-contents-url)))))
3656
3657 (eval-and-compile
3658 (unless (featurep 'xemacs)
3659 (defun w3m-setup-menu ()
3660 "Define menubar buttons for Emacsen."
3661 (w3m-menu-on-forefront w3m-menu-on-forefront t)
3662 (unless (keymapp (lookup-key w3m-mode-map [menu-bar w3m]))
3663 (let ((map (make-sparse-keymap (car w3m-menubar))))
3664 (define-key w3m-mode-map [menu-bar] (make-sparse-keymap))
3665 (w3m-setup-session-menu)
3666 (when w3m-use-tab-menubar (w3m-setup-tab-menu))
3667 (w3m-setup-bookmark-menu)
3668 (define-key w3m-mode-map [menu-bar w3m] (cons (car w3m-menubar) map))
3669 (require 'easymenu)
3670 (easy-menu-define
3671 w3m-mode-menu w3m-mode-map
3672 "w3m menu item" w3m-menubar)
3673 (easy-menu-add w3m-mode-menu))
3674 (let ((map (make-sparse-keymap)))
3675 (easy-menu-define
3676 w3m-rmouse-menu map
3677 "w3m rmouse menu item" w3m-rmouse-menubar))))))
3678
3679 (defun w3m-fontify-images ()
3680 "Fontify img_alt strings of images in the buffer containing halfdump."
3681 (goto-char (point-min))
3682 (let ((help (w3m-make-help-echo w3m-balloon-help))
3683 (balloon (w3m-make-balloon-help w3m-balloon-help))
3684 upper start end help src1)
3685 (while (re-search-forward "<\\(img_alt\\)[^>]+>" nil t)
3686 (setq upper (string= (match-string 1) "IMG_ALT")
3687 start (match-beginning 0)
3688 end (match-end 0))
3689 (goto-char (match-end 1))
3690 (w3m-parse-attributes (src
3691 (width :integer)
3692 (height :integer)
3693 title
3694 usemap)
3695 (delete-region start end)
3696 (setq src (w3m-expand-url (w3m-decode-anchor-string src)))
3697 ;; Use the identical Lisp object for a string used as the value of
3698 ;; the `w3m-image' property. A long title string will be chopped in
3699 ;; w3m's halfdump; since it makes `next-single-property-change' not
3700 ;; work properly, XEmacs didn't display images in shimbun articles.
3701 (if (equal src src1)
3702 (setq src src1)
3703 (setq src1 src))
3704 (when (search-forward "</img_alt>" nil t)
3705 (delete-region (setq end (match-beginning 0)) (match-end 0))
3706 (setq help (get-text-property start 'w3m-balloon-help))
3707 (cond
3708 ((and help title)
3709 (setq help (format "%s\nalt: %s\nimg: %s" help title src)))
3710 (help
3711 (setq help (format "%s\nimg: %s" help src)))
3712 (title
3713 (setq help (format "alt: %s\nimg: %s" title src)))
3714 (t
3715 (setq help (format "img: %s" src))))
3716 (w3m-add-text-properties start end
3717 (list 'w3m-image src
3718 'w3m-image-size
3719 (when (or width height)
3720 (cons width height))
3721 'w3m-image-alt title
3722 'w3m-balloon-help help
3723 'w3m-image-usemap usemap
3724 'w3m-image-status 'off
3725 'w3m-image-redundant upper
3726 'keymap w3m-link-map))
3727 (unless (w3m-action start)
3728 ;; No need to use `w3m-add-text-properties' here.
3729 (w3m-add-face-property start end
3730 (if (w3m-anchor start)
3731 'w3m-image-anchor
3732 'w3m-image))
3733 (unless (w3m-anchor start)
3734 (add-text-properties start end (list 'mouse-face 'highlight
3735 'help-echo help
3736 'balloon-help balloon)))))))))
3737
3738 (defvar w3m-idle-images-show-timer nil)
3739 (defvar w3m-idle-images-show-list nil)
3740 (defvar w3m-idle-images-show-interval 1)
3741
3742 (defun w3m-idle-images-show ()
3743 (let ((repeat t)
3744 (onbuffer (member (current-buffer) (w3m-list-buffers))))
3745 (while (and repeat w3m-idle-images-show-list)
3746 (let* ((item (or (and onbuffer
3747 (or (get-text-property (point) 'w3m-idle-image-item)
3748 (let* ((prev (previous-single-property-change
3749 (point) 'w3m-idle-image-item))
3750 (next (next-single-property-change
3751 (point) 'w3m-idle-image-item))
3752 (prev-diff (and prev (abs (- (point) prev))))
3753 (next-diff (and next (abs (- (point) next)))))
3754 (cond
3755 ((and prev next)
3756 (get-text-property
3757 (if (< prev-diff next-diff) prev next)
3758 'w3m-idle-image-item))
3759 (prev
3760 (get-text-property prev
3761 'w3m-idle-image-item))
3762 (next
3763 (get-text-property next
3764 'w3m-idle-image-item))
3765 (t nil)))))
3766 (car (last w3m-idle-images-show-list))))
3767 (start (nth 0 item))
3768 (end (nth 1 item))
3769 (iurl (nth 2 item))
3770 (url (nth 3 item))
3771 (no-cache (nth 4 item))
3772 (size (nth 5 item)))
3773 (setq w3m-idle-images-show-list
3774 (delete item w3m-idle-images-show-list))
3775 (if (buffer-live-p (marker-buffer start))
3776 (with-current-buffer (marker-buffer start)
3777 (save-restriction
3778 (widen)
3779 (let ((inhibit-read-only t))
3780 (remove-text-properties start end '(w3m-idle-image-item))
3781 (set-buffer-modified-p nil))
3782 (w3m-process-with-null-handler
3783 (lexical-let ((start start)
3784 (end end)
3785 (iurl iurl)
3786 (url url))
3787 (w3m-process-do
3788 (image (let ((w3m-current-buffer (current-buffer))
3789 (w3m-message-silent t))
3790 (w3m-create-image
3791 iurl no-cache
3792 url
3793 size handler)))
3794 (when (buffer-live-p (marker-buffer start))
3795 (with-current-buffer (marker-buffer start)
3796 (save-restriction
3797 (widen)
3798 (if image
3799 (when (equal url w3m-current-url)
3800 (let ((inhibit-read-only t))
3801 (w3m-insert-image start end image iurl))
3802 ;; Redisplay
3803 (when w3m-force-redisplay
3804 (sit-for 0)))
3805 (let ((inhibit-read-only t))
3806 (w3m-add-text-properties
3807 start end '(w3m-image-status off))))
3808 (set-buffer-modified-p nil))
3809 (set-marker start nil)
3810 (set-marker end nil))))))))
3811 (set-marker start nil)
3812 (set-marker end nil)
3813 (w3m-idle-images-show-unqueue (marker-buffer start))))
3814 (setq repeat (sit-for 0.1 t)))
3815 (if w3m-idle-images-show-list
3816 (when (input-pending-p)
3817 (cancel-timer w3m-idle-images-show-timer)
3818 (setq w3m-idle-images-show-timer
3819 (run-with-idle-timer w3m-idle-images-show-interval
3820 t
3821 'w3m-idle-images-show)))
3822 (cancel-timer w3m-idle-images-show-timer)
3823 (setq w3m-idle-images-show-timer nil))))
3824
3825 (defun w3m-idle-images-show-unqueue (buffer)
3826 (when w3m-idle-images-show-timer
3827 (cancel-timer w3m-idle-images-show-timer)
3828 (setq w3m-idle-images-show-timer nil)
3829 (setq w3m-idle-images-show-list
3830 (delq nil
3831 (mapcar (lambda (x)
3832 (and (not (eq buffer (marker-buffer (nth 0 x))))
3833 x))
3834 w3m-idle-images-show-list)))
3835 (when w3m-idle-images-show-list
3836 (setq w3m-idle-images-show-timer
3837 (run-with-idle-timer w3m-idle-images-show-interval
3838 t
3839 'w3m-idle-images-show)))))
3840
3841 (defvar w3m-image-no-idle-timer nil)
3842 (defun w3m-toggle-inline-images-internal (status
3843 &optional no-cache url
3844 begin-pos end-pos
3845 safe-regexp)
3846 "Toggle displaying of inline images on current buffer.
3847 STATUS is current image status.
3848 If NO-CACHE is non-nil, cache is not used.
3849 If URL is specified, only the image with URL is toggled."
3850 (let ((cur-point (point))
3851 (inhibit-read-only t)
3852 (end (or begin-pos (point-min)))
3853 (allow-non-secure-images (not w3m-confirm-leaving-secure-page))
3854 start iurl image size)
3855 (unless end-pos (setq end-pos (point-max)))
3856 (save-excursion
3857 (if (equal status 'off)
3858 (while (< (setq start
3859 (if (w3m-image end)
3860 end
3861 (next-single-property-change end 'w3m-image
3862 nil end-pos)))
3863 end-pos)
3864 (setq end (or (next-single-property-change start 'w3m-image)
3865 (point-max))
3866 iurl (w3m-image start)
3867 size (get-text-property start 'w3m-image-size))
3868 (when (and (or (and (not url)
3869 (or (not w3m-ignored-image-url-regexp)
3870 (not (string-match
3871 w3m-ignored-image-url-regexp
3872 iurl))))
3873 ;; URL is specified and is same as the image URL.
3874 (string= url iurl))
3875 (not (eq (get-text-property start 'w3m-image-status)
3876 'on)))
3877 (w3m-add-text-properties start end '(w3m-image-status on))
3878 (if (get-text-property start 'w3m-image-redundant)
3879 (progn
3880 ;; Insert a dummy string instead of a redundant image.
3881 (setq image (make-string
3882 (string-width (buffer-substring start end))
3883 ? ))
3884 (w3m-add-text-properties start end '(invisible t))
3885 (goto-char end)
3886 (w3m-add-text-properties
3887 end (progn (insert image) (point))
3888 '(w3m-image-dummy t w3m-image "dummy"))
3889 (setq end (point)))
3890 (goto-char cur-point)
3891 (when (and (w3m-url-valid iurl)
3892 (or (null safe-regexp)
3893 (string-match safe-regexp iurl))
3894 (not (and (not (w3m-url-local-p w3m-current-url))
3895 (w3m-url-local-p iurl)))
3896 (or (not w3m-current-ssl)
3897 (string-match "\\`\\(?:ht\\|f\\)tps://" iurl)
3898 allow-non-secure-images
3899 (and (prog1
3900 (y-or-n-p "\
3901 You are retrieving non-secure image(s). Continue? ")
3902 (message nil))
3903 (setq allow-non-secure-images t))))
3904 (if (or w3m-image-no-idle-timer
3905 (and (null (and size w3m-resize-images))
3906 (or (string-match "\\`\\(?:cid\\|data\\):" iurl)
3907 (w3m-url-local-p iurl)
3908 (w3m-cache-available-p iurl))))
3909 (w3m-process-with-null-handler
3910 (lexical-let ((start (set-marker (make-marker) start))
3911 (end (set-marker (make-marker) end))
3912 (iurl iurl)
3913 (url w3m-current-url))
3914 (w3m-process-do
3915 (image (let ((w3m-current-buffer (current-buffer)))
3916 (w3m-create-image
3917 iurl no-cache
3918 w3m-current-url
3919 size handler)))
3920 (when (buffer-live-p (marker-buffer start))
3921 (with-current-buffer (marker-buffer start)
3922 (if image
3923 (when (equal url w3m-current-url)
3924 (let ((inhibit-read-only t))
3925 (w3m-insert-image start end image iurl))
3926 ;; Redisplay
3927 (when w3m-force-redisplay
3928 (sit-for 0)))
3929 (let ((inhibit-read-only t))
3930 (w3m-add-text-properties
3931 start end '(w3m-image-status off))))
3932 (set-buffer-modified-p nil)))
3933 (set-marker start nil)
3934 (set-marker end nil))))
3935 (let ((item (list (set-marker (make-marker) start)
3936 (set-marker (make-marker) end)
3937 (w3m-url-transfer-encode-string iurl)
3938 w3m-current-url
3939 no-cache
3940 size)))
3941 (setq w3m-idle-images-show-list
3942 (cons item w3m-idle-images-show-list))
3943 (w3m-add-text-properties
3944 start end
3945 `(w3m-idle-image-item ,item))
3946 (unless w3m-idle-images-show-timer
3947 (setq w3m-idle-images-show-timer
3948 (run-with-idle-timer w3m-idle-images-show-interval
3949 t
3950 'w3m-idle-images-show)))))))))
3951 ;; Remove.
3952 (while (< (setq start (if (w3m-image end)
3953 end
3954 (next-single-property-change end 'w3m-image
3955 nil end-pos)))
3956 end-pos)
3957 (setq end (or (next-single-property-change start 'w3m-image)
3958 (point-max))
3959 iurl (w3m-image start))
3960 ;; IMAGE-ALT-STRING DUMMY-STRING
3961 ;; <--------w3m-image---------->
3962 ;; <---redundant--><---dummy--->
3963 ;; <---invisible-->
3964 (when (and (or (not url)
3965 ;; URL is specified and is not same as the image URL.
3966 (string= url iurl))
3967 (not (eq (get-text-property start 'w3m-image-status)
3968 'off)))
3969 (cond
3970 ((get-text-property start 'w3m-image-redundant)
3971 ;; Remove invisible property.
3972 (put-text-property start end 'invisible nil))
3973 ((get-text-property start 'w3m-image-dummy)
3974 ;; Remove dummy string.
3975 (delete-region start end)
3976 (setq end start))
3977 (t (w3m-remove-image start end)))
3978 (w3m-add-text-properties start end
3979 '(w3m-image-status off
3980 w3m-idle-image-item nil))))
3981 (set-buffer-modified-p nil)))))
3982
3983 (defun w3m-toggle-inline-image (&optional force no-cache)
3984 "Toggle the visibility of an image under point or images in the region.
3985 If FORCE is non-nil, displaying an image is forced. If NO-CACHE is
3986 non-nil, cached data will not be used."
3987 (interactive "P")
3988 (unless (w3m-display-graphic-p)
3989 (error "Can't display images in this environment"))
3990 (let (toggle-list begin end)
3991 (if (w3m-region-active-p)
3992 (let ((p (region-beginning))
3993 iurl)
3994 (setq begin (region-beginning)
3995 end (region-end))
3996 (w3m-deactivate-region)
3997 (while (< p end)
3998 (setq p (next-single-property-change p 'w3m-image nil end))
3999 (when (and (< p end)
4000 (setq iurl (w3m-image p))
4001 (not (assoc iurl toggle-list)))
4002 (setq toggle-list (cons (cons iurl p) toggle-list)))))
4003 (setq toggle-list (and (w3m-image)
4004 `(,(cons (w3m-image) (point))))))
4005 (if toggle-list
4006 (dolist (x toggle-list)
4007 (let* ((url (car x))
4008 (pos (cdr x))
4009 (status (get-text-property pos 'w3m-image-status))
4010 safe-regexp)
4011 (if (and (get-text-property pos 'w3m-image-scale)
4012 (equal status 'off))
4013 (w3m-zoom-in-image 0)
4014 (if (w3m-url-valid url)
4015 (if (eq status 'on)
4016 (progn
4017 (if force (setq status 'off))
4018 (w3m-toggle-inline-images-internal
4019 status no-cache url
4020 (or begin (point-min))
4021 (or end (point-max))))
4022 (setq safe-regexp
4023 (get-text-property (point) 'w3m-safe-url-regexp))
4024 (if (or force
4025 (not safe-regexp)
4026 (string-match safe-regexp url))
4027 (w3m-toggle-inline-images-internal
4028 status no-cache url
4029 (or begin (point-min))
4030 (or end (point-max)))
4031 (when (interactive-p)
4032 (w3m-message "This image is considered to be unsafe;\
4033 use the prefix arg to force display"))))))))
4034 (if begin
4035 (w3m-message "No images in region")
4036 (w3m-message "No image at point")))))
4037
4038 (defun w3m-turnoff-inline-images ()
4039 "Turn off to display all images in the buffer or in the region."
4040 (interactive)
4041 (w3m-toggle-inline-images 'turnoff))
4042
4043 (defun w3m-toggle-inline-images (&optional force no-cache)
4044 "Toggle the visibility of all images in the buffer or in the region.
4045 If FORCE is neither nil nor `turnoff', displaying images is forced.
4046 The value `turnoff' is special; it turns displaying images off anyway.
4047 If NO-CACHE is non-nil, cached data will not be used.
4048
4049 Note that the status of whether images are visible is kept hereafter
4050 even in new sessions if the `w3m-toggle-inline-images-permanently'
4051 variable is non-nil (default=t)."
4052 (interactive "P")
4053 (unless (w3m-display-graphic-p)
4054 (error "Can't display images in this environment"))
4055 (let ((status (cond ((eq force 'turnoff) t)
4056 (force nil)
4057 (t w3m-display-inline-images)))
4058 (safe-p t)
4059 beg end safe-regexp pos url)
4060 (if (w3m-region-active-p)
4061 (progn
4062 (setq beg (region-beginning)
4063 end (region-end))
4064 (w3m-deactivate-region))
4065 (setq beg (point-min)
4066 end (point-max)))
4067 (unless status
4068 (when (setq safe-regexp (get-text-property (point) 'w3m-safe-url-regexp))
4069 ;; Scan the buffer for searching for an insecure image url.
4070 (setq pos beg)
4071 (setq
4072 safe-p
4073 (catch 'done
4074 (when (setq url (get-text-property pos 'w3m-image))
4075 (unless (string-match safe-regexp url)
4076 (throw 'done nil))
4077 (setq pos (next-single-property-change pos 'w3m-image)))
4078 (while (< pos end)
4079 (when (and
4080 (setq pos (next-single-property-change pos 'w3m-image
4081 nil end))
4082 (setq url (get-text-property pos 'w3m-image)))
4083 (unless (string-match safe-regexp url)
4084 (throw 'done nil)))
4085 (setq pos (next-single-property-change pos 'w3m-image
4086 nil end)))
4087 t))))
4088 (if (or force
4089 status
4090 (not safe-regexp)
4091 safe-p)
4092 (progn
4093 (unwind-protect
4094 (w3m-toggle-inline-images-internal (if status 'on 'off)
4095 no-cache nil beg end
4096 (unless (interactive-p)
4097 safe-regexp))
4098 (setq w3m-display-inline-images (not status))
4099 (when status
4100 (w3m-process-stop (current-buffer))
4101 (w3m-idle-images-show-unqueue (current-buffer)))
4102 (force-mode-line-update)))
4103 (w3m-message "There are some images considered unsafe;\
4104 use the prefix arg to force display"))))
4105
4106 (defun w3m-resize-inline-image-internal (url rate)
4107 "Resize an inline image on the cursor position.
4108 URL is a url of an image. RATE is a number of percent used when
4109 resizing an image."
4110 (let* ((inhibit-read-only t)
4111 (start (point))
4112 (end (or (next-single-property-change start 'w3m-image)
4113 (point-max)))
4114 (iurl (w3m-image start))
4115 (size (get-text-property start 'w3m-image-size))
4116 (iscale (or (get-text-property start 'w3m-image-scale) '100))
4117 (allow-non-secure-images (not w3m-confirm-leaving-secure-page))
4118 scale image)
4119 (w3m-add-text-properties start end '(w3m-image-status on))
4120 (setq scale (truncate (* iscale rate 0.01)))
4121 (w3m-add-text-properties start end (list 'w3m-image-scale scale))
4122 (if (get-text-property start 'w3m-image-redundant)
4123 (progn
4124 ;; Insert a dummy string instead of a redundant image.
4125 (setq image (make-string
4126 (string-width (buffer-substring start end))
4127 ? ))
4128 (w3m-add-text-properties start end '(invisible t))
4129 (w3m-add-text-properties (point)
4130 (progn (insert image) (point))
4131 '(w3m-image-dummy t
4132 w3m-image "dummy")))
4133 (when (and (w3m-url-valid iurl)
4134 (or (not w3m-current-ssl)
4135 (string-match "\\`\\(?:ht\\|f\\)tps://" iurl)
4136 allow-non-secure-images
4137 (and (prog1
4138 (y-or-n-p "\
4139 You are retrieving non-secure image(s). Continue? ")
4140 (message nil))
4141 (setq allow-non-secure-images t))))
4142 (w3m-process-with-null-handler
4143 (lexical-let ((start (set-marker (make-marker) start))
4144 (end (set-marker (make-marker) end))
4145 (iurl iurl)
4146 (rate scale)
4147 (url w3m-current-url))
4148 (w3m-process-do
4149 (image (let ((w3m-current-buffer (current-buffer)))
4150 (w3m-create-resized-image
4151 iurl
4152 rate
4153 w3m-current-url
4154 size handler)))
4155 (when (buffer-live-p (marker-buffer start))
4156 (with-current-buffer (marker-buffer start)
4157 (if image
4158 (when (equal url w3m-current-url)
4159 (let ((inhibit-read-only t))
4160 (w3m-static-when (featurep 'xemacs)
4161 (w3m-remove-image start end))
4162 (w3m-insert-image start end image iurl))
4163 ;; Redisplay
4164 (when w3m-force-redisplay
4165 (sit-for 0)))
4166 (let ((inhibit-read-only t))
4167 (w3m-add-text-properties
4168 start end '(w3m-image-status off))))
4169 (set-buffer-modified-p nil))
4170 (set-marker start nil)
4171 (set-marker end nil)))))))))
4172
4173 (defun w3m-zoom-in-image (&optional rate)
4174 "Zoom in an image on the point.
4175 Numeric prefix specifies how many percent the image is enlarged by
4176 \(30 means enlarging the image by 130%). The default is the value of
4177 the `w3m-resize-image-scale' variable."
4178 (interactive "P")
4179 (unless (w3m-display-graphic-p)
4180 (error "Can't display images in this environment"))
4181 (unless (w3m-imagick-convert-program-available-p)
4182 (error "ImageMagick's `convert' program is required"))
4183 (let ((url (w3m-image)))
4184 (if url
4185 (w3m-resize-inline-image-internal
4186 url
4187 (+ 100 (or rate w3m-resize-image-scale)))
4188 (w3m-message "No image at point"))))
4189
4190 (defun w3m-zoom-out-image (&optional rate)
4191 "Zoom out an image on the point.
4192 Numeric prefix specifies how many percent the image is shrunk by
4193 \(30 means shrinking the image by 70%). The default is the value of
4194 the `w3m-resize-image-scale' variable."
4195 (interactive "P")
4196 (unless (w3m-display-graphic-p)
4197 (error "Can't display images in this environment"))
4198 (unless (w3m-imagick-convert-program-available-p)
4199 (error "ImageMagick's `convert' program is required"))
4200 (let ((url (w3m-image)))
4201 (if url
4202 (w3m-resize-inline-image-internal
4203 url
4204 (- 100 (or rate w3m-resize-image-scale)))
4205 (w3m-message "No image at point"))))
4206
4207 (defun w3m-decode-entities (&optional keep-properties)
4208 "Decode entities in the current buffer.
4209 If optional KEEP-PROPERTIES is non-nil, text property is reserved."
4210 (save-excursion
4211 (goto-char (point-min))
4212 ;; Character entity references are case-sensitive.
4213 ;; Cf. http://www.w3.org/TR/1999/REC-html401-19991224/charset.html#h-5.3.2
4214 (let (case-fold-search start fid prop value)
4215 (while (re-search-forward w3m-entity-regexp nil t)
4216 (setq start (match-beginning 0)
4217 fid (get-text-property start 'w3m-form-field-id))
4218 (unless (and fid
4219 (save-match-data
4220 (string-match "/type=\\(?:text\\|select\\)/name=[^/]+/"
4221 fid)))
4222 (when keep-properties
4223 (setq prop (text-properties-at start)))
4224 (unless (eq (char-after (match-end 1)) ?\;)
4225 (goto-char (match-end 1)))
4226 ;; Note that `w3m-entity-value' breaks `match-data' at the 1st
4227 ;; time in XEmacs because of the autoloading unicode.elc for
4228 ;; the `ucs-to-char' function.
4229 (when (setq value (w3m-entity-value (match-string 1)))
4230 (delete-region start (point))
4231 (insert value))
4232 (when prop
4233 (w3m-add-text-properties start (point) prop)))))))
4234
4235 (defun w3m-decode-entities-string (str)
4236 "Decode entities in the string STR."
4237 (save-match-data
4238 ;; Character entity references are case-sensitive.
4239 ;; Cf. http://www.w3.org/TR/1999/REC-html401-19991224/charset.html#h-5.3.2
4240 (let ((case-fold-search) (pos 0) (buf))
4241 (while (string-match w3m-entity-regexp str pos)
4242 (setq buf (cons (or (w3m-entity-value (match-string 1 str))
4243 (match-string 1 str))
4244 (cons (substring str pos (match-beginning 0))
4245 buf))
4246 pos (if (eq (aref str (match-end 1)) ?\;)
4247 (match-end 0)
4248 (match-end 1))))
4249 (if buf
4250 (apply 'concat (nreverse (cons (substring str pos) buf)))
4251 str))))
4252
4253 (defun w3m-encode-specials-string (str)
4254 "Encode special characters in the string STR."
4255 (let ((pos 0)
4256 (buf))
4257 (while (string-match "[<>&]" str pos)
4258 (setq buf
4259 (cons ";"
4260 (cons (gethash (match-string 0 str) w3m-entity-reverse-table)
4261 (cons "&"
4262 (cons (substring str pos (match-beginning 0))
4263 buf))))
4264 pos (match-end 0)))
4265 (if buf
4266 (apply 'concat (nreverse (cons (substring str pos) buf)))
4267 str)))
4268
4269 (defun w3m-fontify ()
4270 "Fontify the current buffer."
4271 (let ((case-fold-search t)
4272 (inhibit-read-only t))
4273 (w3m-message "Fontifying...")
4274 (run-hooks 'w3m-fontify-before-hook)
4275 ;; Remove hidden anchors like "<a href=url> </a>".
4276 (goto-char (point-min))
4277 (while (re-search-forward "<a[\t\n ]+[^>]+>[\t\n ]*</a>" nil t)
4278 (delete-region (match-beginning 0) (match-end 0)))
4279 ;; Delete <?xml ... ?> tag
4280 (goto-char (point-min))
4281 (if (search-forward "<?xml" nil t)
4282 (let ((start (match-beginning 0)))
4283 (search-forward "?>" nil t)
4284 (delete-region start (match-end 0))
4285 (goto-char (point-min))))
4286 ;; Delete extra title tag.
4287 (let (start)
4288 (and (search-forward "<title>" nil t)
4289 (setq start (match-beginning 0))
4290 (search-forward "</title>" nil t)
4291 (delete-region start (match-end 0))))
4292 (w3m-fontify-bold)
4293 (w3m-fontify-italic)
4294 (w3m-fontify-strike-through)
4295 (w3m-fontify-insert)
4296 (w3m-fontify-underline)
4297 (when w3m-use-symbol
4298 (w3m-replace-symbol))
4299 (w3m-fontify-anchors)
4300 (when w3m-use-form
4301 (w3m-fontify-forms))
4302 (w3m-fontify-images)
4303 ;; Remove other markups.
4304 (goto-char (point-min))
4305 (while (re-search-forward "</?[A-Za-z_][^>]*>" nil t)
4306 (let* ((start (match-beginning 0))
4307 (fid (get-text-property start 'w3m-form-field-id)))
4308 (if (and fid (string-match "/type=text\\(?:area\\)?/" fid))
4309 (goto-char (1+ start))
4310 (delete-region start (match-end 0)))))
4311 ;; Decode escaped characters (entities).
4312 (w3m-decode-entities 'reserve-prop)
4313 (when w3m-use-form
4314 (w3m-fontify-textareas))
4315 (goto-char (point-min))
4316 (when w3m-delete-duplicated-empty-lines
4317 (while (re-search-forward "^[ \t]*\n\\(?:[ \t]*\n\\)+" nil t)
4318 (delete-region (match-beginning 0) (1- (match-end 0)))))
4319
4320 ;; FIXME: The code above reduces number of empty lines but one line
4321 ;; remains. While such empty lines might have been inserted for
4322 ;; making sure of rooms for displaying images, they all should be
4323 ;; removed since they are useless for emacs-w3m. However, currently
4324 ;; we don't have a proper way to identify whether they were inserted
4325 ;; intentionally by the author or not. So, we decided to remove only
4326 ;; that one at the beginning of the buffer though it is unwillingness.
4327 (goto-char (point-min))
4328 (skip-chars-forward "\t\n \e$B!!\e(B")
4329 (delete-region (point-min) (point-at-bol))
4330
4331 (w3m-header-line-insert)
4332 (put-text-property (point-min) (point-max)
4333 'w3m-safe-url-regexp w3m-safe-url-regexp)
4334 (w3m-message "Fontifying...done")
4335 (run-hooks 'w3m-fontify-after-hook)))
4336
4337 (defun w3m-refontify-anchor (&optional buff)
4338 "Refontify anchors as they have already arrived.
4339 It replaces the faces on the arrived anchors from `w3m-anchor' to
4340 `w3m-arrived-anchor'."
4341 (with-current-buffer (or buff (current-buffer))
4342 (let (prop)
4343 (when (and (eq major-mode 'w3m-mode)
4344 (get-text-property (point) 'w3m-anchor-sequence)
4345 (setq prop (get-text-property (point) 'face))
4346 (listp prop)
4347 (member 'w3m-anchor prop))
4348 (let ((start)
4349 (end (next-single-property-change (point) 'w3m-anchor-sequence))
4350 (inhibit-read-only t))
4351 (when (and end
4352 (setq start (previous-single-property-change
4353 end 'w3m-anchor-sequence))
4354 (w3m-arrived-p (get-text-property (point)
4355 'w3m-href-anchor)))
4356 (w3m-remove-face-property start end 'w3m-anchor)
4357 (w3m-remove-face-property start end 'w3m-arrived-anchor)
4358 (w3m-add-face-property start end 'w3m-arrived-anchor))
4359 (set-buffer-modified-p nil))))))
4360
4361 (defun w3m-url-completion (url predicate flag)
4362 "Completion function for URL."
4363 (if (string-match "\\`\\(?:file:\\|[/~]\\|\\.\\.?/\\|[a-zA-Z]:\\)" url)
4364 (if (eq flag 'lambda)
4365 (file-exists-p (w3m-url-to-file-name url))
4366 (let* ((partial
4367 (expand-file-name
4368 (cond
4369 ((string-match "\\`file:[^/]" url)
4370 (substring url 5))
4371 ((string-match "/\\(~\\)" url)
4372 (substring url (match-beginning 1)))
4373 (t (w3m-url-to-file-name url)))))
4374 (collection
4375 (let ((dir (file-name-directory partial)))
4376 (mapcar
4377 (lambda (f)
4378 (list (w3m-expand-file-name-as-url f dir)))
4379 (file-name-all-completions (file-name-nondirectory partial)
4380 dir)))))
4381 (setq partial
4382 (if (string-match "/\\.\\'" url)
4383 (concat (file-name-as-directory
4384 (w3m-expand-file-name-as-url partial))
4385 ".")
4386 (w3m-expand-file-name-as-url partial)))
4387 (cond
4388 ((not flag)
4389 (try-completion partial collection predicate))
4390 ((eq flag t)
4391 (all-completions partial collection predicate)))))
4392 (cond
4393 ((not flag)
4394 (try-completion url w3m-arrived-db))
4395 ((eq flag t)
4396 (all-completions url w3m-arrived-db))
4397 ((eq flag 'lambda)
4398 (if (w3m-arrived-p url) t nil)))))
4399
4400 (defun w3m-gmane-url-at-point ()
4401 "Return a url that indicates the thread page in Gmane.
4402 This function works only when the cursor stays in the References
4403 header or the Message-ID header, otherwise returns nil.
4404
4405 On the Message-ID header, the url that asks Gmane for the thread
4406 beginning with the current article will be generated.
4407 On the References header, the url that asks Gmane for the whole thread
4408 \(namely it begins with the article of the first ID in the header) will
4409 be generated. In that case, Gmane might fail to find the thread since
4410 it is possible that the root article has been posted to another group.
4411
4412 That it returns an invalid url for the article of the group which is
4413 not being archived in Gmane cannot be helped."
4414 (save-excursion
4415 (let ((fmt "http://news.gmane.org/group/thread=%s/force_load=t")
4416 (start (point))
4417 (inhibit-point-motion-hooks t)
4418 case-fold-search)
4419 (goto-char (point-min))
4420 (re-search-forward (concat "^\\(?:"
4421 (regexp-quote mail-header-separator)
4422 "\\)?$")
4423 nil 'move)
4424 (when (< start (point))
4425 (setq case-fold-search t)
4426 (save-restriction
4427 (narrow-to-region (point-min) (point))
4428 (goto-char start)
4429 (beginning-of-line)
4430 (while (and (memq (char-after) '(?\t ? ))
4431 (zerop (forward-line -1))))
4432 (when (looking-at
4433 "\\(?:Message-ID\\|References\\):[\t\n ]*<\\([^\t\n <>]+\\)>")
4434 (format
4435 fmt
4436 (w3m-url-encode-string (match-string-no-properties 1)
4437 nil t))))))))
4438
4439 (defun w3m-header-line-url ()
4440 "Return w3m-current-url if point on header line."
4441 (let ((faces (get-text-property (point) 'face)))
4442 (when (and (eq major-mode 'w3m-mode)
4443 (listp faces)
4444 (or (memq 'w3m-header-line-location-title faces)
4445 (memq 'w3m-header-line-location-content faces))
4446 w3m-current-url)
4447 w3m-current-url)))
4448
4449 (eval-and-compile
4450 (autoload 'ffap-url-at-point "ffap")
4451 (defalias 'w3m-url-at-point
4452 (cond ((and (featurep 'xemacs) (featurep 'mule))
4453 (lambda nil "\
4454 Like `ffap-url-at-point', except that text props will be stripped and
4455 iso646 characters are unified into ascii characters."
4456 (or (w3m-gmane-url-at-point)
4457 (w3m-header-line-url)
4458 (let ((left (buffer-substring-no-properties (point-at-bol)
4459 (point)))
4460 (right (buffer-substring-no-properties (point)
4461 (point-at-eol)))
4462 (regexp (format "[%c-%c]"
4463 (make-char 'latin-jisx0201 33)
4464 (make-char 'latin-jisx0201 126)))
4465 (diff (- (char-to-int (make-char 'latin-jisx0201 33))
4466 33))
4467 index)
4468 (while (setq index (string-match regexp left))
4469 (aset left index (- (aref left index) diff)))
4470 (while (setq index (string-match regexp right))
4471 (aset right index (- (aref right index) diff)))
4472 (with-temp-buffer
4473 (insert right)
4474 (goto-char (point-min))
4475 (insert left)
4476 (ffap-url-at-point))))))
4477 ((featurep 'xemacs)
4478 (lambda nil "\
4479 Like `ffap-url-at-point', except that text props will be stripped."
4480 (or (w3m-gmane-url-at-point)
4481 (w3m-header-line-url)
4482 (unless (fboundp 'ffap-url-at-point)
4483 ;; It is necessary to bind `ffap-xemacs'.
4484 (load "ffap" nil t))
4485 (let (ffap-xemacs)
4486 (ffap-url-at-point)))))
4487 (t
4488 (lambda nil
4489 (or (w3m-gmane-url-at-point)
4490 (w3m-header-line-url)
4491 (ffap-url-at-point)))))))
4492
4493 (eval-after-load "ffap"
4494 '(progn
4495 ;; Under XEmacs, `ffap-url-regexp' won't match to https urls.
4496 (if (and ffap-url-regexp
4497 (not (string-match ffap-url-regexp "https://foo"))
4498 (string-match "\\((\\|\\\\|\\)\\(http\\)\\(\\\\|\\|\\\\)\\)"
4499 ffap-url-regexp))
4500 (setq ffap-url-regexp (replace-match "\\1\\2s?\\3"
4501 nil nil ffap-url-regexp)))
4502 ;; Add nntp:.
4503 (if (and ffap-url-regexp
4504 (not (string-match ffap-url-regexp "nntp://bar"))
4505 (string-match "\\(\\\\(news\\\\(post\\\\)\\?:\\)\\(\\\\|\\)"
4506 ffap-url-regexp))
4507 (setq ffap-url-regexp (replace-match "\\1\\\\|nntp:\\2"
4508 nil nil ffap-url-regexp)))))
4509
4510 (defun w3m-active-region-or-url-at-point (&optional default=current)
4511 "Return an active region or a url around the cursor.
4512 In Transient Mark mode, deactivate the mark. If DEFAULT=CURRENT is
4513 non-nil, return the url of the current page by default."
4514 (if (w3m-region-active-p)
4515 (prog1
4516 (let ((string (buffer-substring-no-properties
4517 (region-beginning) (region-end))))
4518 (with-temp-buffer
4519 (insert string)
4520 (skip-chars-backward "\t\n\f\r \e$B!!\e(B")
4521 (delete-region (point) (point-max))
4522 (goto-char (point-min))
4523 (skip-chars-forward "\t\n\f\r \e$B!!\e(B")
4524 (delete-region (point-min) (point))
4525 (while (re-search-forward "\
4526 \\(?:[\t\f\r \e$B!!\e(B]+\n[\t\f\r \e$B!!\e(B]*\\|[\t\f\r \e$B!!\e(B]*\n[\t\f\r \e$B!!\e(B]+\\)+" nil t)
4527 (delete-region (match-beginning 0) (match-end 0)))
4528 (buffer-string)))
4529 (w3m-deactivate-region))
4530 (or (w3m-url-at-point)
4531 (w3m-anchor)
4532 (unless w3m-display-inline-images
4533 (w3m-image))
4534 (and default=current
4535 (stringp w3m-current-url)
4536 (if (string-match "\\`about://\\(?:header\\|source\\)/"
4537 w3m-current-url)
4538 (substring w3m-current-url (match-end 0))
4539 w3m-current-url)))))
4540
4541 (defun w3m-canonicalize-url (url &optional feeling-lucky)
4542 "Add a scheme part to an URL or make an URL for \"I'm Feeling Lucky on Google\"
4543 if it has no scheme part."
4544 (w3m-string-match-url-components url)
4545 (cond
4546 ((match-beginning 1)
4547 url)
4548 ((and (file-name-absolute-p url) (file-exists-p url))
4549 (concat "file://" url))
4550 (feeling-lucky
4551 (let* ((charset w3m-google-feeling-lucky-charset)
4552 (cs (w3m-charset-to-coding-system charset))
4553 (str (w3m-url-encode-string url cs t)))
4554 (format (concat "http://www.google.com/search"
4555 "?btnI=I%%27m+Feeling+Lucky&ie=%s&oe=%s&q=%s")
4556 charset charset str)))
4557 (t
4558 (concat "http://" url))))
4559
4560 (defun w3m-input-url (&optional prompt initial default quick-start
4561 feeling-lucky)
4562 "Read a url from the minibuffer, prompting with string PROMPT."
4563 (let (url)
4564 (w3m-arrived-setup)
4565 (cond ((null initial)
4566 (when (and (setq initial (w3m-active-region-or-url-at-point t))
4567 (not (string-match "[^\000-\177]" initial)))
4568 (setq initial (w3m-url-decode-string initial
4569 w3m-current-coding-system))))
4570 ((string= initial "")
4571 (setq initial nil)))
4572 (when initial
4573 (setq initial (w3m-puny-decode-url initial)))
4574 (cond ((null default)
4575 (setq default w3m-home-page))
4576 ((string= default "")
4577 (setq default nil)))
4578 (if (and quick-start
4579 default
4580 (not initial))
4581 default
4582 (unless w3m-enable-google-feeling-lucky
4583 (setq feeling-lucky nil))
4584 (setq url (let ((minibuffer-setup-hook
4585 (append minibuffer-setup-hook
4586 (list (lambda ()
4587 (beginning-of-line)
4588 (if (looking-at "[a-z]+:\\(?:/+\\)?")
4589 (goto-char (match-end 0)))))))
4590 (ofunc (lookup-key minibuffer-local-completion-map " ")))
4591 (when feeling-lucky
4592 (define-key minibuffer-local-completion-map " "
4593 'self-insert-command))
4594 (unwind-protect
4595 (completing-read
4596 (if prompt
4597 (if default
4598 (progn
4599 (when (string-match " *: *\\'" prompt)
4600 (setq prompt
4601 (substring prompt 0
4602 (match-beginning 0))))
4603 (concat prompt " (default "
4604 (if (equal default w3m-home-page)
4605 "HOME"
4606 default)
4607 "): "))
4608 prompt)
4609 (if default
4610 (format "URL %s(default %s): "
4611 (if feeling-lucky "or Keyword " "")
4612 (if (stringp default)
4613 (if (eq default w3m-home-page)
4614 "HOME" default)
4615 (prin1-to-string default)))
4616 (if feeling-lucky "URL or Keyword: " "URL: ")))
4617 'w3m-url-completion nil nil initial
4618 'w3m-input-url-history default)
4619 (define-key minibuffer-local-completion-map " " ofunc))))
4620 (if (stringp url)
4621 (progn
4622 ;; remove duplication
4623 (setq w3m-input-url-history
4624 (cons url (delete url w3m-input-url-history)))
4625 (w3m-canonicalize-url url feeling-lucky))
4626 ;; It may be `popup'.
4627 url))))
4628
4629 ;;; Cache:
4630 (defun w3m-cache-setup ()
4631 "Initialize the variables for managing the cache."
4632 (unless (and (bufferp w3m-cache-buffer)
4633 (buffer-live-p w3m-cache-buffer))
4634 (with-current-buffer (w3m-get-buffer-create " *w3m cache*")
4635 (buffer-disable-undo)
4636 (set-buffer-multibyte nil)
4637 (setq buffer-read-only t
4638 w3m-cache-buffer (current-buffer)
4639 w3m-cache-hashtb (make-vector 1021 0)))))
4640
4641 (defun w3m-cache-shutdown ()
4642 "Clear all the variables managing the cache, and the cache itself."
4643 (when (buffer-live-p w3m-cache-buffer)
4644 (kill-buffer w3m-cache-buffer))
4645 (setq w3m-cache-hashtb nil
4646 w3m-cache-articles nil))
4647
4648 (defun w3m-cache-header-delete-variable-part (header)
4649 (let (buf flag)
4650 (dolist (line (split-string header "\n+"))
4651 (if (string-match "\\`\\(?:Date\\|Server\\|W3m-[^:]+\\):" line)
4652 (setq flag t)
4653 (unless (and flag (string-match "\\`[ \t]" line))
4654 (setq flag nil)
4655 (push line buf))))
4656 (mapconcat (function identity) (nreverse buf) "\n")))
4657
4658 (defun w3m-cache-header (url header &optional overwrite)
4659 "Store HEADER into the cache so that it corresponds to URL.
4660 If OVERWRITE is non-nil, it forces the storing even if there has
4661 already been the data corresponding to URL in the cache."
4662 (w3m-cache-setup)
4663 (let ((ident (intern url w3m-cache-hashtb)))
4664 (if (boundp ident)
4665 (if (and
4666 (not overwrite)
4667 (string=
4668 (w3m-cache-header-delete-variable-part header)
4669 (w3m-cache-header-delete-variable-part (symbol-value ident))))
4670 (symbol-value ident)
4671 (w3m-cache-remove url)
4672 (set ident header))
4673 (set ident header))))
4674
4675 (defun w3m-cache-request-header (url)
4676 "Return the header string of URL when it is stored in the cache."
4677 (w3m-cache-setup)
4678 (let ((ident (intern url w3m-cache-hashtb)))
4679 (and (boundp ident)
4680 (symbol-value ident))))
4681
4682 (defun w3m-cache-remove-oldest ()
4683 (with-current-buffer w3m-cache-buffer
4684 (goto-char (point-min))
4685 (unless (zerop (buffer-size))
4686 (let ((ident (get-text-property (point) 'w3m-cache))
4687 (inhibit-read-only t))
4688 ;; Remove the ident from the list of articles.
4689 (when ident
4690 (setq w3m-cache-articles (delq ident w3m-cache-articles)))
4691 ;; Delete the article itself.
4692 (delete-region (point)
4693 (next-single-property-change
4694 (1+ (point)) 'w3m-cache nil (point-max)))))))
4695
4696 (defun w3m-cache-remove (url)
4697 "Remove the data coresponding to URL from the cache."
4698 (w3m-cache-setup)
4699 (let ((ident (intern url w3m-cache-hashtb))
4700 beg end)
4701 (when (memq ident w3m-cache-articles)
4702 ;; It was in the cache.
4703 (with-current-buffer w3m-cache-buffer
4704 (let ((inhibit-read-only t))
4705 (when (setq beg (text-property-any
4706 (point-min) (point-max) 'w3m-cache ident))
4707 ;; Find the end (i. e., the beginning of the next article).
4708 (setq end (next-single-property-change
4709 (1+ beg) 'w3m-cache (current-buffer) (point-max)))
4710 (delete-region beg end)))
4711 (setq w3m-cache-articles (delq ident w3m-cache-articles))))))
4712
4713 (defun w3m-cache-contents (url buffer)
4714 "Store the contents of URL into the cache.
4715 The contents are assumed to be in BUFFER. Return a symbol which
4716 identifies the data in the cache."
4717 (w3m-cache-setup)
4718 (let ((ident (intern url w3m-cache-hashtb)))
4719 (w3m-cache-remove url)
4720 ;; Remove the oldest article, if necessary.
4721 (and (numberp w3m-keep-cache-size)
4722 (>= (length w3m-cache-articles) w3m-keep-cache-size)
4723 (w3m-cache-remove-oldest))
4724 ;; Insert the new article.
4725 (with-current-buffer w3m-cache-buffer
4726 (let ((inhibit-read-only t))
4727 (goto-char (point-max))
4728 (let ((b (point)))
4729 (insert-buffer-substring buffer)
4730 ;; Tag the beginning of the article with the ident.
4731 (when (> (point-max) b)
4732 (w3m-add-text-properties b (1+ b) (list 'w3m-cache ident))
4733 (setq w3m-cache-articles (cons ident w3m-cache-articles))
4734 ident))))))
4735
4736 (defun w3m-cache-request-contents (url &optional buffer)
4737 "Insert contents of URL into BUFFER.
4738 Return t if the contents are found in the cache, otherwise nil. When
4739 BUFFER is nil, all contents will be inserted in the current buffer."
4740 (w3m-cache-setup)
4741 (let ((ident (intern url w3m-cache-hashtb)))
4742 (when (memq ident w3m-cache-articles)
4743 ;; It was in the cache.
4744 (let (beg end)
4745 (with-current-buffer w3m-cache-buffer
4746 (if (setq beg (text-property-any
4747 (point-min) (point-max) 'w3m-cache ident))
4748 ;; Find the end (i.e., the beginning of the next article).
4749 (setq end (next-single-property-change
4750 (1+ beg) 'w3m-cache (current-buffer) (point-max)))
4751 ;; It wasn't in the cache after all.
4752 (setq w3m-cache-articles (delq ident w3m-cache-articles))))
4753 (and beg
4754 end
4755 (with-current-buffer (or buffer (current-buffer))
4756 (let ((inhibit-read-only t))
4757 (insert-buffer-substring w3m-cache-buffer beg end))
4758 t))))))
4759
4760 ;; FIXME: we need to check whether contents were updated in remote servers.
4761 (defun w3m-cache-available-p (url)
4762 "Return non-nil if a content of URL has already been cached."
4763 (w3m-cache-setup)
4764 (when (stringp url)
4765 (let ((ident (intern url w3m-cache-hashtb)))
4766 (and
4767 (memq ident w3m-cache-articles)
4768 (or
4769 w3m-prefer-cache
4770 (save-match-data
4771 (let ((case-fold-search t)
4772 (head (and (boundp ident) (symbol-value ident)))
4773 time expire)
4774 (cond
4775 ((and (string-match "^\\(?:date\\|etag\\):[ \t]" head)
4776 (or (string-match "^pragma:[ \t]+no-cache\n" head)
4777 (string-match
4778 "^cache-control:\\(?:[^\n]+\\)?[ \t,]\\(?:no-cache\\|max-age=0\\)[,\n]"
4779 head)))
4780 nil)
4781 ((and
4782 (string-match "^date:[ \t]\\([^\n]+\\)\n" head)
4783 (setq time (match-string 1 head))
4784 (setq time (w3m-time-parse-string time))
4785 (string-match "^cache-control:\\(?:[^\n]+\\)?[ \t,]max-age=\\([1-9][0-9]*\\)"
4786 head)
4787 (setq expire (string-to-number (match-string 1 head))))
4788 (setq time (decode-time time))
4789 (setcar time (+ (car time) expire))
4790 ;; Work around too large integer.
4791 (when (floatp (car time))
4792 (setcar time (eval '(lsh -1 -1))))
4793 (setq expire (apply 'encode-time time))
4794 (w3m-time-newer-p expire (current-time)))
4795 ((and
4796 (string-match "^expires:[ \t]+\\([^\n]+\\)\n" head)
4797 (setq expire (match-string 1 head))
4798 (setq expire (w3m-time-parse-string expire)))
4799 (w3m-time-newer-p expire (current-time)))
4800 (t
4801 ;; Adhoc heuristic rule: pages with neither
4802 ;; Last-Modified header and ETag header are treated as
4803 ;; dynamically-generated pages.
4804 (string-match "^\\(?:last-modified\\|etag\\):" head))))))
4805 ident))))
4806
4807 (defun w3m-read-file-name (&optional prompt dir default existing)
4808 (when default
4809 (setq default (file-name-nondirectory (w3m-url-strip-query default))))
4810 (unless prompt
4811 (setq prompt (if (and default (not (string-equal default "")))
4812 (format "Save to (%s): " default)
4813 "Save to: ")))
4814 (setq dir (file-name-as-directory (or dir w3m-default-save-directory)))
4815 (let ((default-directory dir)
4816 (file (read-file-name prompt dir nil existing default)))
4817 (if (not (file-directory-p file))
4818 (setq w3m-default-save-directory
4819 (or (file-name-directory file) w3m-default-save-directory))
4820 (setq w3m-default-save-directory file)
4821 (if default
4822 (setq file (expand-file-name default file))))
4823 (expand-file-name file)))
4824
4825 ;;; Handling character sets:
4826 (defun w3m-charset-to-coding-system (charset)
4827 "Return a coding system which is most suitable to CHARSET.
4828 CHARSET is a symbol whose name is MIME charset.
4829 This function is imported from mcharset.el."
4830 (if (stringp charset)
4831 (setq charset (intern (downcase charset))))
4832 (let ((cs (assq charset w3m-charset-coding-system-alist)))
4833 (w3m-find-coding-system (if cs (cdr cs) charset))))
4834
4835 (defun w3m-coding-system-to-charset (coding-system)
4836 "Return the MIME charset corresponding to CODING-SYSTEM."
4837 (when coding-system
4838 (w3m-static-if (featurep 'xemacs)
4839 (when (or (fboundp 'coding-system-to-mime-charset)
4840 (progn
4841 (require 'mcharset)
4842 (fboundp 'coding-system-to-mime-charset)))
4843 (defalias 'w3m-coding-system-to-charset
4844 'coding-system-to-mime-charset)
4845 (w3m-coding-system-to-charset coding-system))
4846 (or (coding-system-get coding-system :mime-charset)
4847 (coding-system-get coding-system 'mime-charset)))))
4848
4849 ;; FIXME: we need to investigate the kind of Content-Charsets being
4850 ;; actually possible.
4851 (defun w3m-read-content-charset (prompt &optional default)
4852 "Read a content charset from the minibuffer, prompting with string PROMPT.
4853 The second argument DEFAULT is the default value, which is used as the
4854 value to return if the user enters the empty string."
4855 (let ((charset (completing-read
4856 prompt
4857 (nconc
4858 (mapcar (lambda (c) (cons (symbol-name c) c))
4859 (coding-system-list))
4860 (mapcar (lambda (c) (cons (symbol-name (car c)) c))
4861 w3m-charset-coding-system-alist))
4862 nil t)))
4863 (if (string= "" charset)
4864 default
4865 charset)))
4866
4867
4868 ;;; Handling encoding of contents:
4869 (defun w3m-decode-encoded-contents (encoding)
4870 "Decode encoded contents in the current buffer.
4871 It supports the encoding types of gzip, bzip2, deflate, etc."
4872 (let ((x (and (stringp encoding)
4873 (assoc (downcase encoding) w3m-encoding-alist))))
4874 (or (not (and x (setq x (cdr (assq (cdr x) w3m-decoder-alist)))))
4875 (let ((coding-system-for-write 'binary)
4876 (coding-system-for-read 'binary)
4877 (default-process-coding-system (cons 'binary 'binary)))
4878 (w3m-process-with-environment w3m-command-environment
4879 (zerop (apply 'call-process-region
4880 (point-min) (point-max)
4881 (w3m-which-command (car x))
4882 t '(t nil) nil (cadr x))))))))
4883
4884 (defmacro w3m-correct-charset (charset)
4885 `(or (and ,charset (stringp ,charset)
4886 (cdr (assoc (downcase ,charset) w3m-correct-charset-alist)))
4887 ,charset))
4888
4889 (defun w3m-detect-meta-charset ()
4890 (let ((case-fold-search t))
4891 (goto-char (point-min))
4892 (catch 'found
4893 (while (re-search-forward "<meta[ \t\r\f\n]+" nil t)
4894 (w3m-parse-attributes ((http-equiv :case-ignore)
4895 (content :case-ignore))
4896 (when (and (string= http-equiv "content-type")
4897 content
4898 (string-match ";[ \t\n]*charset=\\([^\";]+\\)" content))
4899 (throw 'found (match-string 1 content))))))))
4900
4901 (defun w3m-detect-xml-charset ()
4902 (let ((case-fold-search t))
4903 (goto-char (point-min))
4904 (when (looking-at "[ \t\r\f\n]*<\\?xml[ \t\r\f\n]+")
4905 (goto-char (match-end 0))
4906 (or (w3m-parse-attributes ((encoding :case-ignore))
4907 encoding)
4908 "utf-8"))))
4909
4910 (defvar w3m-compatible-encoding-alist
4911 '((gb2312 . gbk)
4912 (iso-8859-1 . windows-1252)
4913 (iso-8859-8 . windows-1255)
4914 (iso-8859-9 . windows-1254))
4915 "Alist of encodings and those supersets.
4916 The cdr of each element is used to decode data if it is available when
4917 the car is what the data specify as the encoding. Or, the car is used
4918 for decoding when the cdr that the data specify is not available.")
4919
4920 (defvar w3m-view-source-decode-level 0
4921 "Say whether `w3m-view-source' decodes html sources.
4922 Users should never modify the value. See also `w3m-view-source'.")
4923
4924 (defun w3m-decode-buffer (url &optional content-charset content-type)
4925 (let* ((sourcep (string-match "\\`about://source/" url))
4926 (level (if sourcep w3m-view-source-decode-level 0))
4927 cs)
4928 (unless (>= level 4)
4929 (unless content-type
4930 (setq content-type (w3m-content-type url)))
4931 (unless content-charset
4932 (setq content-charset
4933 (or (w3m-content-charset url)
4934 (when (or (string= "text/html" content-type) sourcep)
4935 (w3m-detect-meta-charset))
4936 (w3m-detect-xml-charset))))
4937 (cond
4938 ((or (and (stringp content-charset)
4939 (string= "x-moe-internal" (downcase content-charset)))
4940 (eq content-charset 'x-moe-internal))
4941 (setq cs (w3m-x-moe-decode-buffer))
4942 (setq content-charset (symbol-name cs)))
4943 (content-charset
4944 (setq content-charset (w3m-correct-charset content-charset))
4945 (setq cs (w3m-charset-to-coding-system content-charset))))
4946 (setq w3m-current-content-charset content-charset)
4947 (unless cs
4948 (setq cs (w3m-detect-coding-region
4949 (point-min) (point-max) (if (w3m-url-local-p url)
4950 nil
4951 w3m-coding-system-priority-list))))
4952 (setq w3m-current-coding-system
4953 (or (w3m-find-coding-system
4954 (cdr (assq cs w3m-compatible-encoding-alist)))
4955 (w3m-find-coding-system cs)
4956 (w3m-find-coding-system
4957 (car (rassq cs w3m-compatible-encoding-alist)))))
4958 ;; Decode `&#nnn;' entities in 128..159 and 160.
4959 (when (and (<= level 1)
4960 (rassq w3m-current-coding-system
4961 w3m-compatible-encoding-alist))
4962 (goto-char (point-min))
4963 (let ((case-fold-search t))
4964 (while (re-search-forward "\
4965 \\(?:&#\\(12[89]\\|1[3-5][0-9]\\)\;\\)\\|\\(?:&#x\\([89][0-9a-f]\\)\;\\)"
4966 nil t)
4967 (insert (prog1
4968 (if (match-beginning 1)
4969 (string-to-number (match-string 1))
4970 (string-to-number (match-string 2) 16))
4971 (delete-region (match-beginning 0) (match-end 0)))))
4972 (goto-char (point-min))
4973 (while (re-search-forward "\240\\|&#160;\\|&#xa0;" nil t)
4974 (replace-match "&nbsp;"))))
4975 (insert
4976 (prog1
4977 (decode-coding-string (buffer-string) w3m-current-coding-system)
4978 (erase-buffer)
4979 (set-buffer-multibyte t))))))
4980
4981 (defun w3m-x-moe-decode-buffer ()
4982 (let ((args '("-i" "-cs" "x-moe-internal"))
4983 (coding-system-for-read 'binary)
4984 (coding-system-for-write 'binary)
4985 (default-process-coding-system (cons 'binary 'binary))
4986 charset)
4987 (if (w3m-find-coding-system 'utf-8)
4988 (setq args (append args '("-o" "-cs" "utf-8"))
4989 charset 'utf-8)
4990 (setq args
4991 (append args (list "-o" "-cs" (symbol-name w3m-coding-system))))
4992 (setq charset w3m-coding-system))
4993 (w3m-process-with-environment w3m-command-environment
4994 (apply 'call-process-region (point-min) (point-max)
4995 w3m-mbconv-command t t nil args))
4996 charset))
4997
4998 (defun w3m-safe-decode-buffer (url &optional content-charset content-type)
4999 (and (not w3m-current-coding-system)
5000 (stringp content-type)
5001 (string-match "\\`text/" content-type)
5002 (w3m-decode-buffer url content-charset content-type)))
5003
5004 ;;; Retrieving local data:
5005 (defun w3m-local-file-type (url)
5006 "Return the content type and the content encoding of URL."
5007 (setq url (or (w3m-url-to-file-name url)
5008 (file-name-nondirectory url)))
5009 (if (or (and (file-name-absolute-p url)
5010 (file-directory-p url))
5011 (string-match "\\`news:" url)) ;; FIXME: isn't this a kludge?
5012 (cons "text/html" nil)
5013 (let ((encoding
5014 (catch 'encoding-detected
5015 (dolist (elem w3m-encoding-type-alist)
5016 (when (string-match (car elem) url)
5017 (setq url (substring url 0 (match-beginning 0)))
5018 (throw 'encoding-detected (cdr elem)))))))
5019 (cons (catch 'type-detected
5020 (dolist (elem w3m-content-type-alist)
5021 (when (and (cadr elem) (string-match (cadr elem) url))
5022 (throw 'type-detected (car elem))))
5023 "unknown")
5024 encoding))))
5025
5026 (defmacro w3m-local-content-type (url)
5027 `(car (w3m-local-file-type ,url)))
5028
5029 (defun w3m-local-attributes (url &rest args)
5030 "Return a list of attributes corresponding to URL.
5031 Return nil if it failed in retrieving of the header.
5032 Otherwise, return a list which includes the following elements:
5033
5034 0. Type of contents.
5035 1. Charset of contents.
5036 2. Size in bytes.
5037 3. Encoding of contents.
5038 4. Last modification time.
5039 5. Real URL.
5040 "
5041 (let* ((file (w3m-url-to-file-name url))
5042 (attr (when (file-exists-p file)
5043 (file-attributes file)))
5044 (type (w3m-local-file-type url)))
5045 (list (or (w3m-arrived-content-type url) (car type))
5046 nil
5047 (nth 7 attr)
5048 (cdr type)
5049 (nth 5 attr)
5050 (w3m-expand-file-name-as-url (file-truename file)))))
5051
5052 (defun w3m-local-retrieve (url &optional no-uncompress &rest args)
5053 "Retrieve contents of local URL and put it into the current buffer.
5054 This function will return the content-type of URL as a string when
5055 retrieval is successful."
5056 (let ((file (w3m-url-to-file-name url)))
5057 (when (file-readable-p file)
5058 (if (file-directory-p file)
5059 (w3m-local-dirlist-cgi url)
5060 (let ((coding-system-for-read 'binary))
5061 (if no-uncompress
5062 (let (jka-compr-compression-info-list
5063 format-alist)
5064 (insert-file-contents file))
5065 (insert-file-contents file))))
5066 (or (w3m-arrived-content-type url)
5067 (w3m-local-content-type file)))))
5068
5069 (defun w3m-local-dirlist-cgi (url)
5070 (w3m-message "Reading %s..." (w3m-url-readable-string url))
5071 (if w3m-dirlist-cgi-program
5072 (if (file-executable-p w3m-dirlist-cgi-program)
5073 (let ((coding-system-for-read 'binary)
5074 (default-process-coding-system
5075 (cons 'binary 'binary))
5076 (lcookie (make-temp-name
5077 (format "%s.%d." (user-login-name) (emacs-pid))))
5078 (cfile (make-temp-name
5079 (expand-file-name "w3melck" w3m-profile-directory)))
5080 (env (copy-sequence w3m-command-environment))
5081 file)
5082 (with-temp-buffer
5083 (insert lcookie)
5084 (write-region (point-min) (point-max) cfile 'nomsg))
5085 (w3m-process-with-environment
5086 (append
5087 (list
5088 (cons "LOCAL_COOKIE" lcookie)
5089 (cons "LOCAL_COOKIE_FILE" cfile)
5090 (cons "QUERY_STRING"
5091 (format
5092 "dir=%s&cookie=%s"
5093 (encode-coding-string (w3m-url-to-file-name url)
5094 w3m-file-name-coding-system)
5095 lcookie)))
5096 (delq (assoc "LOCAL_COOKIE" env)
5097 (delq (assoc "LOCAL_COOKIE_FILE" env)
5098 (delq (assoc "QUERY_STRING" env) env))))
5099 (call-process w3m-dirlist-cgi-program nil t nil))
5100 ;; delete local cookie file
5101 (when (and (file-exists-p cfile) (file-writable-p cfile))
5102 (delete-file cfile))
5103 (goto-char (point-min))
5104 (when (re-search-forward "^<html>" nil t)
5105 (delete-region (point-min) (match-beginning 0))
5106 (while (re-search-forward "<a href=\"\\([^\"]+\\)\"\\(?:>\\| \\)"
5107 nil t)
5108 (setq file (match-string 1))
5109 (delete-region (goto-char (match-beginning 1)) (match-end 1))
5110 (if (file-directory-p file)
5111 (setq file (w3m-expand-file-name-as-url
5112 (file-name-as-directory file)))
5113 (setq file (w3m-expand-file-name-as-url file)))
5114 (insert (encode-coding-string
5115 (w3m-url-decode-string file
5116 w3m-file-name-coding-system)
5117 w3m-file-name-coding-system)))))
5118 (error "Can't execute: %s" w3m-dirlist-cgi-program))
5119 ;; execute w3m internal CGI
5120 (w3m-process-with-wait-handler
5121 (setq w3m-current-url url)
5122 (w3m-process-start handler
5123 w3m-command
5124 (append w3m-command-arguments
5125 (list "-dump_source" url)))))
5126 ;; bind charset to w3m-file-name-coding-system
5127 (let ((charset (or (car (rassq w3m-file-name-coding-system
5128 w3m-charset-coding-system-alist))
5129 w3m-file-name-coding-system))
5130 beg)
5131 (goto-char (point-min))
5132 (when (search-forward "<head>" nil t)
5133 (insert "\n<meta http-equiv=\"CONTENT-TYPE\" "
5134 "content=\"text/html; charset="
5135 (symbol-name charset)
5136 "\">"))
5137 (goto-char (point-min))
5138 ;; Remove <form>...</form>
5139 (when (search-forward "<form " nil t)
5140 (setq beg (match-beginning 0))
5141 (when (search-forward "</form>" nil t)
5142 (delete-region beg (match-end 0)))))
5143 (w3m-message "Reading %s...done" (w3m-url-readable-string url)))
5144
5145 ;;; Retrieving data via HTTP:
5146 (defun w3m-remove-redundant-spaces (str)
5147 "Remove leading and trailing whitespace from STR."
5148 (save-match-data
5149 (when (string-match "\\`[ \t\r\f\n]+" str)
5150 (setq str (substring str (match-end 0))))
5151 (if (string-match "[ \t\r\f\n]+\\'" str)
5152 (substring str 0 (match-beginning 0))
5153 str)))
5154
5155 (defun w3m-w3m-parse-header (url header)
5156 "Parse a given string HEADER as a MIME header of URL.
5157 Return a list which includes:
5158
5159 0. Status code.
5160 1. Type of contents.
5161 2. Charset of contents.
5162 3. Size in bytes.
5163 4. Encoding of contents.
5164 5. Last modification time.
5165 6. Real URL.
5166 "
5167 (let ((case-fold-search t)
5168 (headers)
5169 (status))
5170 (dolist (line (split-string header "[ \f\t\r]*\n"))
5171 (cond
5172 ((string-match "\\`HTTP/1\\.[0-9] \\([0-9][0-9][0-9]\\)\\b" line)
5173 (setq status (string-to-number (match-string 1 line))))
5174 ((string-match (eval-when-compile
5175 (concat "\\`\\("
5176 (regexp-opt
5177 '(;; MEMO: \e$B%U%!%$%k$r%@%&%s%m!<%I$9$k\e(B
5178 ;; \e$B$H$-$N\e(B \e$BE,@Z$J%G%U%)%k%HL>$r7hDj\e(B
5179 ;; \e$B$9$k$?$a$K$O\e(B content-disposition
5180 ;; \e$B$N2r<a$,I,MW!%\e(B
5181 "content-disposition"
5182 "content-encoding"
5183 "content-length"
5184 ;; MEMO: See [emacs-w3m:02341].
5185 "content-transfer-encoding"
5186 "content-type"
5187 "last-modified"
5188 "location"
5189 "w3m-current-url"
5190 "w3m-document-charset"
5191 "w3m-ssl-certificate"
5192 "x-w3m-content-encoding"
5193 "alternates"))
5194 "\\):[ \t]*"))
5195 line)
5196 (push (cons (downcase (match-string 1 line))
5197 (substring line (match-end 0)))
5198 headers))))
5199 (let (alt real-url type charset xmoe)
5200 (when (and (setq alt (cdr (assoc "alternates" headers)))
5201 (string-match "\\`{[\t ]*\"\\(.+\\)\"" alt))
5202 (setq real-url (w3m-expand-url (match-string 1 alt) url))
5203 (when (string-match "{[\t ]*type[\t ]+\\([^\t }]+\\)" alt)
5204 (setq type (downcase (match-string 1 alt))))
5205 (when (string-match "{[\t ]*charset[\t ]+\\([^\t }]+\\)" alt)
5206 (setq charset (downcase (match-string 1 alt)))))
5207 (when (and (not type)
5208 (setq type (cdr (assoc "content-type" headers))))
5209 (if (string-match ";[ \t]*charset=\"?\\([^\"]+\\)\"?" type)
5210 (setq charset (w3m-remove-redundant-spaces
5211 (match-string 1 type))
5212 type (w3m-remove-redundant-spaces
5213 (substring type 0 (match-beginning 0))))
5214 (setq type (w3m-remove-redundant-spaces type)))
5215 (when (string-match ";" type)
5216 (setq type (substring type 0 (match-beginning 0))))
5217 (setq type (downcase type)))
5218 (setq w3m-current-ssl (cdr (assoc "w3m-ssl-certificate" headers)))
5219 (when (string-match "\\`ftps?:" url)
5220 (setq url (or (cdr (assoc "w3m-current-url" headers))
5221 url)))
5222 (when (and (setq xmoe (cdr (assoc "w3m-document-charset" headers)))
5223 (string= xmoe "x-moe-internal"))
5224 (setq charset xmoe))
5225 (list status
5226 (if (string-match "\\`ftps?:.*/\\'" url)
5227 "text/html"
5228 (or type (w3m-local-content-type url)))
5229 (if (string-match "\\`ftps?:.*/\\'" url)
5230 (if w3m-accept-japanese-characters
5231 "w3m-euc-japan" "w3m-iso-latin-1")
5232 charset)
5233 (let ((v (cdr (assoc "content-length" headers))))
5234 (and v (setq v (string-to-number v)) (> v 0) v))
5235 (cdr (or (assoc "content-encoding" headers)
5236 (assoc "x-w3m-content-encoding" headers)))
5237 (let ((v (cdr (assoc "last-modified" headers))))
5238 (and v (w3m-time-parse-string v)))
5239 (or real-url
5240 (let ((v (cdr (assoc "location" headers))))
5241 ;; RFC2616 says that the field value of the Location
5242 ;; response-header consists of a single absolute
5243 ;; URI. However, some broken servers return
5244 ;; relative URIs.
5245 (and v (w3m-expand-url v url)))
5246 url)))))
5247
5248 (defun w3m-w3m-dump-head (url handler)
5249 "Return the header string of URL."
5250 (lexical-let ((url url)
5251 (silent w3m-message-silent))
5252 (w3m-message "Request sent, waiting for response...")
5253 (w3m-process-do-with-temp-buffer
5254 (success (progn
5255 (setq w3m-current-url url
5256 url (w3m-url-strip-authinfo url))
5257 (w3m-process-start handler
5258 w3m-command
5259 (append w3m-command-arguments
5260 (list "-o" "follow_redirection=0"
5261 "-dump_head" url)))))
5262 (let ((w3m-message-silent silent))
5263 (w3m-message "Request sent, waiting for response...done")
5264 (when success
5265 (buffer-string))))))
5266
5267 (defun w3m-w3m-canonicalize-url (url)
5268 "Add a slash to an URL, when its server part is not ended with a slash."
5269 ;; Because URLs encountered in WEB documents are no less reliable
5270 ;; than URLs given by users, a minimum canonicalization may be
5271 ;; required in the backend side. For more detail, please see
5272 ;; [emacs-w3m:07000].
5273 (if (string-match "\\`\\(?:ht\\|f\\)tps?://[^/]+\\'" url)
5274 (concat url "/")
5275 url))
5276
5277 (defun w3m-w3m-attributes (url no-cache handler)
5278 "Return a list of attributes corresponding to URL.
5279 Return nil if it failed in retrieving of the header.
5280 Otherwise, return a list which includes the following elements:
5281
5282 0. Type of contents.
5283 1. Charset of contents.
5284 2. Size in bytes.
5285 3. Encoding of contents.
5286 4. Last modification time.
5287 5. Real URL.
5288
5289 If the optional argument NO-CACHE is non-nil, cache is not used."
5290 (w3m-w3m-attributes-1 (w3m-w3m-canonicalize-url url)
5291 no-cache
5292 (or w3m-follow-redirection 0)
5293 handler))
5294
5295 (defun w3m-w3m-attributes-1 (url no-cache counter handler)
5296 "A subroutine for `w3m-w3m-attributes'."
5297 (lexical-let ((url url)
5298 (no-cache no-cache)
5299 (counter counter))
5300 (w3m-process-do
5301 (header (or (unless no-cache
5302 (w3m-cache-request-header url))
5303 (w3m-w3m-dump-head url handler)))
5304 (when header
5305 (let ((attr (w3m-w3m-parse-header url header)))
5306 (w3m-cache-header url header)
5307 (if (memq (car attr) '(301 302 303 304 305 306 307))
5308 (if (zerop counter)
5309 ;; Redirect counter exceeds `w3m-follow-redirection'.
5310 (list "text/html" "us-ascii" nil nil nil url)
5311 ;; Follow redirection.
5312 (w3m-w3m-attributes-1 (nth 6 attr) no-cache
5313 (1- counter) handler))
5314 (cdr attr)))))))
5315
5316 (defun w3m-w3m-expand-arguments (arguments)
5317 (apply 'append
5318 (mapcar
5319 (lambda (x)
5320 (cond
5321 ((stringp x) (list x))
5322 ((setq x (eval x))
5323 (cond ((stringp x)
5324 (list x))
5325 ((listp x)
5326 (w3m-w3m-expand-arguments x))
5327 (t
5328 (let (print-level print-length)
5329 (list (prin1-to-string x))))))))
5330 arguments)))
5331
5332 (defun w3m-w3m-dump-extra (url handler)
5333 "Retrive headers and contents pointed to by URL"
5334 (lexical-let ((url url)
5335 (silent w3m-message-silent))
5336 (setq w3m-current-url url
5337 url (w3m-url-strip-authinfo url))
5338 (w3m-message "Reading %s...%s"
5339 (w3m-url-readable-string url)
5340 (if (and w3m-async-exec (not w3m-process-waited))
5341 (substitute-command-keys "\
5342 (Type `\\<w3m-mode-map>\\[w3m-process-stop]' to stop asynchronous process)")
5343 ""))
5344 (w3m-process-do
5345 (success
5346 (w3m-process-start handler
5347 w3m-command
5348 (append w3m-command-arguments
5349 (w3m-w3m-expand-arguments
5350 w3m-dump-head-source-command-arguments)
5351 (list url))))
5352 (let ((w3m-message-silent silent))
5353 (w3m-message "Reading %s...done" (w3m-url-readable-string url))
5354 (when success
5355 (goto-char (point-min))
5356 (let ((case-fold-search t))
5357 (when (and (re-search-forward "^w3m-current-url:" nil t)
5358 (progn
5359 (delete-region (point-min) (match-beginning 0))
5360 (search-forward "\n\n" nil t)))
5361 (let ((header (buffer-substring (point-min) (point))))
5362 (when w3m-use-cookies
5363 (w3m-cookie-set url (point-min) (point)))
5364 (delete-region (point-min) (point))
5365 (w3m-cache-header url header)
5366 (w3m-cache-contents url (current-buffer))
5367 (w3m-w3m-parse-header url header)))))))))
5368
5369 (defun w3m-additional-command-arguments (url)
5370 "Return a list of additional arguments passed to the w3m command.
5371 You may specify additional arguments for the particular urls using the
5372 option `w3m-command-arguments-alist', or using `w3m-no-proxy-domains'
5373 to add the option \"-no-proxy\"."
5374 (let ((defs w3m-command-arguments-alist)
5375 def args host)
5376 (while (and defs
5377 (null args))
5378 (setq def (car defs)
5379 defs (cdr defs))
5380 (when (string-match (car def) url)
5381 (setq args (cdr def))))
5382 (when (and w3m-no-proxy-domains
5383 (not (member "-no-proxy" args))
5384 (string-match "^[a-z]+://\\([^/:]+\\)" url)
5385 (catch 'domain-match
5386 (setq host (match-string 1 url))
5387 (dolist (domain w3m-no-proxy-domains)
5388 (when (string-match (concat "\\(?:^\\|\\.\\)"
5389 (regexp-quote domain)
5390 "$")
5391 host)
5392 (throw 'domain-match t)))))
5393 (push "-no-proxy" args))
5394 args))
5395
5396 (defun w3m-add-referer-p (url referer)
5397 "Return non-nil when URL and REFERER satisfies the condition
5398 specified by `w3m-add-referer'."
5399 (when (stringp referer)
5400 (cond
5401 ((eq w3m-add-referer 'lambda)
5402 (let (host)
5403 (w3m-string-match-url-components url)
5404 (when (match-beginning 4)
5405 (setq host (match-string 4 url))
5406 (w3m-string-match-url-components referer)
5407 (when (match-beginning 4)
5408 (string= host (match-string 4 referer))))))
5409 ((consp w3m-add-referer)
5410 (and (not (and (cdr w3m-add-referer)
5411 (string-match (cdr w3m-add-referer) referer)))
5412 (car w3m-add-referer)
5413 (string-match (car w3m-add-referer) referer)))
5414 ((functionp w3m-add-referer)
5415 (funcall w3m-add-referer url referer))
5416 (t w3m-add-referer))))
5417
5418 ;; Currently, -request argument is supported only by w3mmee.
5419 (defun w3m-request-arguments (method url temp-file
5420 &optional body referer content-type)
5421 "Make the arguments for `-request' or `-header' option passed to w3m.
5422 METHOD is an HTTP method name.
5423 TEMP-FILE is a name of temporal file to write request content to.
5424 Optional BODY is the body content string.
5425 Second optional REFERER is the Referer: field content.
5426 Third optional CONTENT-TYPE is the Content-Type: field content."
5427 (with-temp-buffer
5428 (let ((modes (default-file-modes))
5429 (cookie (and w3m-use-cookies (w3m-cookie-get url))))
5430 (if (and (null cookie)(null body)
5431 (null content-type))
5432 (append
5433 (when w3m-add-user-agent
5434 (list "-header" (concat "User-Agent:" w3m-user-agent)))
5435 (when (w3m-add-referer-p url referer)
5436 (list "-header" (concat "Referer: " referer)))
5437 (when w3m-accept-languages
5438 (list "-header" (concat
5439 "Accept-Language: "
5440 (mapconcat 'identity w3m-accept-languages
5441 " ")))))
5442 (when w3m-add-user-agent (insert "User-Agent: " w3m-user-agent "\n"))
5443 (when (w3m-add-referer-p url referer)
5444 (insert "Referer: " referer "\n"))
5445 (when w3m-accept-languages
5446 (insert "Accept-Language: "
5447 (mapconcat 'identity w3m-accept-languages " ") "\n"))
5448 (when cookie
5449 (insert "Cookie: " cookie "\n"))
5450 (when content-type
5451 (insert "Content-Type: " content-type "\n"))
5452 (insert "\n")
5453 (when body
5454 (insert body))
5455 (unwind-protect
5456 (let ((coding-system-for-write 'binary))
5457 (set-default-file-modes (* 64 6))
5458 (write-region (point-min) (point-max) temp-file nil 'silent))
5459 (set-default-file-modes modes))
5460 (list "-request" (concat method ":" temp-file))))))
5461
5462 ;; Currently, w3m uses this function.
5463 (defun w3m-header-arguments (method url temp-file
5464 &optional body referer content-type)
5465 "Make the arguments for the `-header' option passed to the w3m command.
5466 METHOD is an HTTP method name.
5467 TEMP-FILE is a name of temporal file to write post body to.
5468 Optional BODY is the post body content string.
5469 Optional second REFERER is the Referer: field content.
5470 Third optional CONTENT-TYPE is the Content-Type: field content."
5471 (let ((modes (default-file-modes))
5472 (cookie (and w3m-use-cookies (w3m-cookie-get url)))
5473 args)
5474 (when w3m-add-user-agent
5475 (setq args (nconc args
5476 (list "-o" (concat "user_agent=" w3m-user-agent)))))
5477 (when cookie
5478 (setq args (nconc args
5479 (list "-header" (concat "Cookie: " cookie)))))
5480 (when (and (string= method "post") temp-file)
5481 (with-temp-buffer
5482 (set-buffer-multibyte nil)
5483 (when body (insert body))
5484 (unwind-protect
5485 (let ((coding-system-for-write 'binary))
5486 (set-default-file-modes (* 64 6))
5487 (write-region (point-min) (point-max) temp-file nil 'silent))
5488 (set-default-file-modes modes)))
5489 (setq args (nconc args
5490 (when content-type
5491 (list "-header" (concat "Content-Type: "
5492 content-type)))
5493 (list "-post" temp-file))))
5494 (when (w3m-add-referer-p url referer)
5495 (setq args (nconc args (list "-header" (concat "Referer: " referer)))))
5496 args))
5497
5498 (defun w3m-w3m-retrieve (url no-uncompress no-cache post-data referer handler)
5499 "Retrieve web contents pointed to by URL using the external w3m command.
5500 It will put the retrieved contents into the current buffer. See
5501 `w3m-retrieve' for how does it work asynchronously with the arguments."
5502 (lexical-let ((url (w3m-w3m-canonicalize-url url))
5503 (no-uncompress no-uncompress)
5504 (current-buffer (current-buffer))
5505 (silent w3m-message-silent))
5506 (w3m-process-do-with-temp-buffer
5507 (attr (progn
5508 (set-buffer-multibyte nil)
5509 (w3m-w3m-retrieve-1 url post-data referer no-cache
5510 (or w3m-follow-redirection 0) handler)))
5511 (let ((w3m-message-silent silent))
5512 (when attr
5513 (cond
5514 ((eq attr 'redirection-exceeded)
5515 "X-w3m-error/redirection")
5516 ((or (not (string-match "\\`https?:" url))
5517 (memq (car attr) '(200 300)))
5518 (if (or no-uncompress
5519 (w3m-decode-encoded-contents (nth 4 attr)))
5520 (let ((temp-buffer (current-buffer)))
5521 (with-current-buffer current-buffer
5522 (insert-buffer-substring temp-buffer))
5523 (goto-char (point-min))
5524 (cadr attr))
5525 (ding)
5526 (w3m-message "Can't decode encoded contents: %s" url)
5527 nil))
5528 (t nil)))))))
5529
5530 (defun w3m-w3m-retrieve-1 (url post-data referer no-cache counter handler)
5531 "A subroutine for `w3m-w3m-retrieve'."
5532 (let ((w3m-command-arguments
5533 (append w3m-command-arguments
5534 (when (member "cookie" w3m-compile-options)
5535 (list "-no-cookie"))
5536 (list "-o" "follow_redirection=0")
5537 (w3m-additional-command-arguments url)))
5538 (cachep (w3m-cache-available-p url))
5539 temp-file)
5540 (when (and w3m-broken-proxy-cache
5541 (or no-cache (not cachep)))
5542 (setq w3m-command-arguments
5543 (append w3m-command-arguments '("-o" "no_cache=1"))))
5544 (setq temp-file
5545 (when (or (eq w3m-type 'w3mmee) post-data)
5546 (make-temp-name
5547 (expand-file-name "w3mel" w3m-profile-directory))))
5548 (setq w3m-command-arguments
5549 (append w3m-command-arguments
5550 (apply (if (eq w3m-type 'w3mmee)
5551 'w3m-request-arguments
5552 'w3m-header-arguments)
5553 (list (if post-data "post" "get")
5554 url
5555 temp-file
5556 (if (consp post-data)
5557 (cdr post-data)
5558 post-data)
5559 referer
5560 (if (consp post-data) (car post-data))))))
5561 (lexical-let ((url url)
5562 (post-data post-data)
5563 (referer referer)
5564 (no-cache no-cache)
5565 (counter counter)
5566 (temp-file temp-file))
5567 (w3m-process-do
5568 (attr (or (unless no-cache
5569 (and cachep
5570 (w3m-cache-request-contents url)
5571 (w3m-w3m-parse-header
5572 url (w3m-cache-request-header url))))
5573 (w3m-w3m-dump-extra url handler)))
5574 (and temp-file
5575 (file-exists-p temp-file)
5576 (delete-file temp-file))
5577 (if (memq (car attr) '(301 302 303 304 305 306 307))
5578 (if (zerop counter)
5579 ;; Redirect counter exceeds `w3m-follow-redirection'.
5580 'redirection-exceeded
5581 ;; Follow redirection.
5582 (erase-buffer)
5583 (unless (and post-data
5584 (cond
5585 ((memq (car attr) '(301 302))
5586 (if w3m-redirect-with-get
5587 (setq post-data nil)
5588 (not (y-or-n-p
5589 (format "Send POST data to `%s'?" url)))))
5590 ((eq (car attr) 303) ; => See Other
5591 (setq post-data nil))
5592 ((eq (car attr) 307) ; => Temporally Redirect
5593 (not (y-or-n-p
5594 (format "Send POST data to `%s'?" url))))))
5595 (w3m-w3m-retrieve-1 (nth 6 attr)
5596 post-data referer no-cache
5597 (1- counter) handler)))
5598 (if (and (eq (car attr) 406)
5599 (not (equal url (nth 6 attr))))
5600 ;; Attempt to retrieve an alternative url.
5601 (progn
5602 (erase-buffer)
5603 (w3m-w3m-retrieve-1 (nth 6 attr) post-data referer no-cache
5604 counter handler))
5605 attr))))))
5606
5607 (defun w3m-about-retrieve (url &optional no-uncompress no-cache
5608 post-data referer handler)
5609 "Retrieve the about: page which is pointed to by URL.
5610 It will put the retrieved contents into the current buffer. See
5611 `w3m-retrieve' for how does it work asynchronously with the arguments."
5612 (cond
5613 ((string= "about://emacs-w3m.gif" url)
5614 (let ((icon (base64-decode-string w3m-emacs-w3m-icon)))
5615 (if (featurep 'xemacs)
5616 (insert icon)
5617 (set-buffer-multibyte (multibyte-string-p icon))
5618 (insert icon)
5619 (set-buffer-multibyte nil)))
5620 "image/gif")
5621 ((string-match "\\`about://source/" url)
5622 (lexical-let ((url (substring url (match-end 0))))
5623 (w3m-process-do
5624 (type (w3m-retrieve url
5625 no-uncompress no-cache post-data referer handler))
5626 (cond
5627 (type "text/plain")
5628 ((w3m-cache-request-contents url)
5629 (w3m-decode-encoded-contents (w3m-content-encoding url))
5630 "text/plain")
5631 (t nil)))))
5632 ((string-match "\\`about:/*blank/?\\'" url)
5633 "text/plain")
5634 (t
5635 (lexical-let ((output-buffer (current-buffer)))
5636 (w3m-process-do-with-temp-buffer
5637 (type (let (func)
5638 (setq w3m-current-url url)
5639 (set-buffer-multibyte t)
5640 (if (and (string-match "\\`about://\\([^/]+\\)/" url)
5641 (setq func
5642 (intern-soft (concat "w3m-about-"
5643 (match-string 1 url))))
5644 (fboundp func))
5645 (funcall func url no-uncompress no-cache
5646 post-data referer handler)
5647 (w3m-about url no-uncompress no-cache))))
5648 (when type
5649 (when (string-match "\\`text/" type)
5650 (encode-coding-region (point-min) (point-max) w3m-coding-system))
5651 (set-buffer-multibyte nil)
5652 (when (buffer-name output-buffer)
5653 (let ((temp-buffer (current-buffer)))
5654 (with-current-buffer output-buffer
5655 (insert-buffer-substring temp-buffer))))
5656 type))))))
5657
5658 (defun w3m-cid-retrieve (url &optional no-uncompress no-cache)
5659 "Retrieve contents pointed to by URL prefixed with the cid: scheme.
5660 This function is mainly used when displaying text/html MIME parts in
5661 message user agents, e.g., Gnus, Mew, T-gnus, Wanderlust, and possibly
5662 VM.
5663
5664 It calls a function according to the `major-mode' of the buffer
5665 specified by `w3m-current-buffer'. Functions to be called are
5666 specified by the `w3m-cid-retrieve-function-alist' variable.
5667
5668 Each function in that variable should take three arguments passed
5669 through this function, extract and insert contents specified by URL
5670 \(which can be found in the raw message itself) into the current buffer,
5671 and return the content type of the data.
5672
5673 The optional two arguments can be omitted by functions; NO-UNCOMPRESS
5674 specifies whether functions should not uncompress extracted contents;
5675 NO-CACHE specifies whether functions should not use cached contents."
5676 (let ((func (cdr (assq (with-current-buffer w3m-current-buffer major-mode)
5677 w3m-cid-retrieve-function-alist))))
5678 (when func (funcall func url no-uncompress no-cache))))
5679
5680 (defun w3m-data-retrieve (url &optional no-uncompress no-cache)
5681 "Retrieve contents pointed to by URL prefixed with the data: scheme.
5682 See RFC2397."
5683 (let ((case-fold-search t) (mime-type "text/plain")
5684 (coding nil) (encode nil) (param "")
5685 data-string)
5686 (when (string-match
5687 "data:\\(\\([^/;,]+\\(/[^;,]+\\)?\\)\\(;[^;,]+\\)*\\)?,\\(.*\\)"
5688 url)
5689 (setq mime-type (or (match-string-no-properties 2 url)
5690 mime-type)
5691 param (or (match-string-no-properties 4 url)
5692 param)
5693 data-string (match-string-no-properties 5 url))
5694 (when (string-match "^.*\\(;[ \t]*base64\\)$" param)
5695 (setq param (substring param 0 (match-beginning 1)))
5696 (setq encode 'base64))
5697 (when (string-match "charset=\\([^;]+\\)" param)
5698 (setq coding (w3m-charset-to-coding-system
5699 (match-string-no-properties 1 param))))
5700 (when data-string
5701 (erase-buffer)
5702 (let (decode-string)
5703 (setq decode-string
5704 (cond
5705 ((eq encode 'base64)
5706 (base64-decode-string data-string))
5707 (t
5708 (w3m-url-decode-string
5709 data-string coding))))
5710 (set-buffer-multibyte nil)
5711 (if (featurep 'xemacs)
5712 (insert decode-string)
5713 (set-buffer-multibyte (multibyte-string-p decode-string))
5714 (insert decode-string)
5715 (set-buffer-multibyte nil)))))
5716 mime-type))
5717
5718 ;;;###autoload
5719 (defun w3m-retrieve (url &optional no-uncompress no-cache
5720 post-data referer handler)
5721 "Retrieve web contents pointed to by URL.
5722 It will put the retrieved contents into the current buffer.
5723
5724 If HANDLER is nil, this function will retrieve web contents, return
5725 the content type of the retrieved data, and then come to an end. This
5726 behavior is what is called a synchronous operation. You have to
5727 specify HANDLER in order to make this function show its real ability,
5728 which is called an asynchronous operation.
5729
5730 If HANDLER is a function, this function will come to an end in no time.
5731 In this case, contents will be retrieved by the asynchronous process
5732 after a while. And after finishing retrieving contents successfully,
5733 HANDLER will be called on the buffer where this function starts. The
5734 content type of the retrieved data will be passed to HANDLER as a
5735 string argument.
5736
5737 NO-UNCOMPRESS specifies whether this function should not uncompress contents.
5738 NO-CACHE specifies whether this function should not use cached contents.
5739 POST-DATA and REFERER will be sent to the web server with a request."
5740 (if (not handler)
5741 (condition-case nil
5742 (w3m-process-with-wait-handler
5743 (w3m-retrieve url
5744 no-uncompress no-cache post-data referer handler))
5745 (w3m-process-timeout nil))
5746 (unless (and w3m-safe-url-regexp
5747 (not (string-match w3m-safe-url-regexp url)))
5748 (setq url (w3m-url-strip-fragment url))
5749 (set-buffer-multibyte nil)
5750 (cond
5751 ((string-match "\\`about:" url)
5752 (w3m-about-retrieve url
5753 no-uncompress no-cache post-data referer handler))
5754 ((string-match "\\`cid:" url)
5755 (w3m-cid-retrieve url no-uncompress no-cache))
5756 ((string-match "\\`data:" url)
5757 (w3m-data-retrieve url no-uncompress no-cache))
5758 ((w3m-url-local-p url)
5759 (w3m-local-retrieve url no-uncompress))
5760 (t
5761 (w3m-w3m-retrieve url
5762 no-uncompress no-cache post-data referer handler))))))
5763
5764 (defvar w3m-touch-file-available-p 'undecided)
5765
5766 (eval-and-compile
5767 (if (fboundp 'set-file-times)
5768 (defalias 'w3m-touch-file 'set-file-times)
5769 (defun w3m-touch-file (file time)
5770 "Change the access and/or modification TIME of the specified FILE."
5771 ;; Check the validity of `touch' command.
5772 (when (eq w3m-touch-file-available-p 'undecided)
5773 (let ((file (make-temp-name
5774 (expand-file-name "w3mel" w3m-profile-directory)))
5775 time timefile)
5776 (while (progn
5777 (setq time (list (abs (% (random) 8192))
5778 (abs (% (random) 65536)))
5779 timefile (expand-file-name
5780 (format-time-string "%Y%m%d%H%M.%S" time)
5781 w3m-profile-directory))
5782 (file-exists-p timefile)))
5783 (unwind-protect
5784 (setq w3m-touch-file-available-p
5785 (when (w3m-which-command w3m-touch-command)
5786 (with-temp-buffer
5787 (insert "touch check")
5788 (write-region (point-min) (point-max) file nil 'nomsg))
5789 (and (let ((default-directory w3m-profile-directory)
5790 (w3m-touch-file-available-p t))
5791 (w3m-touch-file file time))
5792 (zerop (w3m-time-lapse-seconds
5793 time (nth 5 (file-attributes file)))))))
5794 (when (file-exists-p file)
5795 (ignore-errors (delete-file file)))
5796 (when (file-exists-p timefile)
5797 (ignore-errors (delete-file timefile))))))
5798 (and w3m-touch-file-available-p
5799 time
5800 (w3m-which-command w3m-touch-command)
5801 (file-exists-p file)
5802 (zerop (let ((default-directory (file-name-directory file))
5803 (coding-system-for-write
5804 (or
5805 (and (boundp 'file-name-coding-system)
5806 (symbol-value 'file-name-coding-system))
5807 (and (boundp 'default-file-name-coding-system)
5808 (symbol-value 'default-file-name-coding-system))
5809 ;; Some versions of X*macsen seem touched.
5810 (and (boundp 'coding-system-for-write)
5811 (symbol-value 'coding-system-for-write)))))
5812 (call-process w3m-touch-command nil nil nil
5813 "-t"
5814 (format-time-string "%Y%m%d%H%M.%S" time)
5815 file)))))))
5816
5817 ;;;###autoload
5818 (defun w3m-download (url &optional filename no-cache handler post-data)
5819 "Download contents of URL to a file named FILENAME.
5820 NO-CHACHE (which the prefix argument gives when called interactively)
5821 specifies not using the cached data."
5822 (interactive
5823 (let* ((url (w3m-input-url "Download URL: "))
5824 (basename (file-name-nondirectory (w3m-url-strip-query url))))
5825 (if (string-match "^[\t ]*$" basename)
5826 (list url
5827 (w3m-read-file-name (format "Download %s to: " url)
5828 w3m-default-save-directory "index.html")
5829 current-prefix-arg)
5830 (list url
5831 (w3m-read-file-name (format "Download %s to: " basename)
5832 w3m-default-save-directory basename)
5833 current-prefix-arg))))
5834 (if (and w3m-use-ange-ftp (string-match "\\`ftp://" url))
5835 (w3m-goto-ftp-url url filename)
5836 (lexical-let ((url url)
5837 (filename (or filename (w3m-read-file-name nil nil url))))
5838 (w3m-process-do-with-temp-buffer
5839 (type (progn
5840 (w3m-clear-local-variables)
5841 (setq w3m-current-url url)
5842 (w3m-retrieve url t no-cache post-data nil handler)))
5843 (if type
5844 (let ((buffer-file-coding-system 'binary)
5845 (coding-system-for-write 'binary)
5846 jka-compr-compression-info-list
5847 format-alist)
5848 (when (or (not (file-exists-p filename))
5849 (prog1 (y-or-n-p
5850 (format "File(%s) already exists. Overwrite? "
5851 filename))
5852 (message nil)))
5853 (write-region (point-min) (point-max) filename)
5854 (w3m-touch-file filename (w3m-last-modified url))
5855 t))
5856 (ding)
5857 (message "Cannot retrieve URL: %s%s"
5858 url
5859 (if w3m-process-exit-status
5860 (format " (exit status: %s)" w3m-process-exit-status)
5861 ""))
5862 nil)))))
5863
5864 ;;; Retrieve data:
5865 (w3m-make-ccl-coding-system
5866 'w3m-euc-japan ?E
5867 "ISO 2022 based EUC encoding for Japanese with w3m internal characters.
5868 (generated by `w3m')"
5869 'w3m-euc-japan-decoder
5870 'w3m-euc-japan-encoder)
5871
5872 (w3m-make-ccl-coding-system
5873 'w3m-iso-latin-1 ?1
5874 "ISO 2022 based 8-bit encoding for Latin-1 with w3m internal characters.
5875 (generated by `w3m')"
5876 'w3m-iso-latin-1-decoder
5877 'w3m-iso-latin-1-encoder)
5878
5879 (defun w3m-remove-comments ()
5880 "Remove HTML comments in the current buffer."
5881 (goto-char (point-min))
5882 (let (beg)
5883 (while (search-forward "<!--" nil t)
5884 (setq beg (match-beginning 0))
5885 (if (search-forward "-->" nil t)
5886 (delete-region beg (point))))))
5887
5888 (defun w3m-remove-invisible-image-alt ()
5889 "Remove alt=\"whitespace\" attributes in img tags.
5890 Such attributes not only obscure them but also might make images not
5891 be displayed especially in shimbun articles."
5892 (goto-char (point-min))
5893 (let ((case-fold-search t)
5894 start end)
5895 (while (and (re-search-forward "\\(<img\\)[\t\n\f\r ]+" nil t)
5896 (progn
5897 (setq start (match-end 1))
5898 (search-forward ">" nil t))
5899 (progn
5900 (setq end (match-beginning 0))
5901 (goto-char start)
5902 (re-search-forward "[\t\n\f\r ]+alt=\"[\t\n\f\r ]*\""
5903 end t)))
5904 (delete-region (match-beginning 0) (match-end 0)))))
5905
5906 (defun w3m-check-header-tags ()
5907 "Process header tags (<LINK>,<BASE>) in the current buffer."
5908 (let ((case-fold-search t)
5909 tag)
5910 (goto-char (point-min))
5911 (when (re-search-forward "</head\\(?:[ \t\r\f\n][^>]*\\)?>" nil t)
5912 (save-restriction
5913 (narrow-to-region (point-min) (point))
5914 (goto-char (point-min))
5915 (while (re-search-forward "<\\(link\\|base\\)[ \t\r\f\n]+" nil t)
5916 (setq tag (downcase (match-string 1)))
5917 (cond
5918 ((string= tag "link")
5919 (w3m-parse-attributes ((rel :case-ignore) href type)
5920 (when rel
5921 (setq rel (split-string rel))
5922 (cond
5923 ((member "icon" rel) (setq w3m-icon-data (cons href type)))
5924 ((member "next" rel) (setq w3m-next-url href))
5925 ((or (member "prev" rel) (member "previous" rel))
5926 (setq w3m-previous-url href))
5927 ((member "start" rel) (setq w3m-start-url href))
5928 ((member "contents" rel) (setq w3m-contents-url href))))))
5929 ((string= tag "base")
5930 (w3m-parse-attributes (href)
5931 (when (< 0 (length href))
5932 (setq w3m-current-base-url href))))))))))
5933
5934 (defun w3m-check-refresh-attribute ()
5935 "Get REFRESH attribute in META tags."
5936 (setq w3m-current-refresh nil)
5937 (when w3m-use-refresh
5938 (let ((case-fold-search t)
5939 (refurl w3m-current-url)
5940 sec)
5941 (goto-char (point-min))
5942 (catch 'found
5943 (while (re-search-forward "<meta[ \t\r\f\n]+" nil t)
5944 (w3m-parse-attributes ((http-equiv :case-ignore) content)
5945 (when (string= http-equiv "refresh")
5946 (cond
5947 ((string-match "\\`[0-9]+\\'" content)
5948 (setq sec (match-string-no-properties 0 content)))
5949 ((string-match
5950 "\\([^;]+\\);[ \t\n]*url=[\"']?\\([^\"']+\\)"
5951 content)
5952 (setq sec (match-string-no-properties 1 content))
5953 (setq refurl (w3m-decode-entities-string
5954 (match-string-no-properties 2 content)))
5955 (when (string-match "\\`[\"']\\(.*\\)[\"']\\'" refurl)
5956 (setq refurl (match-string 1 refurl)))))
5957 (when (and sec (string-match "\\`[0-9]+\\'" sec))
5958 (when (and (eq w3m-use-refresh 'wait-minimum)
5959 (< (string-to-number sec) w3m-refresh-minimum-interval))
5960 (setq sec (number-to-string w3m-refresh-minimum-interval)))
5961 (throw 'found
5962 (setq w3m-current-refresh
5963 (cons (string-to-number sec)
5964 (w3m-expand-url refurl))))))))))))
5965
5966 (defun w3m-remove-meta-charset-tags ()
5967 (let ((case-fold-search t))
5968 (goto-char (point-min))
5969 (catch 'found
5970 (when (re-search-forward "<meta[ \t\r\f\n]+" nil t)
5971 (let ((start (match-beginning 0)))
5972 (w3m-parse-attributes ((http-equiv :case-ignore)
5973 (content :case-ignore))
5974 (when (and (string= http-equiv "content-type")
5975 content
5976 (string-match ";[ \t\n]*charset=" content))
5977 (delete-region start (point))
5978 (throw 'found nil))))))))
5979
5980 (defun w3m-rendering-extract-title ()
5981 "Extract the title from the halfdump and put it into the current buffer."
5982 (goto-char (point-min))
5983 (or (when (re-search-forward "<title_alt[ \t\n]+title=\"\\([^\"]+\\)\">"
5984 nil t)
5985 (prog1 (w3m-decode-entities-string
5986 (mapconcat 'identity
5987 (save-match-data (split-string (match-string 1)))
5988 " "))
5989 (delete-region (match-beginning 0) (match-end 0))))
5990 (when (and (stringp w3m-current-url)
5991 (string-match "/\\([^/]+\\)/?\\'" w3m-current-url))
5992 (match-string 1 w3m-current-url))
5993 "<no-title>"))
5994
5995 (defun w3m-set-display-ins-del ()
5996 (when (eq w3m-display-ins-del 'auto)
5997 (with-temp-buffer
5998 (let* ((coding-system-for-read w3m-output-coding-system)
5999 (coding-system-for-write (if (eq 'binary w3m-input-coding-system)
6000 w3m-current-coding-system
6001 w3m-input-coding-system))
6002 (default-process-coding-system
6003 (cons coding-system-for-read coding-system-for-write))
6004 (env (copy-sequence w3m-command-environment))
6005 type)
6006 (setq w3m-display-ins-del nil)
6007 (w3m-process-with-environment (cons '("LANG" . "C")
6008 (delq (assoc "LANG" env) env))
6009 (call-process (or w3m-halfdump-command w3m-command) nil t nil "-o")
6010 (goto-char (point-min))
6011 (when (re-search-forward "display_ins_del=<\\([^>]+\\)>" nil t)
6012 (setq type (match-string 1))
6013 (cond
6014 ((string= type "number")
6015 (setq w3m-display-ins-del 'fontify))
6016 ((string= type "bool")
6017 (setq w3m-display-ins-del 'tag)))))))))
6018
6019 (defun w3m-rendering-half-dump (charset)
6020 ;; `charset' is used by `w3m-w3m-expand-arguments' to generate
6021 ;; arguments for w3mmee and w3m-m17n from `w3m-halfdump-command-arguments'.
6022 (w3m-set-display-ins-del)
6023 (let* ((coding-system-for-read w3m-output-coding-system)
6024 (coding-system-for-write (if (eq 'binary w3m-input-coding-system)
6025 w3m-current-coding-system
6026 w3m-input-coding-system))
6027 (default-process-coding-system
6028 (cons coding-system-for-read coding-system-for-write)))
6029 (w3m-process-with-environment w3m-command-environment
6030 (apply 'call-process-region
6031 (point-min)
6032 (point-max)
6033 (or w3m-halfdump-command w3m-command)
6034 t t nil
6035 (w3m-w3m-expand-arguments
6036 (append w3m-halfdump-command-arguments
6037 w3m-halfdump-command-common-arguments
6038 ;; Image size conscious rendering
6039 (when (member "image" w3m-compile-options)
6040 (if (and w3m-treat-image-size
6041 (or (w3m-display-graphic-p)
6042 (and w3m-pixels-per-line
6043 w3m-pixels-per-character)))
6044 (list "-o" "display_image=on"
6045 "-ppl" (number-to-string
6046 (or w3m-pixels-per-line
6047 (w3m-static-if
6048 (featurep 'xemacs)
6049 (font-height
6050 (face-font 'default))
6051 (frame-char-height))))
6052 "-ppc" (number-to-string
6053 (or w3m-pixels-per-character
6054 (w3m-static-if
6055 (featurep 'xemacs)
6056 (font-width
6057 (face-font 'default))
6058 (frame-char-width)))))
6059 (list "-o" "display_image=off")))))))))
6060
6061 (defun w3m-rendering-buffer (&optional charset)
6062 "Do rendering of contents in the currenr buffer as HTML and return title."
6063 (w3m-message "Rendering...")
6064 (w3m-remove-comments)
6065 (w3m-remove-invisible-image-alt)
6066 (w3m-check-header-tags)
6067 (w3m-check-refresh-attribute)
6068 (unless (eq w3m-type 'w3m-m17n)
6069 (w3m-remove-meta-charset-tags))
6070 (w3m-rendering-half-dump charset)
6071 (w3m-message "Rendering...done")
6072 (w3m-rendering-extract-title))
6073
6074 (defcustom w3m-confirm-leaving-secure-page t
6075 "If non-nil, you'll be asked for confirmation when leaving secure pages.
6076 This option controls whether the confirmation is made also when
6077 retrieving data (typically images) in a secure page from non-secure
6078 pages. It is STRONGLY recommended to set non-nil value to this option.
6079 You MUST understand what you want to do completely before
6080 switching off this option."
6081 :group 'w3m
6082 :type 'boolean)
6083
6084 (defun w3m-retrieve-and-render (url &optional no-cache charset
6085 post-data referer handler)
6086 "Retrieve contents of URL and render them in the current buffer.
6087 It returns a `w3m-process' object and comes to an end immediately.
6088 The HANDLER function will be called when rendering is complete. When
6089 a new content is retrieved in the buffer, the HANDLER function will be
6090 called with t as an argument. Otherwise, it will be called with nil."
6091 (unless (and w3m-current-ssl
6092 w3m-confirm-leaving-secure-page
6093 ;; Permit leaving safe pages without confirmation for
6094 ;; several safe commands. For more detail of
6095 ;; definition of safe commands, see the thread
6096 ;; beginning at [emacs-w3m:09767].
6097 (not
6098 (or (memq this-command
6099 '(w3m
6100 w3m-goto-url w3m-redisplay-this-page
6101 w3m-reload-this-page w3m-history
6102 w3m-view-next-page w3m-view-previous-page
6103 w3m-view-header w3m-view-source))
6104 (string-match "\\`\\(?:ht\\|f\\)tps://" url)
6105 (prog1
6106 (y-or-n-p "You are leaving secure page. Continue? ")
6107 (message nil)))))
6108 (lexical-let ((url (w3m-url-strip-fragment url))
6109 (charset charset)
6110 (page-buffer (current-buffer))
6111 (arrival-time (current-time))
6112 (silent w3m-message-silent))
6113 (w3m-process-do-with-temp-buffer
6114 (type (progn
6115 (w3m-clear-local-variables)
6116 (w3m-retrieve url nil no-cache post-data referer handler)))
6117 (let ((w3m-message-silent silent))
6118 (when (buffer-live-p page-buffer)
6119 (setq url (w3m-url-strip-authinfo url))
6120 (if type
6121 (if (string= type "X-w3m-error/redirection")
6122 (when (w3m-show-redirection-error-information url page-buffer)
6123 (w3m-message (w3m-message "Cannot retrieve URL: %s"
6124 url)))
6125 (let ((modified-time (w3m-last-modified url)))
6126 (w3m-arrived-add url nil modified-time arrival-time)
6127 (unless modified-time
6128 (setf (w3m-arrived-last-modified url) nil))
6129 (let ((real (w3m-real-url url)))
6130 (unless (string= url real)
6131 (w3m-arrived-add url nil nil arrival-time)
6132 (setf (w3m-arrived-title real)
6133 (w3m-arrived-title url))
6134 (setf (w3m-arrived-last-modified real)
6135 (w3m-arrived-last-modified url))
6136 (setq url real)))
6137 (prog1 (w3m-create-page url
6138 (or (w3m-arrived-content-type url)
6139 type)
6140 (or charset
6141 (w3m-arrived-content-charset url)
6142 (w3m-content-charset url))
6143 page-buffer)
6144 (w3m-force-window-update-later page-buffer)
6145 (unless (get-buffer-window page-buffer)
6146 (w3m-message "The content (%s) has been retrieved in %s"
6147 url (buffer-name page-buffer))))))
6148 (ding)
6149 (when (eq (car w3m-current-forms) t)
6150 (setq w3m-current-forms (cdr w3m-current-forms)))
6151 (prog1 (when (and w3m-show-error-information
6152 (not (or (w3m-url-local-p url)
6153 (string-match "\\`about:" url))))
6154 (w3m-show-error-information url charset page-buffer))
6155 (w3m-message "Cannot retrieve URL: %s%s"
6156 url
6157 (if w3m-process-exit-status
6158 (format " (exit status: %s)"
6159 w3m-process-exit-status)
6160 ""))))))))))
6161
6162 (defun w3m-show-error-information (url charset page-buffer)
6163 "Create and prepare the error information."
6164 (or (when (w3m-cache-request-contents url)
6165 (w3m-decode-encoded-contents (w3m-content-encoding url))
6166 t) ; Even if decoding is failed, use the cached contents.
6167 (let ((case-fold-search t)
6168 (header (w3m-cache-request-header url))
6169 (errmsg (format "\n<br><h1>Cannot retrieve URL: %s%s</h1>"
6170 (format "<a href=\"%s\">%s</a>" url url)
6171 (when w3m-process-exit-status
6172 (format " (exit status: %s)"
6173 w3m-process-exit-status)))))
6174 (if (or (null header)
6175 (string-match "\\`w3m: Can't load " header))
6176 (progn
6177 (erase-buffer)
6178 (setq charset "us-ascii")
6179 (insert
6180 errmsg
6181 (format "<br><br><b>%s</b> could not be found; "
6182 (w3m-get-server-hostname url))
6183 (if (string-match "\\`news:" url)
6184 "check the name of the <b>URL</b>\
6185 and the value of the <b>NNTPSERVER</b> environment variable\
6186 (that should be the address of the <b>NNTP</b> server)."
6187 "check the name of the <b>URL</b>.")))
6188 (goto-char (point-min))
6189 (when (or (re-search-forward "<body>" nil t)
6190 (re-search-forward "<html>" nil t))
6191 (goto-char (match-end 0)))
6192 (insert errmsg "<br><br><hr><br><br>")
6193 (when (or (re-search-forward "</body>" nil t)
6194 (re-search-forward "</html>" nil 'max))
6195 (goto-char (match-end 0)))
6196 (insert "\n<br><br><hr><br><br><h2>Header information</h2><br>\n<pre>"
6197 header "</pre>\n"))))
6198 (w3m-create-page url "text/html" charset page-buffer)
6199 nil)
6200
6201 (defun w3m-show-redirection-error-information (url page-buffer)
6202 (erase-buffer)
6203 (insert
6204 (format "\n<br><h1>Cannot retrieve URL: %s</h1><br><br>%s"
6205 (format "<a href=\"%s\">%s</a>" url url)
6206 "The number of redirections has exceeded a limit. This may have<br>\n
6207 happened due to the server side miss-configuration. Otherwise,<br>\n
6208 try increasing the limit, the value of <b>`w3m-follow-redirection'</b>.<br>\n"))
6209 (w3m-create-page url "text/html" "us-ascii" page-buffer))
6210
6211 (defun w3m-prepare-content (url type charset)
6212 "Prepare contents in the current buffer according to TYPE.
6213 URL is assumed to be a place where the contents come from. CHARSET is
6214 passed to the filter function corresponding to TYPE if it is
6215 specified in the `w3m-content-type-alist' variable."
6216 (let ((filter (nth 3 (assoc type w3m-content-type-alist))))
6217 (cond
6218 ; Filter function is specified.
6219 ((functionp filter) (funcall filter url type charset))
6220 ; Equivalent type is specified.
6221 ((stringp filter) filter)
6222 ; No filter is specified.
6223 ((not filter) type)
6224 ; Failed.
6225 (t ""))))
6226
6227 (defun w3m-detect-xml-type (url type charset)
6228 "Check if the type of xml contents of URL is xhtml+xml.
6229 If so return \"text/html\", otherwise \"text/plain\"."
6230 (with-temp-buffer
6231 (w3m-retrieve url)
6232 (w3m-decode-buffer url charset type)
6233 (goto-char (point-min))
6234 (setq case-fold-search t)
6235 (if (re-search-forward
6236 "<[\t\n ]*html\\(?:\\(?:[\t\n ]+[^>]+\\)?>\\|[\t\n ]*>\\)"
6237 nil t)
6238 "text/html"
6239 "text/plain")))
6240
6241 (defun w3m-create-text-page (url type charset page-buffer)
6242 (w3m-safe-decode-buffer url charset type)
6243 (setq w3m-current-url (if (w3m-arrived-p url)
6244 (w3m-real-url url)
6245 url)
6246 w3m-current-title
6247 (if (string= "text/html" type)
6248 (let ((title (w3m-rendering-buffer charset)))
6249 (setf (w3m-arrived-title url) title)
6250 title)
6251 (or (when (string-match "\\`about://\\(?:source\\|header\\)/" url)
6252 (w3m-arrived-title (substring url (match-end 0))))
6253 (file-name-nondirectory (if (string-match "/\\'" url)
6254 (directory-file-name url)
6255 url)))))
6256 (let ((result-buffer (current-buffer)))
6257 (with-current-buffer page-buffer
6258 (let ((inhibit-read-only t))
6259 (widen)
6260 (delete-region (point-min) (point-max))
6261 (insert-buffer-substring result-buffer)
6262 (goto-char (point-min))
6263 (w3m-copy-local-variables result-buffer)
6264 (set-buffer-file-coding-system w3m-current-coding-system)
6265 (when (string= "text/html" type) (w3m-fontify))
6266 'text-page))))
6267
6268 (defsubst w3m-image-page-displayed-p ()
6269 (and (fboundp 'image-mode-setup-winprops)
6270 w3m-current-url
6271 (string-match "\\`image/" (w3m-content-type w3m-current-url))
6272 (eq (get-text-property (point-min) 'w3m-image-status) 'on)))
6273
6274 (defun w3m-create-image-page (url type charset page-buffer)
6275 (when (w3m-image-type-available-p (w3m-image-type type))
6276 (with-current-buffer page-buffer
6277 (let ((inhibit-read-only t))
6278 (w3m-clear-local-variables)
6279 (setq w3m-current-url (w3m-real-url url)
6280 w3m-current-title (file-name-nondirectory url))
6281 (widen)
6282 (delete-region (point-min) (point-max))
6283 (insert w3m-current-title)
6284 (w3m-add-face-property (point-min) (point-max) 'w3m-image)
6285 (w3m-add-text-properties (point-min) (point-max)
6286 (list 'w3m-image url
6287 'mouse-face 'highlight))
6288 (when (fboundp 'image-mode-setup-winprops)
6289 (image-mode-setup-winprops))
6290 'image-page))))
6291
6292 (defun w3m-create-page (url type charset page-buffer)
6293 ;; Select a content type.
6294 (unless (and (stringp type)
6295 (assoc type w3m-content-type-alist))
6296 (save-window-excursion
6297 (pop-to-buffer (current-buffer))
6298 (delete-other-windows)
6299 (ding)
6300 (setq type
6301 (completing-read
6302 (format "Input %s's content type (default Download): "
6303 (file-name-nondirectory url))
6304 w3m-content-type-alist nil t))
6305 (setf (w3m-arrived-content-type url) type)))
6306 (setq w3m-current-coding-system nil) ; Reset decoding status of this buffer.
6307 (setq type (w3m-prepare-content url type charset))
6308 (w3m-safe-decode-buffer url charset type)
6309 (setq charset (or charset w3m-current-content-charset))
6310 (when w3m-use-filter (w3m-filter url))
6311 (w3m-relationship-estimate url)
6312 ;; Create pages.
6313 (cond
6314 ((string-match "\\`text/" type)
6315 (w3m-create-text-page url type charset page-buffer))
6316 ((string-match "\\`image/" type)
6317 (w3m-create-image-page url type charset page-buffer))
6318 ((member type w3m-doc-view-content-types)
6319 (w3m-doc-view url))
6320 (t
6321 (with-current-buffer page-buffer
6322 (w3m-external-view url)
6323 'external-view))))
6324
6325 (defun w3m-relationship-estimate (url)
6326 "Estimate relationships between a page and others."
6327 (save-excursion
6328 (save-match-data
6329 (catch 'estimated
6330 (dolist (rule w3m-relationship-estimate-rules)
6331 (when (apply (car rule) url (cdr rule))
6332 (throw 'estimated t)))))))
6333
6334 (defun w3m-relationship-simple-estimate (url regexp &optional next previous
6335 start contents)
6336 "Search relationships with given patterns
6337 when the URL of the retrieved page matches the REGEXP."
6338 (when (string-match regexp url)
6339 (w3m-relationship-search-patterns url next previous start contents)))
6340
6341 (defun w3m-relationship-magicpoint-estimate (url)
6342 "Search relationships for pages generated by MagicPoint."
6343 (goto-char (point-max))
6344 (when (search-backward
6345 "Generated by <A HREF=\"http://www.mew.org/mgp/\">MagicPoint</A>"
6346 nil t)
6347 (goto-char (point-min))
6348 (w3m-relationship-search-patterns
6349 url
6350 (eval-when-compile
6351 (concat "<A HREF=" w3m-html-string-regexp ">\\[next&gt;\\]</A>"))
6352 (eval-when-compile
6353 (concat "<A HREF=" w3m-html-string-regexp ">\\[&lt;prev\\]</A>"))
6354 (eval-when-compile
6355 (concat "<A HREF=" w3m-html-string-regexp ">\\[&lt;&lt;start\\]</A>"))
6356 (eval-when-compile
6357 (concat "<A HREF=" w3m-html-string-regexp ">\\[index\\]</A>")))))
6358
6359 (defun w3m-relationship-oddmuse-estimate (url)
6360 (when (string-match "/wiki\\?search=.*" url)
6361 (goto-char (point-min))
6362 (and (re-search-forward "href=\"\\([^\"]+\\)\">Previous</a>" nil t)
6363 (setq w3m-previous-url (match-string 1)))
6364 (and (re-search-forward "href=\"\\([^\"]+\\)\">Next</a>" nil t)
6365 (setq w3m-next-url (match-string 1)))))
6366
6367 (defun w3m-relationship-slashdot-estimate (url)
6368 (goto-char (point-min))
6369 (when (and (string-match
6370 "slashdot\\.org/\\(article\\|comments\\)\\.pl\\?"
6371 url)
6372 (search-forward "<div class=\"linkCommentPage\">" nil t))
6373 (let ((min (point)) (max (save-excursion (search-forward "</div>" nil t))))
6374 ;; move to the position of the current page indicator and then search
6375 ;; for the next and previous link within the current <div>
6376 (when (and max (re-search-forward "<b>\\(([0-9]+)\\)</b>" max t))
6377 (let ((re (concat "<a href=" w3m-html-string-regexp ">")))
6378 (when (save-excursion (re-search-backward re min t))
6379 (setq w3m-previous-url
6380 (w3m-expand-url (w3m-decode-anchor-string
6381 (or (match-string 2)
6382 (match-string 3)
6383 (match-string 1))))))
6384 (when (re-search-forward re max t)
6385 (setq w3m-next-url
6386 (w3m-expand-url (w3m-decode-anchor-string
6387 (or (match-string 2)
6388 (match-string 3)
6389 (match-string 1)))))))))))
6390
6391 (defun w3m-relationship-alc-estimate (url)
6392 ;; use filter
6393 (when (string-match "\\`http://eow\\.alc\\.co\\.jp/[^/]+/UTF-8/" url)
6394 (when (re-search-forward
6395 (concat "<a href=\\\"http://eow\\.alc\\.co\\.jp/[^/]+/UTF-8/"
6396 "\\(\\?pg=[0-9]+\\)\\\">\e$BA0$X\e(B</a>")
6397 nil t)
6398 (setq w3m-previous-url
6399 (w3m-expand-url (match-string 1) url)))
6400 (when (re-search-forward
6401 (concat "<a href=\\\"http://eow\\.alc\\.co\\.jp/[^/]+/UTF-8/"
6402 "\\(\\?pg=[0-9]+\\)\\\">\e$B<!$X\e(B</a>")
6403 nil t)
6404 (setq w3m-next-url
6405 (w3m-expand-url (match-string 1) url)))
6406 (unless (or w3m-previous-url w3m-next-url)
6407 ;; no use filter
6408 (goto-char (point-min))
6409 (when (re-search-forward
6410 "<a href='javascript:goPage(\"\\([0-9+]\\)\")'>\e$BA0$X\e(B</a>"
6411 nil t)
6412 (setq w3m-previous-url
6413 (w3m-expand-url (format "?pg=%s" (match-string 1)) url)))
6414 (when (re-search-forward
6415 "<a href='javascript:goPage(\"\\([0-9+]\\)\")'>\e$B<!$X\e(B</a>"
6416 nil t)
6417 (setq w3m-next-url
6418 (w3m-expand-url (format "?pg=%s" (match-string 1)) url))))))
6419
6420 (defun w3m-relationship-search-patterns (url next previous
6421 &optional start contents)
6422 "Search relationships with given patterns."
6423 (goto-char (point-min))
6424 (and next
6425 (re-search-forward next nil t)
6426 (setq w3m-next-url
6427 (w3m-expand-url (w3m-decode-anchor-string (or (match-string 2)
6428 (match-string 3)
6429 (match-string 1)))
6430 url))
6431 (goto-char (point-min)))
6432 (and previous
6433 (re-search-forward previous nil t)
6434 (setq w3m-previous-url
6435 (w3m-expand-url (w3m-decode-anchor-string (or (match-string 2)
6436 (match-string 3)
6437 (match-string 1)))
6438 url))
6439 (goto-char (point-min)))
6440 (and start
6441 (re-search-forward start nil t)
6442 (setq w3m-start-url
6443 (w3m-expand-url (w3m-decode-anchor-string (or (match-string 2)
6444 (match-string 3)
6445 (match-string 1)))
6446 url))
6447 (goto-char (point-min)))
6448 (and contents
6449 (re-search-forward contents nil t)
6450 (setq w3m-contents-url
6451 (w3m-expand-url (w3m-decode-anchor-string (or (match-string 2)
6452 (match-string 3)
6453 (match-string 1)))
6454 url))))
6455
6456 (defun w3m-search-name-anchor (name &optional quiet no-record)
6457 (interactive "sName: ")
6458 (let ((pos (point-min))
6459 (cur-pos (point))
6460 found)
6461 (catch 'found
6462 (while (setq pos (next-single-property-change pos 'w3m-name-anchor))
6463 (when (member name (get-text-property pos 'w3m-name-anchor))
6464 (goto-char pos)
6465 (when (eolp) (forward-line))
6466 (w3m-horizontal-on-screen)
6467 (throw 'found (setq found t))))
6468 (setq pos (point-min))
6469 (while (setq pos (next-single-property-change pos 'w3m-name-anchor2))
6470 (when (member name (get-text-property pos 'w3m-name-anchor2))
6471 (goto-char pos)
6472 (when (eolp) (forward-line))
6473 (w3m-horizontal-on-screen)
6474 (throw 'found (setq found t))))
6475 (unless quiet
6476 (message "No such anchor: %s" name)))
6477
6478 (when (and found
6479 (not no-record)
6480 (/= (point) cur-pos))
6481 (setq w3m-name-anchor-from-hist
6482 (append (list 1 nil (point) cur-pos)
6483 (and (integerp (car w3m-name-anchor-from-hist))
6484 (nthcdr (1+ (car w3m-name-anchor-from-hist))
6485 w3m-name-anchor-from-hist)))))
6486 (when found
6487 (w3m-recenter))
6488 found))
6489
6490 (defun w3m-parent-page-available-p ()
6491 (if (null w3m-current-url)
6492 nil
6493 (save-match-data
6494 (string-match "\\`[a-z]+://?[^/]+/." w3m-current-url))))
6495
6496 (defun w3m-view-parent-page (&optional count)
6497 "Attempt to move to the parent directory of the page currently displayed.
6498 For instance, it will let you visit \"http://foo/bar/\" if you are currently
6499 viewing \"http://foo/bar/baz\".
6500 If COUNT is a integer, you will visit the parent directory to step up the COUNT.
6501 If COUNT is zero, you will visit the top of this site."
6502 (interactive "p")
6503 (unless (integerp count)
6504 (setq count 1))
6505 (setq count (abs count))
6506 (cond
6507 ((and w3m-current-url
6508 (eq count 0)
6509 (string-match "\\`[a-z]+:///?[^/]+/" w3m-current-url))
6510 (w3m-goto-url (match-string 0 w3m-current-url)))
6511 (w3m-start-url (w3m-goto-url w3m-start-url))
6512 (w3m-contents-url (w3m-goto-url w3m-contents-url))
6513 (w3m-current-url
6514 (let ((parent-url w3m-current-url))
6515 (catch 'loop
6516 (while (not (zerop count))
6517 (setq count (1- count))
6518 ;; Check whether http://foo/bar/ or http://foo/bar
6519 (if (string-match "/$" parent-url)
6520 (if (string-match "\\(.*\\)/[^/]+/$" parent-url)
6521 ;; http://foo/bar/ -> http://foo/
6522 (setq parent-url (concat (match-string 1 parent-url) "/")))
6523 (if (string-match "\\(.*\\)/.+$" parent-url)
6524 ;; http://foo/bar -> http://foo/
6525 (setq parent-url (concat (match-string 1 parent-url) "/"))))
6526 ;; Ignore "http:/"
6527 (cond
6528 ((string-match "\\`[a-z]+:///?[^/]+/\\'" parent-url)
6529 (throw 'loop t))
6530 ((and parent-url
6531 (string-match "\\`[a-z]+:/+\\'" parent-url))
6532 (setq parent-url nil)
6533 (throw 'loop nil)))))
6534 (if parent-url
6535 (w3m-goto-url parent-url)
6536 (error "No parent page for: %s" w3m-current-url))))
6537 (t (error "w3m-current-url is not set"))))
6538
6539 (defun w3m-view-previous-page (&optional count)
6540 "Move back COUNT pages in the history.
6541 If COUNT is a positive integer, move backward COUNT times in the
6542 history. If COUNT is a negative integer, moving forward is performed.
6543 COUNT is treated as 1 by default if it is omitted."
6544 (interactive "p")
6545 (unless w3m-current-url
6546 ;; This page may have not been registered in the history since an
6547 ;; accident has probably occurred, so we should skip the page.
6548 (if (integerp count)
6549 (when (> count 0)
6550 (decf count))
6551 (setq count 0)))
6552 (let ((index (car w3m-name-anchor-from-hist))
6553 pos)
6554 (if (and (integerp count)
6555 (integerp index)
6556 (< 0 (setq index (+ index count)))
6557 (setq pos (nth index w3m-name-anchor-from-hist)))
6558 (progn
6559 (when (and (= (point) pos)
6560 (nth (1+ index) w3m-name-anchor-from-hist))
6561 (setq index (1+ index)))
6562 (goto-char (nth index w3m-name-anchor-from-hist))
6563 (setcar w3m-name-anchor-from-hist index)
6564 ;; Restore last position.
6565 (w3m-history-restore-position))
6566 (let ((hist ;; Cons of a new history element and position pointers.
6567 (if (integerp count)
6568 (w3m-history-backward count)
6569 (w3m-history-backward)))
6570 ;; Inhibit sprouting of a new history.
6571 (w3m-history-reuse-history-elements t)
6572 (w3m-use-refresh 'wait-minimum))
6573 (if hist
6574 (let ((w3m-prefer-cache t))
6575 ;; Save last position.
6576 (w3m-history-store-position)
6577 (w3m-goto-url (caar hist) nil nil
6578 (w3m-history-plist-get :post-data)
6579 (w3m-history-plist-get :referer)
6580 nil
6581 (w3m-history-element (caddr hist) t))
6582 ;; Set the position pointers in the history.
6583 (setcar w3m-history (cdr hist))
6584 ;; Restore last position.
6585 (w3m-history-restore-position))
6586 (message "There's no more history"))))))
6587
6588 (defun w3m-view-next-page (&optional count)
6589 "Move forward COUNT pages in history.
6590 If COUNT is a positive integer, move forward COUNT times in the
6591 history. If COUNT is a negative integer, moving backward is performed.
6592 COUNT is treated as 1 by default if it is omitted."
6593 (interactive "p")
6594 (w3m-view-previous-page (if (integerp count) (- count) -1)))
6595
6596 (defun w3m-expand-path-name (file base)
6597 (let ((input (if (eq (elt file 0) ?/)
6598 file
6599 (concat base file)))
6600 (output ""))
6601 (save-match-data
6602 (while (string-match "^\\(?:\\.\\.?/\\)+" input)
6603 (setq input (substring input (match-end 0))))
6604 (while (not (zerop (length input)))
6605 (cond
6606 ((string-match "^/\\.\\(?:/\\|$\\)" input)
6607 (setq input (concat "/" (substring input (match-end 0)))))
6608 ((string-match "^/\\.\\.\\(?:/\\|$\\)" input)
6609 (setq input (concat "/" (substring input (match-end 0))))
6610 (when (string-match "/?[^/]+$" output)
6611 (setq output (substring output 0 (match-beginning 0)))))
6612 ((string-match "^\\.\\.?$" input)
6613 (setq input ""))
6614 (t
6615 (let ((end (and (string-match "^/[^/]*" input)
6616 (match-end 0))))
6617 (setq output
6618 (concat output (substring input 0 end)))
6619 (setq input
6620 (substring input end))))))
6621 output)))
6622
6623 (defconst w3m-url-hierarchical-schemes
6624 '("http" "https" "ftp" "ftps" "file")
6625 "List of schemes which may have hierarchical parts.
6626 This list is refered to by `w3m-expand-url' to keep backward
6627 compatibility which is described in Section 5.2 of RFC 2396.")
6628
6629 (defun w3m-expand-url (url &optional base)
6630 "Convert URL to the absolute address, and canonicalize it."
6631 (save-match-data
6632 (if base
6633 (if (progn
6634 (w3m-string-match-url-components base)
6635 (match-beginning 1))
6636 (and (not (match-beginning 3))
6637 (member (match-string 2 base) w3m-url-hierarchical-schemes)
6638 (setq base (concat
6639 (substring base 0 (match-end 1))
6640 "//"
6641 (substring base (match-beginning 5)))))
6642 (error "BASE must have a scheme part: %s" base))
6643 (setq base (or w3m-current-base-url
6644 w3m-current-url
6645 w3m-url-fallback-base)))
6646 (w3m-string-match-url-components url)
6647 ;; Remove an empty fragment part.
6648 (when (and (match-beginning 8)
6649 (= (match-beginning 9) (length url)))
6650 (setq url (substring url 0 (match-beginning 8)))
6651 (w3m-string-match-url-components url))
6652 ;; Remove an empty query part.
6653 (when (and (match-beginning 6)
6654 (= (match-beginning 7) (or (match-beginning 8)
6655 (length url))))
6656 (setq url (concat (substring url 0 (match-beginning 6))
6657 (if (match-beginning 8)
6658 (substring url (match-beginning 8))
6659 ""))
6660 base (progn (w3m-string-match-url-components base)
6661 (substring base 0 (match-beginning 6))))
6662 (w3m-string-match-url-components url))
6663 (cond
6664 ((match-beginning 1)
6665 ;; URL has a scheme part. => URL may have an absolute spec.
6666 (if (or (match-beginning 3)
6667 (and (< (match-beginning 5) (length url))
6668 (eq ?/ (aref url (match-beginning 5)))))
6669 ;; URL has a net-location part or an absolute hierarchical
6670 ;; part. => URL has an absolute spec.
6671 url
6672 (let ((scheme (match-string 2 url)))
6673 (if (and (member scheme w3m-url-hierarchical-schemes)
6674 (progn
6675 (w3m-string-match-url-components base)
6676 (equal scheme (match-string 2 base))))
6677 (w3m-expand-url (substring url (match-end 1)) base)
6678 url))))
6679 ((match-beginning 3)
6680 ;; URL has a net-location part. => The hierarchical part of URL
6681 ;; has an absolute spec.
6682 (w3m-string-match-url-components base)
6683 (concat (substring base 0 (match-end 1)) url))
6684 ((> (match-end 5) (match-beginning 5))
6685 (let ((path-end (match-end 5))
6686 expanded-path
6687 ;; See the following thread about a problem related to
6688 ;; the use of file-name-* functions for url string:
6689 ;; http://news.gmane.org/group/gmane.emacs.w3m/thread=4210
6690 file-name-handler-alist)
6691 (w3m-string-match-url-components base)
6692 (setq expanded-path
6693 (w3m-expand-path-name
6694 (substring url 0 path-end)
6695 (or (file-name-directory (match-string 5 base))
6696 "/")))
6697 (concat
6698 (substring base 0 (match-beginning 5))
6699 (if (member (match-string 2 base) w3m-url-hierarchical-schemes)
6700 expanded-path
6701 (substring url 0 path-end))
6702 (substring url path-end))))
6703 ((match-beginning 6)
6704 ;; URL has a query part.
6705 (w3m-string-match-url-components base)
6706 (concat (substring base 0 (match-end 5)) url))
6707 (t
6708 ;; URL has only a fragment part.
6709 (w3m-string-match-url-components base)
6710 (concat (substring base 0 (match-beginning 8))
6711 url)))))
6712
6713 (defun w3m-display-progress-message (url)
6714 "Show \"Reading URL...\" message in the middle of a buffer."
6715 (insert (make-string (max 0 (/ (1- (window-height)) 2)) ?\n)
6716 "Reading " (w3m-url-readable-string (w3m-url-strip-authinfo url))
6717 "...")
6718 (beginning-of-line)
6719 (let ((fill-column (window-width)))
6720 (center-region (point) (point-max)))
6721 (goto-char (point-min))
6722 (put-text-property (point) (point-max) 'w3m-progress-message t)
6723 (sit-for 0))
6724
6725 (defun w3m-view-this-url-1 (url reload new-session)
6726 (lexical-let ((cur w3m-current-url)
6727 (url url)
6728 (obuffer (current-buffer))
6729 (wconfig (current-window-configuration))
6730 pos buffer)
6731 (if new-session
6732 (let ((empty
6733 ;; If a new url has the #name portion, we simply copy
6734 ;; the buffer's contents to the new session, otherwise
6735 ;; creating an empty buffer.
6736 (not (and (progn
6737 (w3m-string-match-url-components url)
6738 (match-beginning 8))
6739 (string-equal w3m-current-url
6740 (substring url
6741 0 (match-beginning 8)))))))
6742 (setq pos (point-marker)
6743 buffer (w3m-copy-buffer
6744 nil nil nil empty w3m-new-session-in-background))
6745 (when w3m-new-session-in-background
6746 (set-buffer buffer))
6747 (when empty
6748 (w3m-display-progress-message url)))
6749 (setq buffer (current-buffer)))
6750 (let (handler)
6751 (w3m-process-do
6752 (success (w3m-goto-url url reload nil nil w3m-current-url handler))
6753 (set-window-hscroll (selected-window) 0)
6754 ;; Delete the newly created buffer if it's been made empty.
6755 (when (and pos
6756 (buffer-name buffer))
6757 (w3m-delete-buffer-if-empty buffer))
6758 (when pos ;; the new session is created.
6759 ;; FIXME: what we should actually do is to modify the `w3m-goto-url'
6760 ;; function so that it may return a proper value, and checking it.
6761 (when (and (marker-buffer pos) (buffer-name (marker-buffer pos)))
6762 (with-current-buffer (marker-buffer pos)
6763 (save-excursion
6764 (goto-char pos)
6765 (w3m-refontify-anchor)))))
6766 ;; We need to restore the window configuration to the former
6767 ;; one if `w3m-new-session-in-background' is non-nil unless
6768 ;; the buffer's major mode has changed from the w3m-mode to
6769 ;; another by visiting the new url (possibly a local file,
6770 ;; a mailto url, doc-view-mode, etc.).
6771 (if (and w3m-new-session-in-background
6772 (not (eq obuffer (current-buffer)))
6773 (or (buffer-name buffer)
6774 ;; Clear "...has been retrieved in..." message.
6775 (progn (w3m-message "") nil))
6776 (or (eq major-mode 'w3m-mode)
6777 (not (eq (with-current-buffer buffer major-mode)
6778 'w3m-mode))))
6779 (set-window-configuration wconfig)
6780 (unless (eq cur w3m-current-url)
6781 (w3m-recenter)))))))
6782
6783 (defun w3m-view-this-url (&optional arg new-session)
6784 "Display the page pointed to by the link under point.
6785 If ARG is the number 2 or the list of the number 16 (you may produce
6786 this by typing `C-u' twice) or NEW-SESSION is non-nil and the link is
6787 an anchor, this function makes a copy of the current session in
6788 advance. Otherwise, if ARG is non-nil, it forces to reload the url at
6789 point."
6790 (interactive (if (member current-prefix-arg '(2 (16)))
6791 (list nil t)
6792 (list current-prefix-arg nil)))
6793 ;; Store the current position in the history structure.
6794 (w3m-history-store-position)
6795 (let ((w3m-prefer-cache
6796 (or w3m-prefer-cache
6797 (and (stringp w3m-current-url)
6798 (string-match "\\`about://\\(?:db-\\)?history/"
6799 w3m-current-url))))
6800 act url)
6801 (cond
6802 ((setq act (w3m-action))
6803 (let ((w3m-form-new-session new-session)
6804 (w3m-form-download nil))
6805 (eval act)))
6806 ((setq url (w3m-url-valid (w3m-anchor)))
6807 (w3m-view-this-url-1 url arg new-session))
6808 ((w3m-url-valid (w3m-image))
6809 (if (w3m-display-graphic-p)
6810 (w3m-toggle-inline-image)
6811 (w3m-view-image)))
6812 ((setq url (w3m-active-region-or-url-at-point t))
6813 (unless (eq 'quit (setq url (w3m-input-url nil url 'quit nil
6814 'feeling-lucky)))
6815 (w3m-view-this-url-1 url arg new-session)))
6816 (t (w3m-message "No URL at point")))))
6817
6818 (eval-and-compile
6819 (autoload 'mouse-set-point "mouse"))
6820
6821 (defun w3m-mouse-view-this-url (event &optional arg)
6822 "Follow the link under the mouse pointer."
6823 (interactive "e\nP")
6824 (mouse-set-point event)
6825 (w3m-view-this-url arg))
6826
6827 (defun w3m-open-all-links-in-new-session (start end &optional arg)
6828 "Open all http links between START and END as new sessions.
6829 If the page looks like Google's search result and the START point is
6830 the beginning of a line, only the links displayed in the beginning of
6831 lines are picked up. If ARG is non-nil, it forces to reload all links.
6832 If Transient Mark mode, deactivate the mark."
6833 (interactive "r\nP")
6834 (when (w3m-region-active-p)
6835 (w3m-deactivate-region))
6836 (let ((buffer (current-buffer))
6837 (prev start)
6838 (url (w3m-url-valid (w3m-anchor start)))
6839 urls all)
6840 (when url
6841 (setq urls (list url)))
6842 (save-excursion
6843 (goto-char start)
6844 (setq all (not (and (bolp)
6845 w3m-current-url
6846 (string-match "\\`http://\\(?:[^/]+\\.\\)*google\\."
6847 w3m-current-url))))
6848 (while (progn
6849 (w3m-next-anchor)
6850 (and (> (point) prev)
6851 (< (point) end)))
6852 (setq prev (point))
6853 (when (and (setq url (w3m-url-valid (w3m-anchor)))
6854 (string-match "\\`https?:" url)
6855 (or all
6856 (bolp)))
6857 (push url urls))))
6858 (setq urls (nreverse urls))
6859 (while urls
6860 (setq url (car urls)
6861 urls (cdr urls))
6862 (set-buffer buffer)
6863 (w3m-view-this-url-1 url arg t))))
6864
6865 (defun w3m-view-this-url-new-session ()
6866 "Display the page of the link under point in a new session.
6867 If the region is active, use the `w3m-open-all-links-in-new-session'
6868 command instead."
6869 (interactive)
6870 (if (w3m-region-active-p)
6871 (call-interactively 'w3m-open-all-links-in-new-session)
6872 (w3m-view-this-url nil t)))
6873
6874 (defun w3m-mouse-view-this-url-new-session (event)
6875 "Follow the link under the mouse pointer in a new session."
6876 (interactive "e")
6877 (mouse-set-point event)
6878 (w3m-view-this-url nil t))
6879
6880 (defun w3m-submit-form (&optional new-session)
6881 "Submit the form at point."
6882 (interactive "P")
6883 (let ((submit (w3m-submit)))
6884 (if (and submit
6885 w3m-current-url
6886 (w3m-url-valid w3m-current-url)
6887 (if w3m-submit-form-safety-check
6888 (prog1 (y-or-n-p "Submit? ") (message nil))
6889 t))
6890 (let ((w3m-form-new-session new-session)
6891 (w3m-form-download nil))
6892 (eval submit))
6893 (w3m-message "Can't submit form at this point"))))
6894
6895 (defun w3m-external-view (url &optional no-cache handler)
6896 (when (w3m-url-valid url)
6897 (lexical-let ((url url)
6898 (no-cache no-cache))
6899 (w3m-process-do
6900 (type (w3m-content-type url no-cache handler))
6901 (when type
6902 (lexical-let ((method
6903 (or (nth 2 (assoc type w3m-content-type-alist))
6904 (nth 2 (assoc (w3m-prepare-content url type nil)
6905 w3m-content-type-alist)))))
6906 (cond
6907 ((not method)
6908 (if (w3m-url-local-p url)
6909 (error "\
6910 No method to view `%s' is registered. Use `w3m-edit-this-url'"
6911 (file-name-nondirectory (w3m-url-to-file-name url)))
6912 (w3m-download url nil no-cache handler)))
6913 ((functionp method)
6914 (funcall method url))
6915 ((consp method)
6916 (lexical-let
6917 ((command (w3m-which-command (car method)))
6918 (arguments (cdr method))
6919 (file (make-temp-name
6920 (expand-file-name "w3mel" w3m-profile-directory)))
6921 suffix)
6922 (setq suffix (file-name-nondirectory url))
6923 (when (string-match "\\.[a-zA-Z0-9]+$" suffix)
6924 (setq suffix (match-string 0 suffix))
6925 (when (< (length suffix) 5)
6926 (setq file (concat file suffix))))
6927 (cond
6928 ((and command (memq 'file arguments))
6929 (let ((w3m-current-buffer (current-buffer)))
6930 (w3m-process-do
6931 (success (w3m-download url file no-cache handler))
6932 (when success
6933 (w3m-external-view-file command file url arguments)))))
6934 (command
6935 (w3m-external-view-file command nil url arguments))
6936 (t
6937 (w3m-download url nil no-cache handler))))))))))))
6938
6939 (defun w3m-external-view-file (command file url arguments)
6940 ;; The 3rd argument `url' is necessary to handle the constant `url'
6941 ;; included in the 4th argument `arguments' which is provided by
6942 ;; `w3m-content-type-alist'.
6943 (lexical-let ((file file))
6944 (let (proc)
6945 (unwind-protect
6946 (with-current-buffer
6947 (generate-new-buffer " *w3m-external-view*")
6948 (setq proc
6949 (apply 'start-process
6950 "w3m-external-view"
6951 (current-buffer)
6952 command
6953 (mapcar (function eval) arguments)))
6954 (w3m-message "Start %s..." (file-name-nondirectory command))
6955 (set-process-sentinel
6956 proc
6957 (lambda (proc event)
6958 (let ((buffer (process-buffer proc)))
6959 (when (and (string-match "^\\(?:finished\\|exited\\)" event)
6960 (buffer-name buffer))
6961 (with-current-buffer buffer
6962 (and (stringp file)
6963 (file-exists-p file)
6964 (delete-file file)))
6965 (kill-buffer buffer))))))
6966 (and (stringp file)
6967 (file-exists-p file)
6968 (unless (and (processp proc)
6969 (memq (process-status proc) '(run stop)))
6970 (delete-file file)))))))
6971
6972 (defun w3m-view-image ()
6973 "Display the image under point in the external viewer.
6974 The viewer is defined in `w3m-content-type-alist' for every type of an
6975 image."
6976 (interactive)
6977 (let ((url (w3m-url-valid (w3m-image))))
6978 (if url
6979 (w3m-external-view url)
6980 (w3m-message "No image at point"))))
6981
6982 (defun w3m-save-image ()
6983 "Save the image under point to a file.
6984 The default name will be the original name of the image."
6985 (interactive)
6986 (let ((url (w3m-url-valid (w3m-image))))
6987 (if url
6988 (w3m-download url)
6989 (w3m-message "No image at point"))))
6990
6991 (defun w3m-external-view-this-url ()
6992 "Launch the external browser and display the link an point."
6993 (interactive)
6994 (let ((url (w3m-url-valid (or (w3m-anchor) (w3m-image)))))
6995 (if url
6996 (w3m-external-view url)
6997 (w3m-message "No URL at point"))))
6998
6999 (defun w3m-external-view-current-url ()
7000 "Launch the external browser and display the current URL."
7001 (interactive)
7002 (if w3m-current-url
7003 (w3m-external-view w3m-current-url)
7004 (w3m-message "No URL at this page")))
7005
7006 (defun w3m-view-url-with-external-browser (&optional url)
7007 "Launch the external browser and display the same web page.
7008 If the cursor points to a link, it visits the url of the link instead
7009 of the url currently displayed. The browser is defined in
7010 `w3m-content-type-alist' for every type of a url."
7011 (interactive)
7012 (unless url
7013 (setq url (or url
7014 (w3m-anchor)
7015 (unless w3m-display-inline-images
7016 (w3m-image))
7017 (when (y-or-n-p (format "Browse <%s> ? " w3m-current-url))
7018 w3m-current-url))))
7019 (if (w3m-url-valid url)
7020 (progn
7021 (message "Browsing <%s>..." url)
7022 (w3m-external-view url))
7023 (w3m-message "No URL at point")))
7024
7025 (defun w3m-download-this-url ()
7026 "Download the file or the page pointed to by the link under point."
7027 (interactive)
7028 (let ((url (or (w3m-anchor) (w3m-image))) act)
7029 (cond
7030 ((w3m-url-valid url)
7031 (lexical-let ((pos (point-marker))
7032 (curl w3m-current-url))
7033 (w3m-process-with-null-handler
7034 (w3m-process-do
7035 (success (w3m-download url nil nil handler))
7036 (and success
7037 (buffer-name (marker-buffer pos))
7038 (with-current-buffer (marker-buffer pos)
7039 (when (equal curl w3m-current-url)
7040 (goto-char pos)
7041 (w3m-refontify-anchor))))))))
7042 ((setq act (w3m-action))
7043 (let ((w3m-form-download t))
7044 (eval act)))
7045 (t
7046 (w3m-message "No URL at point")))))
7047
7048 (defun w3m-download-this-image ()
7049 "Download the image under point."
7050 (interactive)
7051 (let ((url (w3m-image)) act)
7052 (cond
7053 ((w3m-url-valid url)
7054 (lexical-let ((pos (point-marker))
7055 (curl w3m-current-url))
7056 (w3m-process-with-null-handler
7057 (w3m-process-do
7058 (success (w3m-download url nil nil handler))
7059 (and success
7060 (buffer-name (marker-buffer pos))
7061 (with-current-buffer (marker-buffer pos)
7062 (when (equal curl w3m-current-url)
7063 (goto-char pos)
7064 (w3m-refontify-anchor))))))))
7065 ((setq act (w3m-action))
7066 (let ((w3m-form-download t))
7067 (eval act)))
7068 (t
7069 (w3m-message "No image at point")))))
7070
7071 (defun w3m-print-current-url ()
7072 "Display the current url in the echo area and put it into `kill-ring'."
7073 (interactive)
7074 (when w3m-current-url
7075 (let ((deactivate-mark nil))
7076 (kill-new w3m-current-url)
7077 (w3m-message "%s" (w3m-url-readable-string w3m-current-url)))))
7078
7079 (defun w3m-print-this-url (&optional interactive-p)
7080 "Display the url under point in the echo area and put it into `kill-ring'."
7081 (interactive (list t))
7082 (let ((deactivate-mark nil)
7083 (url (if interactive-p
7084 (or (w3m-anchor) (w3m-image))
7085 (or (w3m-anchor (point)) (w3m-image (point)))))
7086 (alt (if interactive-p
7087 (w3m-image-alt)
7088 (w3m-image-alt (point)))))
7089 (when (or url interactive-p)
7090 (and url interactive-p (kill-new url))
7091 (w3m-message "%s%s"
7092 (if (zerop (length alt))
7093 ""
7094 (concat alt ": "))
7095 (or (w3m-url-readable-string url)
7096 (and (w3m-action) "There is a form")
7097 "There is no url")))))
7098
7099 (defun w3m-print-this-image-url (&optional interactive-p)
7100 "Display image url under point in echo area and put it into `kill-ring'."
7101 (interactive (list t))
7102 (let ((deactivate-mark nil)
7103 (url (if interactive-p
7104 (w3m-image)
7105 (w3m-image (point))))
7106 (alt (if interactive-p
7107 (w3m-image-alt)
7108 (w3m-image-alt (point)))))
7109 (when (or url interactive-p)
7110 (and url interactive-p (kill-new url))
7111 (w3m-message "%s%s"
7112 (if (zerop (length alt))
7113 ""
7114 (concat alt ": "))
7115 (or (w3m-url-readable-string url)
7116 (and (w3m-action) "There is a form")
7117 "There is no image url")))))
7118
7119 (defmacro w3m-delete-all-overlays ()
7120 "Delete all momentary overlays."
7121 '(dolist (overlay (overlays-in (point-min) (point-max)))
7122 (if (overlay-get overlay 'w3m-momentary-overlay)
7123 (delete-overlay overlay))))
7124
7125 (defun w3m-highlight-current-anchor-1 (seq)
7126 "Highlight an anchor in the line if the anchor sequence is the same as SEQ.
7127 Return t if highlighting is successful."
7128 (let ((limit (point-at-eol))
7129 ov beg pos pseq)
7130 (save-excursion
7131 (beginning-of-line)
7132 (setq pos (point))
7133 (while (and pos
7134 (< pos limit)
7135 (not (eq seq (setq pseq (w3m-anchor-sequence pos)))))
7136 (setq pos (next-single-property-change pos 'w3m-anchor-sequence)))
7137 (when (and pos (< pos limit) (eq seq pseq))
7138 (setq beg pos)
7139 (setq pos (next-single-property-change pos 'w3m-anchor-sequence))
7140 (setq ov (make-overlay beg pos))
7141 (overlay-put ov 'face 'w3m-current-anchor)
7142 (overlay-put ov 'w3m-momentary-overlay t)
7143 (overlay-put ov 'evaporate t)
7144 t))))
7145
7146 (defun w3m-highlight-current-anchor ()
7147 "Highlight an anchor under point."
7148 (when (let ((ovs (overlays-at (point))) ov)
7149 ;; If the anchor is already highlighted, it does nothing.
7150 (or (null ovs)
7151 (null (progn (while ovs
7152 (if (overlay-get (car ovs) 'w3m-momentary-overlay)
7153 (setq ov (car ovs)
7154 ovs nil))
7155 (setq ovs (cdr ovs)))
7156 ov))))
7157 (w3m-delete-all-overlays)
7158 (save-excursion
7159 (let ((seq (w3m-anchor-sequence))
7160 (pos (point)))
7161 (when (and seq
7162 (w3m-highlight-current-anchor-1 seq)
7163 (zerop (forward-line 1)))
7164 (while (and (w3m-highlight-current-anchor-1 seq)
7165 (zerop (forward-line 1))))
7166 (goto-char pos)
7167 (while (and (zerop (forward-line -1))
7168 (w3m-highlight-current-anchor-1 seq))))))))
7169
7170 (defun w3m-edit-url (url)
7171 "Edit the page pointed by URL."
7172 (interactive (list (w3m-input-url)))
7173 (when (string-match "\\`about://\\(?:header\\|source\\)/" url)
7174 (setq url (substring url (match-end 0))))
7175 (catch 'found
7176 (dolist (pair w3m-edit-function-alist)
7177 (when (and (string-match (car pair) url)
7178 (fboundp (cdr pair)))
7179 (throw 'found (funcall (cdr pair) url))))
7180 (funcall w3m-edit-function
7181 (or (w3m-url-to-file-name url)
7182 (error "URL:%s is not a local file" url)))))
7183
7184 (defun w3m-edit-current-url ()
7185 "Edit this viewing page."
7186 (interactive)
7187 (if w3m-current-url
7188 (w3m-edit-url w3m-current-url)
7189 (w3m-message "No URL")))
7190
7191 (defun w3m-edit-this-url ()
7192 "Edit the page linked from the anchor under the cursor."
7193 (interactive)
7194 (let ((url (w3m-url-valid (w3m-anchor))))
7195 (if url
7196 (w3m-edit-url url)
7197 (w3m-message "No URL at point"))))
7198
7199 (defvar w3m-goto-anchor-hist nil)
7200 (make-variable-buffer-local 'w3m-goto-anchor-hist)
7201
7202 (defun w3m-goto-next-anchor ()
7203 (let ((hseq (w3m-anchor-sequence))
7204 (pos (next-single-property-change (point) 'w3m-anchor-sequence)))
7205 (if (or (not hseq) (< hseq 1))
7206 (and pos (goto-char pos))
7207 (setq pos
7208 ;; hseq is not sequence in form.
7209 (catch 'loop
7210 (setq hseq (1+ hseq))
7211 (while (<= hseq w3m-max-anchor-sequence)
7212 (setq pos (text-property-any
7213 (point-min) (point-max) 'w3m-anchor-sequence hseq))
7214 (when pos (throw 'loop pos))
7215 (setq hseq (1+ hseq)))))
7216 (and pos (goto-char pos)))))
7217
7218 (defun w3m-next-anchor (&optional arg)
7219 "Move the point to the next anchor."
7220 (interactive "p")
7221 (w3m-keep-region-active)
7222 (unless arg (setq arg 1))
7223 (if (null (memq last-command '(w3m-next-anchor w3m-previous-anchor)))
7224 (when (setq w3m-goto-anchor-hist (w3m-anchor-sequence))
7225 (setq w3m-goto-anchor-hist (list w3m-goto-anchor-hist)))
7226 (when (and (eq last-command 'w3m-previous-anchor) w3m-goto-anchor-hist)
7227 (setcdr w3m-goto-anchor-hist nil)))
7228 (if (< arg 0)
7229 (w3m-previous-anchor (- arg))
7230 (let (pos)
7231 (while (> arg 0)
7232 (unless (w3m-goto-next-anchor)
7233 (setq w3m-goto-anchor-hist nil)
7234 (if (w3m-imitate-widget-button)
7235 (widget-forward 1)
7236 (when (setq pos (text-property-any
7237 (point-min) (point-max) 'w3m-anchor-sequence 1))
7238 (goto-char pos))))
7239 (setq arg (1- arg))
7240 (if (member (w3m-anchor-sequence) w3m-goto-anchor-hist)
7241 (setq arg (1+ arg))
7242 (push (w3m-anchor-sequence) w3m-goto-anchor-hist))))
7243 (w3m-horizontal-on-screen)
7244 (w3m-print-this-url)))
7245
7246 (defun w3m-goto-previous-anchor ()
7247 (let ((hseq (w3m-anchor-sequence))
7248 (pos (previous-single-property-change (point) 'w3m-anchor-sequence)))
7249 (cond
7250 ((and (not hseq) pos)
7251 (if (w3m-anchor-sequence pos)
7252 (goto-char pos)
7253 (setq pos (previous-single-property-change pos 'w3m-anchor-sequence))
7254 (and pos (goto-char pos))))
7255 ((or (not pos) (< hseq 2)) nil)
7256 (t
7257 (setq pos
7258 ;; hseq is not sequence in form.
7259 (catch 'loop
7260 (setq hseq (1- hseq))
7261 (while (> hseq 0)
7262 (setq pos (text-property-any
7263 (point-min) (point-max) 'w3m-anchor-sequence hseq))
7264 (when pos (throw 'loop pos))
7265 (setq hseq (1- hseq)))))
7266 (and pos (goto-char pos))))))
7267
7268 (defun w3m-previous-anchor (&optional arg)
7269 "Move the point to the previous anchor."
7270 (interactive "p")
7271 (w3m-keep-region-active)
7272 (unless arg (setq arg 1))
7273 (if (null (memq last-command '(w3m-next-anchor w3m-previous-anchor)))
7274 (when (setq w3m-goto-anchor-hist (w3m-anchor-sequence))
7275 (setq w3m-goto-anchor-hist (list w3m-goto-anchor-hist)))
7276 (when (and (eq last-command 'w3m-next-anchor) w3m-goto-anchor-hist)
7277 (setcdr w3m-goto-anchor-hist nil)))
7278 (if (< arg 0)
7279 (w3m-next-anchor (- arg))
7280 (let (pos)
7281 (while (> arg 0)
7282 (unless (w3m-goto-previous-anchor)
7283 (setq w3m-goto-anchor-hist nil)
7284 (if (w3m-imitate-widget-button)
7285 (widget-forward -1)
7286 (when (setq pos (and w3m-max-anchor-sequence
7287 (text-property-any
7288 (point-min) (point-max)
7289 'w3m-anchor-sequence
7290 w3m-max-anchor-sequence)))
7291 (goto-char pos))))
7292 (setq arg (1- arg))
7293 (if (member (w3m-anchor-sequence) w3m-goto-anchor-hist)
7294 (setq arg (1+ arg))
7295 (push (w3m-anchor-sequence) w3m-goto-anchor-hist))))
7296 (w3m-horizontal-on-screen)
7297 (w3m-print-this-url)))
7298
7299 (defun w3m-goto-next-form ()
7300 ;; Move the point to the end of the current form.
7301 (when (w3m-action (point))
7302 (goto-char (next-single-property-change (point) 'w3m-action)))
7303 ;; Find the next form.
7304 (or (w3m-action (point))
7305 (let ((pos (next-single-property-change (point) 'w3m-action)))
7306 (when pos
7307 (goto-char pos)
7308 t))))
7309
7310 (defun w3m-next-form (&optional arg)
7311 "Move the point to the next form."
7312 (interactive "p")
7313 (w3m-keep-region-active)
7314 (unless arg (setq arg 1))
7315 (if (null (memq last-command '(w3m-next-form w3m-previous-form)))
7316 (when (setq w3m-goto-anchor-hist (w3m-action (point)))
7317 (setq w3m-goto-anchor-hist (list w3m-goto-anchor-hist)))
7318 (when (and (eq last-command 'w3m-previous-form) w3m-goto-anchor-hist)
7319 (setcdr w3m-goto-anchor-hist nil)))
7320 (if (< arg 0)
7321 (w3m-previous-form (- arg))
7322 (while (> arg 0)
7323 (unless (w3m-goto-next-form)
7324 ;; Make a search from the beginning of the buffer.
7325 (setq w3m-goto-anchor-hist nil)
7326 (goto-char (point-min))
7327 (w3m-goto-next-form))
7328 (setq arg (1- arg))
7329 (if (member (w3m-action (point)) w3m-goto-anchor-hist)
7330 (setq arg (1+ arg))
7331 (push (w3m-action (point)) w3m-goto-anchor-hist)))
7332 (w3m-horizontal-on-screen)
7333 (w3m-print-this-url)))
7334
7335 (defun w3m-goto-previous-form ()
7336 ;; Move the point to the beginning of the current form.
7337 (when (w3m-action (point))
7338 (goto-char (previous-single-property-change (1+ (point))
7339 'w3m-action)))
7340 ;; Find the previous form.
7341 (let ((pos (previous-single-property-change (point) 'w3m-action)))
7342 (if pos
7343 (goto-char
7344 (if (w3m-action pos)
7345 pos
7346 (previous-single-property-change pos 'w3m-action))))))
7347
7348 (defun w3m-previous-form (&optional arg)
7349 "Move the point to the previous form."
7350 (interactive "p")
7351 (w3m-keep-region-active)
7352 (unless arg (setq arg 1))
7353 (if (null (memq last-command '(w3m-next-form w3m-previous-form)))
7354 (when (setq w3m-goto-anchor-hist (w3m-action (point)))
7355 (setq w3m-goto-anchor-hist (list w3m-goto-anchor-hist)))
7356 (when (and (eq last-command 'w3m-next-form) w3m-goto-anchor-hist)
7357 (setcdr w3m-goto-anchor-hist nil)))
7358 (if (< arg 0)
7359 (w3m-next-form (- arg))
7360 (while (> arg 0)
7361 (unless (w3m-goto-previous-form)
7362 ;; search from the end of the buffer
7363 (setq w3m-goto-anchor-hist nil)
7364 (goto-char (point-max))
7365 (w3m-goto-previous-form))
7366 (setq arg (1- arg))
7367 (if (member (w3m-action (point)) w3m-goto-anchor-hist)
7368 (setq arg (1+ arg))
7369 (push (w3m-action (point)) w3m-goto-anchor-hist)))
7370 (w3m-horizontal-on-screen)
7371 (w3m-print-this-url)))
7372
7373 (defun w3m-goto-next-image ()
7374 ;; Move the point to the end of the current image.
7375 (when (w3m-image (point))
7376 (goto-char (next-single-property-change (point) 'w3m-image)))
7377 ;; Find the next form or image.
7378 (or (w3m-image (point))
7379 (let ((pos (next-single-property-change (point) 'w3m-image)))
7380 (when pos
7381 (goto-char pos)
7382 t))))
7383
7384 (defun w3m-next-image (&optional arg)
7385 "Move the point to the next image."
7386 (interactive "p")
7387 (w3m-keep-region-active)
7388 (unless arg (setq arg 1))
7389 (if (null (memq last-command
7390 '(w3m-next-image w3m-previous-image)))
7391 (when (setq w3m-goto-anchor-hist (w3m-image (point)))
7392 (setq w3m-goto-anchor-hist (list w3m-goto-anchor-hist)))
7393 (when (and (eq last-command 'w3m-previous-image)
7394 w3m-goto-anchor-hist)
7395 (setcdr w3m-goto-anchor-hist nil)))
7396 (if (< arg 0)
7397 (w3m-previous-image (- arg))
7398 (while (> arg 0)
7399 (unless (w3m-goto-next-image)
7400 ;; Make a search for an image from the beginning of the buffer.
7401 (setq w3m-goto-anchor-hist nil)
7402 (goto-char (point-min))
7403 (w3m-goto-next-image))
7404 (setq arg (1- arg))
7405 (if (member (w3m-image (point)) w3m-goto-anchor-hist)
7406 (setq arg (1+ arg))
7407 (push (w3m-image (point)) w3m-goto-anchor-hist)))
7408 (w3m-horizontal-on-screen)
7409 (w3m-print-this-url)))
7410
7411 (defun w3m-goto-previous-image ()
7412 ;; Move the point to the beginning of the current image.
7413 (when (w3m-image (point))
7414 (goto-char (previous-single-property-change (1+ (point))
7415 'w3m-image)))
7416 ;; Find the previous form or image.
7417 (let ((pos (previous-single-property-change (point) 'w3m-image)))
7418 (if pos
7419 (goto-char
7420 (if (w3m-image pos) pos
7421 (previous-single-property-change pos 'w3m-image))))))
7422
7423 (defun w3m-previous-image (&optional arg)
7424 "Move the point to the previous image."
7425 (interactive "p")
7426 (w3m-keep-region-active)
7427 (unless arg (setq arg 1))
7428 (if (null (memq last-command '(w3m-next-image w3m-previous-image)))
7429 (when (setq w3m-goto-anchor-hist (w3m-image (point)))
7430 (setq w3m-goto-anchor-hist (list w3m-goto-anchor-hist)))
7431 (when (and (eq last-command 'w3m-next-image)
7432 w3m-goto-anchor-hist)
7433 (setcdr w3m-goto-anchor-hist nil)))
7434 (if (< arg 0)
7435 (w3m-next-image (- arg))
7436 (while (> arg 0)
7437 (unless (w3m-goto-previous-image)
7438 ;; Make a search from the end of the buffer.
7439 (setq w3m-goto-anchor-hist nil)
7440 (goto-char (point-max))
7441 (w3m-goto-previous-image))
7442 (setq arg (1- arg))
7443 (if (member (w3m-image (point)) w3m-goto-anchor-hist)
7444 (setq arg (1+ arg))
7445 (push (w3m-image (point)) w3m-goto-anchor-hist)))
7446 (w3m-horizontal-on-screen)
7447 (w3m-print-this-url)))
7448
7449 (defun w3m-copy-buffer (&optional buffer newname just-copy empty background)
7450 "Create a copy of the BUFFER in which emacs-w3m is working.
7451 Return a new buffer.
7452
7453 If BUFFER is nil, the current buffer is assumed. If NEWNAME is nil,
7454 it defaults to the name of the current buffer. If JUST-COPY is nil,
7455 this function lets a new buffer be the current buffer and pop up as a
7456 new window or a new frame according to `w3m-pop-up-windows' and
7457 `w3m-pop-up-frames' (which see), otherwise just creates BUFFER's copy.
7458 If EMPTY is nil, a page of the same url will be re-rendered in a new
7459 buffer, otherwise an empty buffer is created. If BACKGROUND is non-nil,
7460 this function stays on the current buffer.
7461
7462 Note that this function should be called on the window displaying the
7463 original buffer BUFFER even if JUST-COPY is non-nil in order to render
7464 a page in a new buffer with the correct width."
7465 (interactive (list (current-buffer)
7466 (if current-prefix-arg (read-string "Name: "))
7467 t))
7468 (unless buffer
7469 (setq buffer (current-buffer)))
7470 (unless newname
7471 (setq newname (buffer-name buffer)))
7472 (when (string-match "<[0-9]+>\\'" newname)
7473 (setq newname (substring newname 0 (match-beginning 0))))
7474 (let (url coding images init-frames new)
7475 (save-current-buffer
7476 (set-buffer buffer)
7477 (setq url (or w3m-current-url
7478 (car (w3m-history-element (cadar w3m-history))))
7479 coding w3m-current-coding-system
7480 images w3m-display-inline-images
7481 init-frames (when (w3m-popup-frame-p)
7482 (copy-sequence w3m-initial-frames)))
7483 (unless url
7484 (setq empty t))
7485 ;;
7486 (set-buffer (setq new (w3m-generate-new-buffer newname)))
7487 (w3m-mode)
7488 ;; Make copies of `w3m-history' and `w3m-history-flat'.
7489 (w3m-history-copy buffer)
7490 (setq w3m-current-coding-system coding
7491 w3m-initial-frames init-frames
7492 w3m-display-inline-images
7493 (if w3m-toggle-inline-images-permanently
7494 images
7495 w3m-default-display-inline-images)))
7496 (cond
7497 ((and empty (not background))
7498 ;; Pop to a window or a frame up because `w3m-goto-url' is not called.
7499 (w3m-popup-buffer new))
7500 (empty
7501 ;; When empty and just-copy, stay origianl buffer.
7502 )
7503 (t
7504 ;; Need to change to the `new' buffer in which `w3m-goto-url' runs.
7505 (set-buffer new)
7506 ;; Render a page.
7507 (let ((positions (copy-sequence (car w3m-history)))
7508 (w3m-history-reuse-history-elements t)
7509 (w3m-prefer-cache t))
7510 (w3m-process-with-wait-handler
7511 (w3m-goto-url url 'redisplay nil nil nil handler
7512 ;; Pass the properties of the history elements,
7513 ;; although it is currently always nil.
7514 (w3m-history-element (cadr positions))))
7515 (setcar w3m-history positions))
7516 (when (and w3m-new-session-in-background
7517 just-copy
7518 (not (get-buffer-window buffer)))
7519 (set-window-buffer (selected-window) buffer))))
7520 new))
7521
7522 (defun w3m-next-buffer (arg)
7523 "Turn ARG pages of emacs-w3m buffers ahead."
7524 (interactive "p")
7525 (unless arg (setq arg 1))
7526 (when (and (/= arg 0) (eq major-mode 'w3m-mode))
7527 (w3m-history-store-position)
7528 (let* ((buffers (w3m-list-buffers))
7529 (len (length buffers)))
7530 (switch-to-buffer
7531 (nth (mod (+ arg (- len (length (memq (current-buffer) buffers))))
7532 len)
7533 buffers)))
7534 (w3m-history-restore-position)
7535 (run-hooks 'w3m-select-buffer-hook)
7536 (w3m-select-buffer-update)))
7537
7538 (defun w3m-previous-buffer (arg)
7539 "Turn ARG pages of emacs-w3m buffers behind."
7540 (interactive "p")
7541 (w3m-next-buffer (- arg)))
7542
7543 (defun w3m-delete-buffer (&optional force)
7544 "Delete the current emacs-w3m buffer and switch to the previous one.
7545 If there is the sole emacs-w3m buffer, it is assumed to be called for
7546 terminating the emacs-w3m session; the prefix argument FORCE will be
7547 passed to the `w3m-quit' function (which see)."
7548 (interactive "P")
7549 ;; Bind `w3m-fb-mode' to nil so that this function might not call
7550 ;; `w3m-quit' when there is only one buffer belonging to the selected
7551 ;; frame, but there are emacs-w3m buffers in other frames.
7552 (let* ((w3m-fb-mode nil)
7553 (buffers (w3m-list-buffers t))
7554 (num (length buffers))
7555 cur buf bufs)
7556 (if (= 1 num)
7557 (w3m-quit force)
7558 (setq cur (current-buffer))
7559 (if (w3m-use-tab-p)
7560 (save-window-excursion
7561 (select-window (or (get-buffer-window cur t) (selected-window)))
7562 (w3m-next-buffer -1))
7563 ;; List buffers being shown in the other windows of the current frame.
7564 (save-current-buffer
7565 (walk-windows (lambda (window)
7566 (set-buffer (setq buf (window-buffer window)))
7567 (when (and (eq major-mode 'w3m-mode)
7568 (not (eq buf cur)))
7569 (push buf bufs)))
7570 'no-minibuf))
7571 (cond ((= (1- num) (length bufs))
7572 ;; All the other buffers are shown in the current frame.
7573 (select-window (get-buffer-window (prog2
7574 (w3m-next-buffer -1)
7575 (current-buffer)
7576 (delete-window)))))
7577 (bufs
7578 ;; Look for the buffer which is not shown in the current frame.
7579 (setq buf nil)
7580 (while (progn
7581 (w3m-next-buffer -1)
7582 (unless buf
7583 (setq buf (current-buffer)))
7584 (memq (current-buffer) bufs)))
7585 (when (memq buf bufs)
7586 ;; Go to the buffer which is most suitable to be called
7587 ;; the *previous* buffer.
7588 (select-window (get-buffer-window buf))))
7589 ((progn ;; List buffers being not shown anywhere.
7590 (setq bufs nil)
7591 (while buffers
7592 (unless (get-buffer-window (setq buf (pop buffers)) t)
7593 (push buf bufs)))
7594 bufs)
7595 (while (progn
7596 (w3m-next-buffer -1)
7597 (not (memq (current-buffer) bufs)))))
7598 ((memq (selected-frame) w3m-initial-frames)
7599 ;; Assume that this frame was created to show this buffer.
7600 (if (one-window-p t)
7601 (delete-frame)
7602 (delete-window)))
7603 (t
7604 (if (>= num 2)
7605 (w3m-next-buffer -1)
7606 (unless (one-window-p t)
7607 (delete-window))))))
7608 (w3m-session-deleted-save (list cur))
7609 (w3m-process-stop cur)
7610 (w3m-idle-images-show-unqueue cur)
7611 (kill-buffer cur)
7612 (when w3m-use-form
7613 (w3m-form-kill-buffer cur))
7614 (w3m-history-restore-position)
7615 (run-hooks 'w3m-delete-buffer-hook)
7616 (w3m-session-crash-recovery-save)))
7617 (w3m-select-buffer-update)
7618 (unless w3m-fb-inhibit-buffer-selection
7619 (w3m-fb-select-buffer)))
7620
7621 (defun w3m-delete-buffer-if-empty (buffer)
7622 "Delete a newly created emacs-w3m buffer BUFFER if it seems unnecessary.
7623 Some emacs-w3m commands create a buffer for the new session first, but
7624 it may be useless if the command is invoked for visiting a local file
7625 or a mail buffer. This command will delete BUFFER if it is empty or
7626 there is only a progress message. It also deletes windows and frames
7627 related to BUFFER."
7628 (with-current-buffer buffer
7629 (unless (or w3m-current-process
7630 w3m-current-url
7631 (not (or (zerop (buffer-size))
7632 (and (get-text-property (point-min)
7633 'w3m-progress-message)
7634 (get-text-property (1- (point-max))
7635 'w3m-progress-message)))))
7636 (w3m-delete-buffer t))))
7637
7638 (defun w3m-pack-buffer-numbers ()
7639 "Renumber suffixes of names of emacs-w3m buffers.
7640 It aligns emacs-w3m buffers in order of *w3m*, *w3m<2>, *w3m*<3>,...
7641 as if the folder command of MH performs with the -pack option."
7642 (interactive)
7643 (let ((count 1) number newname)
7644 (dolist (buffer (w3m-list-buffers))
7645 (setq number (w3m-buffer-number buffer))
7646 (when number
7647 (unless (eq number count)
7648 (when (and (setq newname (w3m-buffer-set-number buffer count))
7649 w3m-use-form)
7650 (w3m-form-set-number buffer newname)))
7651 (incf count)))))
7652
7653 (defun w3m-delete-other-buffers (&optional buffer)
7654 "Delete emacs-w3m buffers except for BUFFER or the current buffer."
7655 (interactive)
7656 (unless buffer
7657 (setq buffer (current-buffer)))
7658 (w3m-delete-frames-and-windows buffer)
7659 (let ((buffers (delq buffer (w3m-list-buffers t))))
7660 (w3m-delete-buffers buffers)))
7661
7662 (defun w3m-delete-left-tabs ()
7663 "Delete tabs on the left side of the current tab."
7664 (interactive)
7665 (let ((cbuf (current-buffer))
7666 bufs)
7667 (setq bufs (catch 'done
7668 (dolist (buf (w3m-list-buffers))
7669 (if (eq cbuf buf)
7670 (throw 'done bufs)
7671 (setq bufs (cons buf bufs))))))
7672 (when bufs
7673 (w3m-delete-buffers bufs))))
7674
7675 (defun w3m-delete-right-tabs ()
7676 "Delete tabs on the right side of the current tab."
7677 (interactive)
7678 (let ((bufs (w3m-righttab-exist-p)))
7679 (when bufs
7680 (w3m-delete-buffers bufs))))
7681
7682 (defun w3m-delete-buffers (buffers)
7683 "Delete emacs-w3m buffers."
7684 (let (buffer)
7685 (when buffers
7686 (w3m-session-deleted-save buffers))
7687 (while buffers
7688 (setq buffer (pop buffers))
7689 (w3m-process-stop buffer)
7690 (w3m-idle-images-show-unqueue buffer)
7691 (kill-buffer buffer)
7692 (when w3m-use-form
7693 (w3m-form-kill-buffer buffer))))
7694 (run-hooks 'w3m-delete-buffer-hook)
7695 (w3m-session-crash-recovery-save)
7696 (w3m-select-buffer-update)
7697 (w3m-force-window-update))
7698
7699 (defvar w3m-ctl-c-map nil
7700 "Sub-keymap used for the `C-c'-prefixed commands.
7701
7702 Note: keys should not be alphabet since `C-c LETTER' keys are reserved
7703 for users. See Info node `(elisp)Key Binding Conventions'.")
7704 (unless w3m-ctl-c-map
7705 (let ((map (make-sparse-keymap)))
7706 (define-key map "\C-@" 'w3m-history-store-position)
7707 (if (featurep 'xemacs)
7708 (define-key map [(control space)] 'w3m-history-store-position)
7709 ;; `C- ' doesn't mean `C-SPC' in XEmacs.
7710 (define-key map [?\C-\ ] 'w3m-history-store-position))
7711 (define-key map "\C-v" 'w3m-history-restore-position)
7712 (define-key map "\C-t" 'w3m-copy-buffer)
7713 (define-key map "\C-p" 'w3m-previous-buffer)
7714 (define-key map "\C-n" 'w3m-next-buffer)
7715 (when (featurep 'w3m-ems)
7716 (define-key map [?\C-,] 'w3m-tab-move-left)
7717 (define-key map [?\C-<] 'w3m-tab-move-left)
7718 (define-key map [?\C-.] 'w3m-tab-move-right)
7719 (define-key map [?\C->] 'w3m-tab-move-right))
7720 (define-key map "\C-w" 'w3m-delete-buffer)
7721 (define-key map "\M-w" 'w3m-delete-other-buffers)
7722 (define-key map "\M-l" 'w3m-delete-left-tabs)
7723 (define-key map "\M-r" 'w3m-delete-right-tabs)
7724 (define-key map "\C-s" 'w3m-select-buffer)
7725 (define-key map "\C-a" 'w3m-switch-buffer)
7726 (define-key map "\C-b" 'report-emacs-w3m-bug)
7727 (define-key map "\C-c" 'w3m-submit-form)
7728 (define-key map "\C-k" 'w3m-process-stop)
7729 (define-key map "\C-m" 'w3m-move-unseen-buffer)
7730 (define-key map "\C-l" 'w3m-go-to-linknum)
7731 (setq w3m-ctl-c-map map)))
7732
7733 (defvar w3m-redisplay-map nil
7734 "Sub-keymap used for the `C'-prefixed redisplay commands.")
7735 (unless w3m-redisplay-map
7736 (let ((map (make-sparse-keymap)))
7737 (define-key map "t" 'w3m-redisplay-with-content-type)
7738 (define-key map "c" 'w3m-redisplay-with-charset)
7739 (define-key map "C" 'w3m-redisplay-and-reset)
7740 (setq w3m-redisplay-map map)))
7741
7742 (defvar w3m-linknum-map nil
7743 "Sub-keymap used for the `L'-prefixed link numbering commands.")
7744 (unless w3m-linknum-map
7745 (let ((map (make-sparse-keymap)))
7746 (define-key map "F" 'w3m-go-to-linknum)
7747 (define-key map "I" 'w3m-linknum-view-image)
7748 (define-key map "\M-i" 'w3m-linknum-save-image)
7749 (define-key map "d" 'w3m-linknum-download-this-url)
7750 (define-key map "e" 'w3m-linknum-edit-this-url)
7751 (define-key map "f" 'w3m-linknum-follow)
7752 (define-key map "t" 'w3m-linknum-toggle-inline-image)
7753 (define-key map "u" 'w3m-linknum-print-this-url)
7754 (define-key map "b" 'w3m-linknum-bookmark-add-this-url)
7755 (define-key map "]" 'w3m-linknum-zoom-in-image)
7756 (define-key map "[" 'w3m-linknum-zoom-out-image)
7757 (setq w3m-linknum-map map)))
7758
7759 (defvar w3m-lynx-like-map nil
7760 "Lynx-like keymap used in emacs-w3m buffers.")
7761 ;; `C-t' is a prefix key reserved to commands that do something in all
7762 ;; emacs-w3m buffers. 2006-05-18
7763 (unless w3m-lynx-like-map
7764 (let ((map (make-keymap)))
7765 (suppress-keymap map)
7766 (define-key map " " 'w3m-scroll-up-or-next-url)
7767 (define-key map "b" 'w3m-scroll-down-or-previous-url)
7768 (define-key map [backspace] 'w3m-scroll-down-or-previous-url)
7769 (define-key map [delete] 'w3m-scroll-down-or-previous-url)
7770 (if (featurep 'xemacs)
7771 (define-key map [(shift space)] 'w3m-scroll-down-or-previous-url)
7772 (define-key map [?\S-\ ] 'w3m-scroll-down-or-previous-url))
7773 (define-key map "h" 'backward-char)
7774 (define-key map "j" 'next-line)
7775 (define-key map "k" 'previous-line)
7776 (define-key map "l" 'forward-char)
7777 (define-key map "J" 'w3m-scroll-up-1)
7778 (define-key map "K" (lambda () (interactive) (scroll-down 1)))
7779 (define-key map "\C-?" 'w3m-scroll-down-or-previous-url)
7780 (define-key map "\t" 'w3m-next-anchor)
7781 (define-key map [tab] 'w3m-next-anchor)
7782 (define-key map [(shift tab)] 'w3m-previous-anchor)
7783 (define-key map [(shift iso-lefttab)] 'w3m-previous-anchor)
7784 (define-key map [backtab] 'w3m-previous-anchor)
7785 (define-key map [down] 'w3m-next-anchor)
7786 (define-key map "\M-\t" 'w3m-previous-anchor)
7787 (define-key map [up] 'w3m-previous-anchor)
7788 (define-key map "\C-m" 'w3m-view-this-url)
7789 (define-key map [(shift return)] 'w3m-view-this-url-new-session)
7790 (define-key map [(shift kp-enter)] 'w3m-view-this-url-new-session)
7791 (define-key map [right] 'w3m-view-this-url)
7792 (cond ((featurep 'xemacs)
7793 (define-key map [(button3)] 'w3m-mouse-major-mode-menu))
7794 ;; Don't use [mouse-3], which gets submenus not working in GTK Emacs.
7795 ((featurep 'gtk)
7796 (define-key map [down-mouse-3] 'w3m-mouse-major-mode-menu)
7797 (define-key map [drag-mouse-3] 'undefined)
7798 (define-key map [mouse-3] 'undefined))
7799 (t
7800 (define-key map [mouse-3] 'w3m-mouse-major-mode-menu)))
7801 (if (featurep 'xemacs)
7802 (progn
7803 (define-key map [(button2)] 'w3m-mouse-view-this-url)
7804 (define-key map [(shift button2)]
7805 'w3m-mouse-view-this-url-new-session))
7806 (define-key map [mouse-2] 'w3m-mouse-view-this-url)
7807 ;; Support for mouse-1 on Emacs 22 and greater.
7808 (define-key map [follow-link] 'mouse-face)
7809 (define-key map [S-mouse-2] 'w3m-mouse-view-this-url-new-session))
7810 (define-key map [left] 'w3m-view-previous-page)
7811 (define-key map "B" 'w3m-view-previous-page)
7812 (define-key map "N" 'w3m-view-next-page)
7813 (define-key map "^" 'w3m-view-parent-page)
7814 (define-key map "\M-d" 'w3m-download)
7815 (define-key map "d" 'w3m-download-this-url)
7816 (define-key map "u" 'w3m-print-this-url)
7817 (define-key map "I" 'w3m-view-image)
7818 (define-key map "\M-i" 'w3m-save-image)
7819 (define-key map "c" 'w3m-print-current-url)
7820 (define-key map "M" 'w3m-view-url-with-external-browser)
7821 (define-key map "G" 'w3m-goto-url-new-session)
7822 (define-key map "g" 'w3m-goto-url)
7823 (define-key map "T" 'w3m-toggle-inline-images)
7824 (define-key map "\M-T" 'w3m-turnoff-inline-images)
7825 (define-key map "t" 'w3m-toggle-inline-image)
7826 (when (w3m-display-graphic-p)
7827 (define-key map "\M-[" 'w3m-zoom-out-image)
7828 (define-key map "\M-]" 'w3m-zoom-in-image))
7829 (define-key map "U" 'w3m-goto-url)
7830 (define-key map "v" 'w3m-bookmark-view)
7831 (define-key map "V" 'w3m-bookmark-view-new-session)
7832 (define-key map "q" 'w3m-close-window)
7833 (define-key map "Q" 'w3m-quit)
7834 (define-key map "\M-n" 'w3m-copy-buffer)
7835 (define-key map "\M-s" 'w3m-session-select)
7836 (define-key map "\M-S" 'w3m-session-save)
7837 (define-key map "r" 'w3m-redisplay-this-page)
7838 (define-key map "R" 'w3m-reload-this-page)
7839 (define-key map "\C-tR" 'w3m-reload-all-pages)
7840 (define-key map "?" 'describe-mode)
7841 (define-key map "\M-a" 'w3m-bookmark-add-this-url)
7842 (define-key map "\M-k" 'w3m-cookie)
7843 (define-key map "a" 'w3m-bookmark-add-current-url)
7844 (define-key map "\C-ta" 'w3m-bookmark-add-all-urls)
7845 (define-key map "+" 'w3m-antenna-add-current-url)
7846 (define-key map "]" 'w3m-next-form)
7847 (define-key map "[" 'w3m-previous-form)
7848 (define-key map "}" 'w3m-next-image)
7849 (define-key map "{" 'w3m-previous-image)
7850 (define-key map "H" 'w3m-gohome)
7851 (define-key map "A" 'w3m-antenna)
7852 (define-key map "W" 'w3m-weather)
7853 (define-key map "S" 'w3m-search)
7854 (define-key map "D" 'w3m-dtree)
7855 (define-key map ">" 'w3m-scroll-left)
7856 (define-key map "<" 'w3m-scroll-right)
7857 (define-key map "." 'w3m-shift-left)
7858 (define-key map "," 'w3m-shift-right)
7859 (define-key map "\M-l" 'w3m-horizontal-recenter)
7860 (define-key map "\C-a" 'w3m-beginning-of-line)
7861 (define-key map "\C-e" 'w3m-end-of-line)
7862 (define-key map "\\" 'w3m-view-source)
7863 (define-key map "=" 'w3m-view-header)
7864 (define-key map "s" 'w3m-history)
7865 (define-key map "E" 'w3m-edit-current-url)
7866 (define-key map "e" 'w3m-edit-this-url)
7867 (define-key map "|" 'w3m-pipe-source)
7868 (define-key map "\C-c" w3m-ctl-c-map)
7869 (define-key map "C" w3m-redisplay-map)
7870 (define-key map "L" w3m-linknum-map)
7871 (setq w3m-lynx-like-map map)))
7872
7873 (defvar w3m-info-like-map nil
7874 "Info-like keymap used in emacs-w3m buffers.")
7875 ;; `C-t' is a prefix key reserved to commands that do something in all
7876 ;; emacs-w3m buffers. 2006-05-18
7877 (unless w3m-info-like-map
7878 (let ((map (make-keymap)))
7879 (suppress-keymap map)
7880 (define-key map [backspace] 'w3m-scroll-down-or-previous-url)
7881 (define-key map [delete] 'w3m-scroll-down-or-previous-url)
7882 (define-key map "\C-?" 'w3m-scroll-down-or-previous-url)
7883 (if (featurep 'xemacs)
7884 (define-key map [(shift space)] 'w3m-scroll-down-or-previous-url)
7885 (define-key map [?\S-\ ] 'w3m-scroll-down-or-previous-url))
7886 (define-key map "\t" 'w3m-next-anchor)
7887 (define-key map [tab] 'w3m-next-anchor)
7888 (define-key map [(shift tab)] 'w3m-previous-anchor)
7889 (define-key map [(shift iso-lefttab)] 'w3m-previous-anchor)
7890 (define-key map [backtab] 'w3m-previous-anchor)
7891 (define-key map "\M-\t" 'w3m-previous-anchor)
7892 (define-key map "\C-m" 'w3m-view-this-url)
7893 (define-key map [(shift return)] 'w3m-view-this-url-new-session)
7894 (define-key map [(shift kp-enter)] 'w3m-view-this-url-new-session)
7895 (if (featurep 'xemacs)
7896 (progn
7897 (define-key map [(button2)] 'w3m-mouse-view-this-url)
7898 (define-key map [(shift button2)]
7899 'w3m-mouse-view-this-url-new-session))
7900 (define-key map [mouse-2] 'w3m-mouse-view-this-url)
7901 ;; Support for mouse-1 on Emacs 22 and greater.
7902 (define-key map [follow-link] 'mouse-face)
7903 (define-key map [S-mouse-2] 'w3m-mouse-view-this-url-new-session))
7904 (cond ((featurep 'xemacs)
7905 (define-key map [(button3)] 'w3m-mouse-major-mode-menu))
7906 ;; Don't use [mouse-3], which gets submenus not working in GTK Emacs.
7907 ((featurep 'gtk)
7908 (define-key map [down-mouse-3] 'w3m-mouse-major-mode-menu)
7909 (define-key map [drag-mouse-3] 'undefined)
7910 (define-key map [mouse-3] 'undefined))
7911 (t
7912 (define-key map [mouse-3] 'w3m-mouse-major-mode-menu)))
7913 (define-key map " " 'w3m-scroll-up-or-next-url)
7914 (define-key map "a" 'w3m-bookmark-add-current-url)
7915 (define-key map "\C-ta" 'w3m-bookmark-add-all-urls)
7916 (define-key map "\M-a" 'w3m-bookmark-add-this-url)
7917 (define-key map "+" 'w3m-antenna-add-current-url)
7918 (define-key map "A" 'w3m-antenna)
7919 (define-key map "b" 'w3m-scroll-down-or-previous-url)
7920 (define-key map "!" 'w3m-redisplay-with-content-type)
7921 (define-key map "d" 'w3m-download)
7922 (define-key map "D" 'w3m-download-this-url)
7923 (define-key map "e" 'w3m-edit-current-url)
7924 (define-key map "E" 'w3m-edit-this-url)
7925 (define-key map "f" 'undefined) ;; reserved.
7926 (define-key map "g" 'w3m-goto-url)
7927 (define-key map "G" 'w3m-goto-url-new-session)
7928 (define-key map "h" 'describe-mode)
7929 (define-key map "H" 'w3m-gohome)
7930 (define-key map "i" (if (w3m-display-graphic-p)
7931 'w3m-toggle-inline-image
7932 'w3m-view-image))
7933 (define-key map "I" 'w3m-toggle-inline-images)
7934 (define-key map "\M-I" 'w3m-turnoff-inline-images)
7935 (when (w3m-display-graphic-p)
7936 (define-key map "\M-[" 'w3m-zoom-out-image)
7937 (define-key map "\M-]" 'w3m-zoom-in-image))
7938 (define-key map "\M-i" 'w3m-save-image)
7939 (define-key map "l" 'w3m-view-previous-page)
7940 (define-key map "\C-l" 'recenter)
7941 (define-key map [(control L)] 'w3m-reload-this-page)
7942 (define-key map [(control t) (control L)] 'w3m-reload-all-pages)
7943 (define-key map "M" 'w3m-view-url-with-external-browser)
7944 (define-key map "n" 'w3m-view-next-page)
7945 (define-key map "N" 'w3m-namazu)
7946 (define-key map "\M-n" 'w3m-copy-buffer)
7947 (define-key map "\M-k" 'w3m-cookie)
7948 (define-key map "\M-s" 'w3m-session-select)
7949 (define-key map "\M-S" 'w3m-session-save)
7950 (define-key map "o" 'w3m-history)
7951 (define-key map "O" 'w3m-db-history)
7952 (define-key map "p" 'w3m-view-previous-page)
7953 (define-key map "P" 'undecided) ;; reserved for print-this-buffer.
7954 (define-key map "q" 'w3m-close-window)
7955 (define-key map "Q" 'w3m-quit)
7956 (define-key map "r" 'w3m-redisplay-this-page)
7957 (define-key map "R" 'w3m-reload-this-page)
7958 (define-key map "\C-tR" 'w3m-reload-all-pages)
7959 (define-key map "s" 'w3m-search)
7960 (define-key map "S" 'w3m-search-new-session)
7961 (define-key map "T" 'w3m-dtree)
7962 (define-key map "u" 'w3m-view-parent-page)
7963 (define-key map "v" 'w3m-bookmark-view)
7964 (define-key map "V" 'w3m-bookmark-view-new-session)
7965 (define-key map "W" 'w3m-weather)
7966 (define-key map "y" 'w3m-print-current-url)
7967 (define-key map "Y" 'w3m-print-this-url)
7968 (define-key map "=" 'w3m-view-header)
7969 (define-key map "\\" 'w3m-view-source)
7970 (define-key map "?" 'describe-mode)
7971 (define-key map ">" 'w3m-scroll-left)
7972 (define-key map "<" 'w3m-scroll-right)
7973 (define-key map [(shift right)] 'w3m-shift-left)
7974 (define-key map [(shift left)] 'w3m-shift-right)
7975 (define-key map "\M-l" 'w3m-horizontal-recenter)
7976 (define-key map "\C-a" 'w3m-beginning-of-line)
7977 (define-key map "\C-e" 'w3m-end-of-line)
7978 (define-key map "." 'beginning-of-buffer)
7979 (define-key map "^" 'w3m-view-parent-page)
7980 (define-key map "]" 'w3m-next-form)
7981 (define-key map "[" 'w3m-previous-form)
7982 (define-key map "}" 'w3m-next-image)
7983 (define-key map "{" 'w3m-previous-image)
7984 (define-key map "|" 'w3m-pipe-source)
7985 (define-key map "\C-c" w3m-ctl-c-map)
7986 (define-key map "C" w3m-redisplay-map)
7987 (define-key map "L" w3m-linknum-map)
7988 (setq w3m-info-like-map map)))
7989
7990 (defun w3m-alive-p (&optional visible)
7991 "Return a buffer in which emacs-w3m is running.
7992 If there is no emacs-w3m session, return nil. If the optional VISIBLE
7993 is non-nil, a visible emacs-w3m buffer is preferred. The last visited
7994 emacs-w3m buffer is likely to return if VISIBLE is omitted or there is
7995 no visible buffer."
7996 (let* ((buffers (w3m-list-buffers t))
7997 (buf (car buffers)))
7998 (if visible
7999 (progn
8000 (setq visible nil)
8001 (while (and (not visible)
8002 buffers)
8003 (when (get-buffer-window (car buffers) t)
8004 (setq visible (car buffers)))
8005 (setq buffers (cdr buffers)))
8006 (or visible buf))
8007 buf)))
8008
8009 (defun w3m-quit (&optional force)
8010 "Return to a peaceful life (exiting all emacs-w3m sessions).
8011 This command lets you quit browsing web after updating the arrived
8012 URLs database. Quit browsing immediately if the prefix argument FORCE
8013 is specified, otherwise prompt you for the confirmation. See also
8014 `w3m-close-window'."
8015 (interactive "P")
8016 (let ((buffers (w3m-list-buffers t))
8017 (all-buffers (let ((w3m-fb-mode nil))
8018 (w3m-list-buffers t))))
8019 (if (or (= (length buffers) (length all-buffers))
8020 (prog1 (y-or-n-p "Kill emacs-w3m buffers on other frames? ")
8021 (message nil)))
8022 (let ((w3m-fb-mode nil))
8023 (when (or force
8024 (prog1 (y-or-n-p "Do you want to exit emacs-w3m? ")
8025 (message nil)))
8026 (w3m-session-automatic-save)
8027 (w3m-delete-frames-and-windows)
8028 (sit-for 0) ;; Delete frames seemingly fast.
8029 (dolist (buffer all-buffers)
8030 (w3m-cancel-refresh-timer buffer)
8031 (kill-buffer buffer)
8032 (when w3m-use-form
8033 (w3m-form-kill-buffer buffer)))
8034 (when w3m-use-form
8035 (w3m-form-textarea-file-cleanup))
8036 (w3m-select-buffer-close-window)
8037 (w3m-cache-shutdown)
8038 (w3m-arrived-shutdown)
8039 (w3m-process-shutdown)
8040 (when w3m-use-cookies
8041 (w3m-cookie-shutdown))
8042 (w3m-kill-all-buffer)))
8043 (w3m-session-automatic-save)
8044 (w3m-fb-delete-frame-buffers)
8045 (w3m-fb-select-buffer))))
8046
8047 (defun w3m-close-window ()
8048 "Return to a restless life (quitting all emacs-w3m sessions).
8049 This command closes all emacs-w3m windows, but all the emacs-w3m
8050 buffers remain. Frames created for emacs-w3m sessions will also be
8051 closed. See also `w3m-quit'."
8052 (interactive)
8053 (w3m-history-store-position)
8054 ;; `w3m-list-buffers' won't return all the emacs-w3m buffers if
8055 ;; `w3m-fb-mode' is turned on.
8056 (let* ((buffers (w3m-list-buffers t))
8057 (bufs buffers)
8058 buf windows window)
8059 (w3m-delete-frames-and-windows)
8060 (while bufs
8061 (setq buf (pop bufs))
8062 (w3m-cancel-refresh-timer buf)
8063 (bury-buffer buf))
8064 (while buffers
8065 (setq buf (pop buffers)
8066 windows (get-buffer-window-list buf 'no-minibuf t))
8067 (while windows
8068 (setq window (pop windows))
8069 (set-window-buffer
8070 window
8071 (w3m-static-if (featurep 'xemacs)
8072 (other-buffer buf (window-frame window) nil)
8073 (other-buffer buf nil (window-frame window)))))))
8074 (w3m-select-buffer-close-window)
8075 ;; The current-buffer and displayed buffer are not necessarily the
8076 ;; same at this point; if they aren't bury-buffer will be a nop, and
8077 ;; we will infloop.
8078 (set-buffer (window-buffer (selected-window)))
8079 (while (eq major-mode 'w3m-mode)
8080 (bury-buffer)))
8081
8082 (unless w3m-mode-map
8083 (setq w3m-mode-map
8084 (if (eq w3m-key-binding 'info)
8085 w3m-info-like-map
8086 w3m-lynx-like-map)))
8087
8088 (defun w3m-mouse-major-mode-menu (event)
8089 "Pop up a W3M mode-specific menu of mouse commands."
8090 (interactive "e")
8091 (mouse-set-point event)
8092 (let* ((bmkitems (if w3m-bookmark-mode
8093 (cdr w3m-bookmark-menu-items)
8094 (car w3m-bookmark-menu-items)))
8095 (bmkmenu (if w3m-bookmark-menu-items-pre
8096 `(,@bmkitems
8097 "----"
8098 ,@w3m-bookmark-menu-items-pre)
8099 bmkitems)))
8100 (w3m-static-if (featurep 'xemacs)
8101 (let (menubar)
8102 (when current-menubar
8103 (run-hooks 'activate-menubar-hook))
8104 (setq menubar
8105 (cons "w3m"
8106 (delq nil
8107 `(,@(cdr w3m-rmouse-menubar)
8108 "----"
8109 "----"
8110 ,(assoc "w3m" current-menubar)
8111 "----"
8112 ,(assoc "Bookmark" current-menubar)
8113 ,(assoc "Tab" current-menubar)
8114 ,(assoc "Session" current-menubar)))))
8115 (popup-menu menubar event))
8116 (run-hooks 'menu-bar-update-hook)
8117 (popup-menu (delete nil
8118 `(,@w3m-rmouse-menubar
8119 "----"
8120 "----"
8121 ,w3m-menubar
8122 "----"
8123 ,(cons "Bookmark" bmkmenu)
8124 ,(when w3m-tab-menubar-make-items-preitems
8125 (cons "Tab" w3m-tab-menubar-make-items-preitems))
8126 ,(cons "Session" (if w3m-session-menu-items-pre
8127 (append w3m-session-menu-items
8128 '("----")
8129 w3m-session-menu-items-pre)
8130 w3m-session-menu-items))))
8131 event))))
8132
8133 (defvar w3m-tab-button-menu-current-buffer nil
8134 "Internal variable used by `w3m-tab-button-menu'.")
8135
8136 (defvar w3m-tab-button-menu-commands
8137 (let ((manyp '(cdr (w3m-list-buffers)))
8138 (currentp 'w3m-tab-button-menu-current-buffer)
8139 (leftp '(and w3m-tab-button-menu-current-buffer
8140 (w3m-lefttab-exist-p w3m-tab-button-menu-current-buffer)))
8141 (rightp '(and w3m-tab-button-menu-current-buffer
8142 (w3m-righttab-exist-p
8143 w3m-tab-button-menu-current-buffer)))
8144 (many2p '(and w3m-tab-button-menu-current-buffer
8145 (cdr (w3m-list-buffers)))))
8146 `((w3m-goto-url-new-session
8147 ,(w3m-make-menu-item "\e$B?7$7$$%?%V\e(B" "New Tab")
8148 t ,w3m-new-session-in-background w3m-new-session-url)
8149 (w3m-copy-buffer
8150 ,(w3m-make-menu-item "\e$B%?%V$rJ#@=\e(B" "Copy Tab")
8151 ,currentp ,w3m-new-session-in-background)
8152 -
8153 (w3m-reload-this-page
8154 ,(w3m-make-menu-item "\e$B%?%V$r:FFI$_9~$_\e(B" "Reload Tab")
8155 ,currentp)
8156 (w3m-reload-all-pages
8157 ,(w3m-make-menu-item "\e$B$9$Y$F$N%?%V$r:FFI$_9~$_\e(B" "Reload All Tabs")
8158 ,manyp)
8159 -
8160 (w3m-delete-buffer
8161 ,(w3m-make-menu-item "\e$B$3$N%?%V$rJD$8$k\e(B" "Close This Tab")
8162 ,currentp)
8163 -
8164 (w3m-delete-other-buffers
8165 ,(w3m-make-menu-item "\e$BB>$N%?%V$r$9$Y$FJD$8$k\e(B" "Close Other Tabs")
8166 ,many2p)
8167 (w3m-delete-left-tabs
8168 ,(w3m-make-menu-item "\e$B:8B&$N%?%V$r$9$Y$FJD$8$k\e(B" "Close Left Tabs")
8169 ,leftp)
8170 (w3m-delete-right-tabs
8171 ,(w3m-make-menu-item "\e$B1&B&$N%?%V$r$9$Y$FJD$8$k\e(B" "Close Right Tabs")
8172 ,rightp)
8173 -
8174 (w3m-view-url-with-external-browser
8175 ,(w3m-make-menu-item "\e$B30It%V%i%&%6$G3+$/\e(B" "View with external browser")
8176 ,currentp ,w3m-new-session-in-background w3m-current-url)
8177 -
8178 (w3m-session-save
8179 ,(w3m-make-menu-item "\e$B$9$Y$F$N%?%V$rJ]B8$9$k\e(B" "Save All Tabs...")
8180 t)
8181 (w3m-session-select
8182 ,(w3m-make-menu-item "\e$B%?%V%j%9%H$rA*Br$9$k\e(B" "Select List of Tabs...")
8183 t)
8184 (w3m-bookmark-add-current-url
8185 ,(w3m-make-menu-item "\e$B$3$N%?%V$r%V%C%/%^!<%/\e(B" "Bookmark This Tab...")
8186 ,currentp ,w3m-new-session-in-background)
8187 (w3m-bookmark-add-all-urls
8188 ,(w3m-make-menu-item
8189 "\e$B$9$Y$F$N%?%V$r%V%C%/%^!<%/\e(B" "Bookmark All Tabs..." )
8190 ,manyp)))
8191 "List of commands invoked by the tab button menu.
8192 Each item is the symbol `-' which is a separator,
8193 or a list which consists of the following elements:
8194
8195 0: a function.
8196 1: a function description.
8197 2: a Lisp form which returns non-nil if the item is active.
8198 3: a flag specifying whether the buffer should be selected.
8199 &rest: arguments passed to the function.")
8200
8201 (w3m-static-unless (featurep 'xemacs)
8202 (easy-menu-define
8203 w3m-tab-button-menu w3m-tab-map "w3m tab button menu."
8204 (cons nil (w3m-make-menu-commands w3m-tab-button-menu-commands)))
8205
8206 ;; This function must be placed after `easy-menu-define'.
8207 (defun w3m-tab-button-menu (event buffer)
8208 (select-window (posn-window (event-start event)))
8209 (setq w3m-tab-button-menu-current-buffer buffer)
8210 (popup-menu w3m-tab-button-menu))
8211
8212 (defun w3m-tab-button-menu2 (event buffer)
8213 (select-window (posn-window (event-start event)))
8214 (setq w3m-tab-button-menu-current-buffer nil)
8215 (popup-menu w3m-tab-button-menu)))
8216
8217 (unless w3m-link-map
8218 (setq w3m-link-map (make-sparse-keymap))
8219 (cond ((featurep 'xemacs)
8220 (define-key w3m-link-map [(button3)] 'w3m-link-menu))
8221 ;; Don't use [mouse-3], which gets submenus not working in GTK Emacs.
8222 ((featurep 'gtk)
8223 (define-key w3m-link-map [down-mouse-3] 'w3m-link-menu)
8224 (define-key w3m-link-map [drag-mouse-3] 'undefined)
8225 (define-key w3m-link-map [mouse-3] 'undefined))
8226 (t
8227 (define-key w3m-link-map [mouse-3] 'w3m-link-menu))))
8228
8229 (easy-menu-define w3m-link-menu w3m-link-map "w3m link menu."
8230 `("Link" ;; This cannot be omitted for at least MacOS.
8231 [,(w3m-make-menu-item "\e$B%j%s%/$r$3$N%;%C%7%g%s$G3+$/\e(B"
8232 "Open Link in This Session")
8233 w3m-view-this-url (w3m-anchor (point))]
8234 [,(w3m-make-menu-item "\e$B%j%s%/$r?7$7$$%;%C%7%g%s$G3+$/\e(B"
8235 "Open Link in New Session")
8236 w3m-view-this-url-new-session (w3m-anchor (point))]
8237 [,(w3m-make-menu-item "\e$B%j%s%/$r30It%V%i%&%6$G3+$/\e(B"
8238 "Open Link in an External Browser")
8239 w3m-external-view-this-url (w3m-anchor (point))]
8240 "-"
8241 [,(w3m-make-menu-item "\e$B$3$N%j%s%/$r%V%C%/%^!<%/\e(B..."
8242 "Bookmark This Link...")
8243 w3m-bookmark-add-this-url (w3m-anchor (point))]
8244 [,(w3m-make-menu-item "\e$BL>A0$rIU$1$F%j%s%/@h$rJ]B8\e(B..."
8245 "Save Link As...")
8246 w3m-download-this-url (w3m-anchor (point))]
8247 [,(w3m-make-menu-item "\e$BL>A0$rIU$1$F2hA|$rJ]B8\e(B..."
8248 "Save Image As...")
8249 w3m-download-this-image (w3m-image (point))]
8250 [,(w3m-make-menu-item "\e$B%j%s%/$N\e(B URL \e$B$r%3%T!<\e(B"
8251 "Copy Link Location")
8252 w3m-print-this-url (w3m-anchor (point))]
8253 [,(w3m-make-menu-item "\e$B2hA|$N\e(B URL \e$B$r%3%T!<\e(B"
8254 "Copy Image Location")
8255 w3m-print-this-image-url (w3m-image (point))]))
8256
8257 (defun w3m-link-menu (event)
8258 "Pop up a link menu."
8259 (interactive "e")
8260 (mouse-set-point event)
8261 (popup-menu w3m-link-menu))
8262
8263 (defvar w3m-buffer-unseen nil)
8264 (make-variable-buffer-local 'w3m-buffer-unseen)
8265
8266 (defun w3m-set-buffer-unseen (&optional url)
8267 (setq w3m-buffer-unseen t)
8268 (w3m-add-local-hook 'pre-command-hook 'w3m-set-buffer-seen))
8269
8270 (defun w3m-set-buffer-seen ()
8271 (setq w3m-buffer-unseen nil)
8272 (w3m-remove-local-hook 'pre-command-hook 'w3m-set-buffer-seen))
8273
8274 (defun w3m-move-unseen-buffer ()
8275 "Move to the next unseen buffer."
8276 (interactive)
8277 (when (eq major-mode 'w3m-mode)
8278 (let* ((bufs (w3m-list-buffers))
8279 (right (memq (current-buffer) bufs))
8280 unseen)
8281 (setq unseen
8282 (catch 'unseen
8283 (dolist (buf (append right bufs))
8284 (when (w3m-unseen-buffer-p buf)
8285 (throw 'unseen buf)))))
8286 (if (not unseen)
8287 (message "No unseen buffer.")
8288 (switch-to-buffer unseen)
8289 (run-hooks 'w3m-select-buffer-hook)
8290 (w3m-select-buffer-update)))))
8291
8292 (defun w3m-mode ()
8293 "Major mode for browsing web.
8294
8295 \\<w3m-mode-map>\
8296 \\[w3m-view-this-url] Display the page pointed to by the link under point.
8297 You may use the prefix arg `2' or\
8298 `\\[universal-argument] \\<universal-argument-map>\
8299 \\[universal-argument-more]\\<w3m-mode-map>' to make a new session.
8300 \\[w3m-mouse-view-this-url] Follow the link under the mouse pointer.
8301 If w3m-use-form is t, `\\[w3m-view-this-url]' and\
8302 `\\[w3m-mouse-view-this-url]' enable you to enter forms.
8303 You may use the prefix arg `2' or\
8304 `\\[universal-argument] \\<universal-argument-map>\
8305 \\[universal-argument-more]\\<w3m-mode-map>' to make a new session.
8306 \\[w3m-view-this-url-new-session] Display the page of the link\
8307 in a new session.
8308 If the region is active, visit all the links within the region.
8309 \\[w3m-mouse-view-this-url-new-session] Display the page of the link\
8310 in a new session by mouse.
8311
8312 \\[w3m-submit-form] Submit the form at point.
8313
8314 \\[w3m-reload-this-page] Reload the current page.
8315 \\[w3m-reload-all-pages] Reload all the pages.
8316 \\[w3m-redisplay-this-page] Redisplay the current page.
8317 \\[w3m-redisplay-with-content-type] Redisplay the page, specifying\
8318 a content type.
8319 \\[w3m-redisplay-with-charset] Redisplay the current page, specifying\
8320 a charset.
8321 \\[w3m-redisplay-and-reset] Redisplay the current page and reset\
8322 the user-specified charset and\n\tcontent type.
8323
8324 \\[w3m-next-anchor] Move the point to the next anchor.
8325 \\[w3m-previous-anchor] Move the point to the previous anchor.
8326 \\[w3m-go-to-linknum] Move the point to the numbered anchor.
8327 \\[w3m-next-form] Move the point to the next form.
8328 \\[w3m-previous-form] Move the point to the previous form.
8329 \\[w3m-next-image] Move the point to the next image.
8330 \\[w3m-previous-image] Move the point to the previous image.
8331
8332 \\[w3m-view-previous-page] Move back to the previous page in the history.
8333 \\[w3m-view-next-page] Move forward to the next page in the history.
8334 \\[w3m-view-parent-page] Attempt to move to the parent directory of\
8335 the page.
8336
8337 \\[w3m-goto-url] Visit the web page.
8338 \\[w3m-goto-url-new-session] Visit the web page in a new session.
8339 \\[w3m-gohome] Go to the Home page.
8340 \\[w3m-view-url-with-external-browser] Display the current page using the\
8341 external browser.
8342
8343 \\[w3m-download] Download the URL.
8344 \\[w3m-download-this-url] Download the URL under point.
8345
8346 \\[w3m-view-image] Display the image under point in the external viewer.
8347 \\[w3m-save-image] Save the image under point to a file.
8348 \\[w3m-toggle-inline-images] Toggle the visibility of all images.
8349 \\[w3m-turnoff-inline-images] Turn off to display all images.
8350 \\[w3m-zoom-out-image] Zoom in an image on the point.
8351 \\[w3m-zoom-in-image] Zoom out an image on the point.
8352
8353 \\[w3m-print-this-url] Display the url under point and put it into\
8354 `kill-ring'.
8355 \\[w3m-print-current-url] Display the url of the current page and put\
8356 it into `kill-ring'.
8357
8358 \\[w3m-view-source] Display the html source of the current page.
8359 \\[w3m-view-header] Display the header of the current page.
8360 \\[w3m-edit-current-url] Edit the local file displayed as the current\
8361 page.
8362 \\[w3m-edit-this-url] Edit the local file which is pointed to by URL under\
8363 point.
8364
8365 \\[w3m-scroll-up-or-next-url] Scroll up the current window, or go to the\
8366 next page.
8367 \\[w3m-scroll-down-or-previous-url] Scroll down the current window, or\
8368 go to the previous page.
8369 \\[w3m-scroll-left] Scroll to the left.
8370 \\[w3m-scroll-right] Scroll to the right.
8371 \\[w3m-shift-left] Shift to the left.
8372 \\[w3m-shift-right] Shift to the right.
8373 \\[w3m-horizontal-recenter] Recenter horizontally.
8374 \\[w3m-beginning-of-line] Go to the entire beginning of line, may be\
8375 accompanied by scrolling.
8376 \\[w3m-end-of-line] Go to the entire end of line, may be accompanied\
8377 by scrolling.
8378
8379 \\[next-line] Next line.
8380 \\[previous-line] Previous line.
8381 \\[forward-char] Forward char.
8382 \\[backward-char] Backward char.
8383
8384 \\[goto-line] Go to the line, specifying the line number (beginning with 1).
8385 \\[w3m-history-store-position] Mark the current position.
8386 \\[w3m-history-restore-position] Go to the last marked position.
8387
8388 \\[w3m-history] Display the history of pages you have visited in the\
8389 session.
8390 If it is called with the prefix arg, it displays the arrived URLs.
8391 \\[w3m-antenna] Display the report of changes in web pages.
8392 If it is called with the prefix arg, it updates the report.
8393 \\[w3m-antenna-add-current-url] Add the current url to the antenna database.
8394 \\[w3m-search] Query to the search engine a word.
8395 To change the server, give any prefix argument to the command.
8396 \\[w3m-search-new-session] Query to the search engine a word in a new session.
8397 To change the server, give any prefix argument to the command.
8398 \\[w3m-weather] Display a weather report.
8399 To change the local area, give any prefix argument to the command.
8400 \\[w3m-dtree] Display a directory tree.
8401 If the prefix arg is given, display files in addition to directories.
8402 \\[w3m-namazu] Search files with Namazu.
8403 To change the index, give any prefix argument to the command.
8404
8405 \\[w3m-bookmark-view] Display the bookmark.
8406 \\[w3m-bookmark-view-new-session] Display the bookmark on a new session.
8407 \\[w3m-bookmark-add-current-url] Add a url of the current page to\
8408 the bookmark.
8409 If the prefix arg is given, the user will be prompted for the url.
8410 \\[w3m-bookmark-add-all-urls] Add urls of all pages being visited to\
8411 the bookmark.
8412 \\[w3m-bookmark-add-this-url] Add the url under point to the bookmark.
8413
8414 \\[w3m-copy-buffer] Create a copy of the current page as a new session.
8415 \\[w3m-next-buffer] Turn the page of emacs-w3m buffers ahead.
8416 \\[w3m-previous-buffer] Turn the page of emacs-w3m buffers behind.
8417 \\[w3m-select-buffer] Pop to the emacs-w3m buffers selection window up.
8418 \\[w3m-switch-buffer] Select one of emacs-w3m buffers at the current window.
8419 \\[w3m-delete-buffer] Delete the current emacs-w3m buffer.
8420 \\[w3m-delete-other-buffers] Delete emacs-w3m buffers except for the\
8421 current buffer.
8422
8423 \\[w3m] Start browsing web with emacs-w3m.
8424 \\[w3m-close-window] Close all emacs-w3m windows, without deleteing\
8425 buffers.
8426 \\[w3m-quit] Exit browsing web. All emacs-w3m buffers will be deleted.
8427
8428 \\[describe-mode] describe-mode.
8429
8430 \\[report-emacs-w3m-bug] Send a bug report to the emacs-w3m team.
8431 "
8432 (kill-all-local-variables)
8433 (buffer-disable-undo)
8434 (setq major-mode 'w3m-mode)
8435 (setq mode-name "w3m")
8436 (use-local-map w3m-mode-map)
8437 (setq truncate-lines t
8438 w3m-display-inline-images w3m-default-display-inline-images)
8439 (when w3m-auto-show
8440 (when (boundp 'auto-hscroll-mode)
8441 (set (make-local-variable 'auto-hscroll-mode) nil))
8442 (when (boundp 'automatic-hscrolling)
8443 (set (make-local-variable 'automatic-hscrolling) nil))
8444 (when (boundp 'auto-show-mode)
8445 (set (make-local-variable 'auto-show-mode) nil))
8446 (when (boundp 'hscroll-mode)
8447 (set (make-local-variable 'hscroll-mode) nil)))
8448 (make-local-variable 'list-buffers-directory)
8449 (w3m-static-unless (featurep 'xemacs)
8450 (setq show-trailing-whitespace nil))
8451 (w3m-setup-toolbar)
8452 (w3m-setup-menu)
8453 (run-hooks 'w3m-mode-setup-functions)
8454 (w3m-run-mode-hooks 'w3m-mode-hook))
8455
8456 (defun w3m-scroll-up-1 (&optional arg)
8457 "Scroll the current window up ARG line.
8458 ARG will be fixed into 1 when this function is called interactively.
8459 This function avoids the bug that Emacs 21.x hangs up when scrolling
8460 up for too many number of lines if `scroll-margin' is set as two or
8461 greater."
8462 (interactive '(1))
8463 (w3m-static-unless (featurep 'xemacs)
8464 (when (and (numberp arg)
8465 (> arg 0)
8466 (numberp scroll-margin)
8467 (> scroll-margin 0))
8468 (setq arg (min arg
8469 (max 0 (- (count-lines (window-start) (point-max))
8470 scroll-margin))))))
8471 (scroll-up arg))
8472
8473 (defun w3m-scroll-up-or-next-url (arg)
8474 "Scroll the current window up ARG lines, or go to the next page."
8475 (interactive "P")
8476 (if (w3m-image-page-displayed-p)
8477 (image-scroll-up arg)
8478 (w3m-keep-region-active)
8479 (if (pos-visible-in-window-p (point-max))
8480 (if w3m-next-url
8481 (let ((w3m-prefer-cache t))
8482 (w3m-goto-url w3m-next-url))
8483 (signal 'end-of-buffer nil))
8484 (w3m-scroll-up-1 arg))))
8485
8486 (defun w3m-scroll-down-or-previous-url (arg)
8487 "Scroll the current window down ARG lines, or go to the previous page."
8488 (interactive "P")
8489 (if (w3m-image-page-displayed-p)
8490 (image-scroll-down arg)
8491 (w3m-keep-region-active)
8492 (if (pos-visible-in-window-p (point-min))
8493 (if w3m-previous-url
8494 (let ((w3m-prefer-cache t))
8495 (w3m-goto-url w3m-previous-url))
8496 (signal 'beginning-of-buffer nil))
8497 (scroll-down arg))))
8498
8499 (defvar w3m-current-longest-line nil
8500 "The length of the longest line in the window.")
8501
8502 (defun w3m-set-current-longest-line ()
8503 "Set the value of `w3m-current-longest-line'."
8504 (save-excursion
8505 (goto-char (window-start))
8506 (end-of-line)
8507 (setq w3m-current-longest-line 0)
8508 ;; The XEmacs version of `window-end' returns the point beyond
8509 ;; `point-max' if it is visible in the window.
8510 (let ((end (min (window-end) (point-max))))
8511 (while (progn
8512 (skip-chars-backward " ")
8513 (setq w3m-current-longest-line
8514 (max w3m-current-longest-line (current-column)))
8515 (end-of-line 2)
8516 (< (point) end))))))
8517
8518 (defun w3m-scroll-left (arg)
8519 "Scroll to the left.
8520 If ARG (the prefix) is a number, scroll the window ARG columns.
8521 Otherwise, it defaults to `w3m-horizontal-scroll-columns'."
8522 (interactive "P")
8523 (when (if (memq last-command '(w3m-scroll-left w3m-shift-left))
8524 (or (< (window-hscroll) w3m-current-longest-line)
8525 (progn (ding) nil))
8526 (w3m-set-current-longest-line)
8527 (< (window-hscroll) w3m-current-longest-line))
8528 (w3m-horizontal-scroll 'left (if arg
8529 (prefix-numeric-value arg)
8530 w3m-horizontal-scroll-columns))))
8531
8532 (defun w3m-scroll-right (arg)
8533 "Scroll to the right.
8534 If ARG (the prefix) is a number, scroll the window ARG columns.
8535 Otherwise, it defaults to `w3m-horizontal-scroll-columns'."
8536 (interactive "P")
8537 (if (zerop (window-hscroll))
8538 (when (memq last-command '(w3m-scroll-right w3m-shift-right))
8539 (ding))
8540 (w3m-horizontal-scroll 'right (if arg
8541 (prefix-numeric-value arg)
8542 w3m-horizontal-scroll-columns))))
8543
8544 (defun w3m-shift-left (arg)
8545 "Shift to the left. Shift means a fine level horizontal scrolling.
8546 If ARG (the prefix) is a number, scroll the window ARG columns.
8547 Otherwise, it defaults to `w3m-horizontal-shift-columns'."
8548 (interactive "P")
8549 (if (w3m-image-page-displayed-p)
8550 (image-forward-hscroll (or arg 1))
8551 (when (if (memq last-command '(w3m-scroll-left w3m-shift-left))
8552 (or (< (window-hscroll) w3m-current-longest-line)
8553 (progn (ding) nil))
8554 (w3m-set-current-longest-line)
8555 (< (window-hscroll) w3m-current-longest-line))
8556 (w3m-horizontal-scroll 'left (if arg
8557 (prefix-numeric-value arg)
8558 w3m-horizontal-shift-columns)))))
8559
8560 (defun w3m-shift-right (arg)
8561 "Shift to the right. Shift means a fine level horizontal scrolling.
8562 If ARG (the prefix) is a number, scroll the window ARG columns.
8563 Otherwise, it defaults to `w3m-horizontal-shift-columns'."
8564 (interactive "P")
8565 (if (w3m-image-page-displayed-p)
8566 (image-backward-hscroll (or arg 1))
8567 (if (zerop (window-hscroll))
8568 (when (memq last-command '(w3m-scroll-right w3m-shift-right))
8569 (ding))
8570 (w3m-horizontal-scroll 'right (if arg
8571 (prefix-numeric-value arg)
8572 w3m-horizontal-shift-columns)))))
8573
8574 (defvar w3m-horizontal-scroll-done nil)
8575 (make-variable-buffer-local 'w3m-horizontal-scroll-done)
8576 (defvar w3m-current-position '(-1 0 0))
8577 (make-variable-buffer-local 'w3m-current-position)
8578
8579 (defun w3m-auto-show ()
8580 "Scroll horizontally so that the point is visible."
8581 (when (and truncate-lines
8582 w3m-auto-show
8583 (not w3m-horizontal-scroll-done)
8584 (not (and (eq last-command this-command)
8585 (or (eq (point) (point-min))
8586 (eq (point) (point-max)))))
8587 (or (memq this-command '(beginning-of-buffer end-of-buffer))
8588 (and (symbolp this-command)
8589 (string-match "\\`i?search-" (symbol-name this-command)))
8590 (and (markerp (nth 1 w3m-current-position))
8591 (markerp (nth 2 w3m-current-position))
8592 (>= (point)
8593 (marker-position (nth 1 w3m-current-position)))
8594 (<= (point)
8595 (marker-position (nth 2 w3m-current-position))))))
8596 (w3m-horizontal-on-screen))
8597 (setq w3m-horizontal-scroll-done nil))
8598
8599 ;; Ailiases to meet XEmacs bugs?
8600 (eval-and-compile
8601 (unless (fboundp 'w3m-window-hscroll)
8602 (defalias 'w3m-window-hscroll 'window-hscroll))
8603 (unless (fboundp 'w3m-current-column)
8604 (defalias 'w3m-current-column 'current-column))
8605 (unless (fboundp 'w3m-set-window-hscroll)
8606 (defalias 'w3m-set-window-hscroll 'set-window-hscroll)))
8607
8608 (defun w3m-horizontal-scroll (direction ncol)
8609 "Scroll the window NCOL columns horizontally to DIRECTION.
8610 DIRECTON should be the symbol `left' which specifies to scroll to the
8611 left, or any other Lisp object meaning to scroll to the right. NCOL
8612 should be a number. This function is a subroutine called by the
8613 commands `w3m-scroll-left', `w3m-scroll-right', `w3m-shift-left' and
8614 `w3m-shift-right'."
8615 (setq w3m-horizontal-scroll-done t)
8616 (let ((inhibit-point-motion-hooks t))
8617 (w3m-set-window-hscroll (selected-window)
8618 (max 0
8619 (+ (w3m-window-hscroll)
8620 (if (eq direction 'left) ncol (- ncol)))))
8621 (let ((hs (w3m-window-hscroll)))
8622 (unless (and (>= (- (current-column) hs) 0)
8623 (< (- (current-column) hs) (window-width)))
8624 (move-to-column (if (eq direction 'left) hs
8625 (+ hs (window-width)
8626 (w3m-static-if (featurep 'xemacs) -3 -2))))))))
8627
8628 (defun w3m-horizontal-on-screen ()
8629 "Scroll the window horizontally so that the current position is visible.
8630 See the documentation for the `w3m-horizontal-scroll-division' variable
8631 for details."
8632 (when w3m-auto-show
8633 (setq w3m-horizontal-scroll-done t)
8634 (let ((cc (w3m-current-column))
8635 (hs (w3m-window-hscroll))
8636 (ww (window-width))
8637 (inhibit-point-motion-hooks t))
8638 (unless (and (>= (- cc hs) 0)
8639 (< (+ (- cc hs) (if (eolp)
8640 0
8641 (w3m-static-if (featurep 'xemacs)
8642 3 2))) ;; '$$'
8643 ww))
8644 (w3m-set-window-hscroll
8645 (selected-window)
8646 (max 0 (- cc (if (> hs cc)
8647 (/ ww w3m-horizontal-scroll-division)
8648 (* (/ ww w3m-horizontal-scroll-division)
8649 (1- w3m-horizontal-scroll-division))))))))))
8650
8651 (defun w3m-horizontal-recenter (&optional arg)
8652 "Recenter horizontally. With ARG, put the point on the column ARG.
8653 If `truncate-lines' is nil, it does nothing besides resetting the
8654 window's hscroll."
8655 (interactive "P")
8656 (if truncate-lines
8657 (progn
8658 (cond ((< (w3m-current-column) (window-hscroll))
8659 (move-to-column (w3m-window-hscroll))
8660 (setq arg 0))
8661 ((>= (w3m-current-column) (+ (window-hscroll) (window-width)))
8662 (move-to-column (+ (w3m-window-hscroll) (window-width) -2))
8663 (setq arg -1))
8664 ((listp arg)
8665 (setq arg (car arg))))
8666 (w3m-set-window-hscroll
8667 (selected-window)
8668 (if (numberp arg)
8669 (if (>= arg 0)
8670 (max (- (current-column) arg) 0)
8671 (let* ((home (point))
8672 (inhibit-point-motion-hooks t)
8673 (maxcolumn (prog2
8674 (end-of-line)
8675 (1- (current-column))
8676 (goto-char home))))
8677 (max (min (- (current-column)
8678 (window-width)
8679 arg
8680 -2)
8681 maxcolumn)
8682 0)))
8683 (max (- (current-column) (/ (window-width) 2) -1)
8684 0))))
8685 (set-window-hscroll (selected-window) 0)))
8686
8687 (defun w3m-recenter ()
8688 "Recenter according to `w3m-view-recenter'."
8689 (when (and w3m-view-recenter
8690 (eq (window-buffer) (current-buffer)))
8691 (recenter (if (eq t w3m-view-recenter)
8692 '(4) ;; per "C-u C-l" to recenter in middle
8693 w3m-view-recenter)))) ;; otherwise an integer
8694
8695 (defun w3m-beginning-of-line (&optional arg)
8696 "Make the beginning of the line visible and move the point to there."
8697 (interactive "P")
8698 (if (w3m-image-page-displayed-p)
8699 (image-bol (or arg 1))
8700 (w3m-keep-region-active)
8701 (when (listp arg)
8702 (setq arg (car arg)))
8703 (set-window-hscroll (selected-window) 0)
8704 (beginning-of-line arg)))
8705
8706 (defun w3m-end-of-line (&optional arg)
8707 "Move the point to the end of the line and scroll the window left.
8708 It makes the ends of upper and lower three lines visible. If
8709 `truncate-lines' is nil, it works identically as `end-of-line'."
8710 (interactive "P")
8711 (if (w3m-image-page-displayed-p)
8712 (image-eol (or arg 1))
8713 (w3m-keep-region-active)
8714 (if truncate-lines
8715 (progn
8716 (when (listp arg)
8717 (setq arg (car arg)))
8718 (forward-line (1- (or arg 1)))
8719 (let ((inhibit-point-motion-hooks t)
8720 home)
8721 (end-of-line)
8722 (setq home (point)
8723 arg (current-column))
8724 (dolist (n '(-3 -2 -1 1 2 3))
8725 (forward-line n)
8726 (end-of-line)
8727 (setq arg (max (current-column) arg))
8728 (goto-char home)))
8729 (setq temporary-goal-column arg
8730 this-command 'next-line)
8731 (w3m-set-window-hscroll (selected-window)
8732 (max (- arg (window-width) -2) 0)))
8733 (set-window-hscroll (selected-window) 0)
8734 (end-of-line arg))))
8735
8736 (defun w3m-pattern-uri-replace (uri format)
8737 "Create a new uri from URI matched by last search according to FORMAT."
8738 (replace-match format nil nil uri))
8739
8740 (defun w3m-uri-replace (uri)
8741 "Return the converted URI according to `w3m-uri-replace-alist'."
8742 (catch 'found-replacement
8743 (dolist (elem w3m-uri-replace-alist uri)
8744 (when (string-match (car elem) uri)
8745 (if (setq uri
8746 (cond
8747 ((consp (cdr elem))
8748 (apply (cadr elem) uri (cddr elem)))
8749 ;; Rest conditions are inserted in order to keep
8750 ;; backward compatibility.
8751 ((functionp (cdr elem))
8752 (funcall (cdr elem) uri))
8753 ((stringp (cdr elem))
8754 (w3m-pattern-uri-replace uri (cdr elem)))))
8755 (throw 'found-replacement uri)
8756 (error "Invalid replacement: %s" elem))))))
8757
8758 (defun w3m-goto-mailto-url (url &optional post-data)
8759 (let ((before (nreverse (buffer-list)))
8760 comp info buffers buffer function)
8761 (save-window-excursion
8762 (if (and (symbolp w3m-mailto-url-function)
8763 (fboundp w3m-mailto-url-function))
8764 (funcall w3m-mailto-url-function url)
8765 ;; Require `mail-user-agent' setting
8766 (unless (and (boundp 'mail-user-agent)
8767 (symbol-value 'mail-user-agent))
8768 (error "You must specify the valid value to `mail-user-agent'"))
8769 (unless (and (setq comp (get (symbol-value 'mail-user-agent)
8770 'composefunc))
8771 (fboundp comp))
8772 (error "No function to compose a mail in `%s'"
8773 (symbol-value 'mail-user-agent)))
8774 ;; Use rfc2368.el if exist.
8775 ;; rfc2368.el is written by Sen Nagata.
8776 ;; You can find it in "contrib" directory of Mew package
8777 ;; or in "utils" directory of Wanderlust package.
8778 (if (or (featurep 'rfc2368)
8779 (condition-case nil (require 'rfc2368) (error nil)))
8780 (progn
8781 (setq info (rfc2368-parse-mailto-url url))
8782 (apply comp
8783 (append (mapcar (lambda (x)
8784 (cdr (assoc x info)))
8785 '("To" "Subject"))
8786 (if post-data
8787 (list
8788 (list (cons
8789 "body"
8790 (or (and
8791 (consp post-data)
8792 (concat (car post-data) "\n"))
8793 (concat post-data "\n")))))))))
8794 ;; without rfc2368.el.
8795 (string-match ":\\([^?]+\\)" url)
8796 (funcall comp (match-string 1 url)))))
8797 (setq buffers (nreverse (buffer-list)))
8798 (save-current-buffer
8799 (while buffers
8800 (setq buffer (car buffers)
8801 buffers (cdr buffers))
8802 (unless (memq buffer before)
8803 (set-buffer buffer)
8804 (when (setq function
8805 (cdr (assq major-mode
8806 w3m-mailto-url-popup-function-alist)))
8807 (setq buffers nil)))))
8808 (when function
8809 (let (special-display-buffer-names
8810 special-display-regexps
8811 same-window-buffer-names
8812 same-window-regexps)
8813 (funcall function buffer)))))
8814
8815 (defun w3m-convert-ftp-url-for-emacsen (url)
8816 (or (and (string-match "^ftp://?\\([^/@]+@\\)?\\([^/]+\\)\\(?:/~/\\)?" url)
8817 (concat "/"
8818 (if (match-beginning 1)
8819 (substring url (match-beginning 1) (match-end 1))
8820 "anonymous@")
8821 (substring url (match-beginning 2) (match-end 2))
8822 ":"
8823 (substring url (match-end 2))))
8824 (error "URL is strange")))
8825
8826 (defun w3m-file-directory-p (file)
8827 "Emulate the `file-directory-p' function for the remote file FILE."
8828 (when (file-exists-p file)
8829 (let (dirp (i 10))
8830 (catch 'loop
8831 (while (> i 0)
8832 (setq dirp (car (file-attributes file)))
8833 (if (stringp dirp)
8834 (setq file (expand-file-name
8835 dirp
8836 (file-name-directory (directory-file-name file)))
8837 i (1- i))
8838 (throw 'loop dirp)))))))
8839
8840 (defun w3m-goto-ftp-url (url &optional filename)
8841 "Copy a remote file to the local system or run dired for ftp URLs.
8842 If URL looks like a file, it will perform the copy. Otherwise, it
8843 will run `dired-other-window' using `ange-ftp' or `efs'. Optional
8844 FILENAME specifies the name of a local file. If FILENAME is omitted,
8845 this function will prompt user for it."
8846 (let ((ftp (w3m-convert-ftp-url-for-emacsen url))
8847 file)
8848 (if (or (string-equal "/" (substring ftp -1))
8849 ;; `file-directory-p' takes a long time for remote files.
8850 ;; `file-directory-p' returns t in Emacsen, anytime.
8851 (w3m-file-directory-p ftp))
8852 (dired-other-window ftp)
8853 (setq file (file-name-nondirectory ftp))
8854 (unless filename
8855 (setq filename (w3m-read-file-name nil nil file)))
8856 (unless (file-writable-p (file-name-directory filename))
8857 (error "Permission denied, %s" (file-name-directory filename)))
8858 (when (or (not (file-exists-p filename))
8859 (if (file-writable-p filename)
8860 (and (prog1
8861 (y-or-n-p
8862 (format "File(%s) already exists. Overwrite? "
8863 filename))
8864 (message nil))
8865 (progn
8866 (delete-file filename)
8867 t))
8868 (error "Permission denied, %s" filename)))
8869 (copy-file ftp filename)
8870 (message "Wrote %s" filename)))))
8871
8872 (unless w3m-doc-view-map
8873 (setq w3m-doc-view-map (make-sparse-keymap))
8874 (define-key w3m-doc-view-map "q" 'w3m-doc-view-quit))
8875
8876 (defun w3m-doc-view (url)
8877 "View PDF/PostScript/DVI files using `doc-view-mode'.
8878 `w3m-pop-up-windows' and `w3m-pop-up-frames' control how the document
8879 window turns up."
8880 (let* ((basename (file-name-nondirectory (w3m-url-strip-query url)))
8881 (regexp (concat "\\`" (regexp-quote basename) "\\(?:<[0-9]+>\\)?\\'"))
8882 (buffers (buffer-list))
8883 buffer data case-fold-search)
8884 (save-current-buffer
8885 (while buffers
8886 (setq buffer (pop buffers))
8887 (if (and (string-match regexp (buffer-name buffer))
8888 (progn
8889 (set-buffer buffer)
8890 (eq major-mode 'doc-view-mode))
8891 (equal buffer-file-name url))
8892 (setq buffers nil)
8893 (setq buffer nil))))
8894 (unless (prog1
8895 buffer
8896 (unless buffer
8897 (setq buffer (generate-new-buffer basename)
8898 data (buffer-string)))
8899 (let ((pop-up-windows w3m-pop-up-windows)
8900 (pop-up-frames w3m-pop-up-frames))
8901 (pop-to-buffer buffer)))
8902 (set-buffer-multibyte nil)
8903 (insert data)
8904 (set-buffer-modified-p nil)
8905 (setq buffer-file-name url)
8906 (doc-view-mode)
8907 (use-local-map w3m-doc-view-map)
8908 (set-keymap-parent w3m-doc-view-map doc-view-mode-map)
8909 'internal-view)))
8910
8911 (defun w3m-doc-view-quit (&optional kill)
8912 "Quit the `doc-view-mode' window that emacs-w3m launches.
8913 With the prefix argument KILL, kill the buffer."
8914 (interactive "P")
8915 (cond (w3m-pop-up-frames
8916 (when (prog1 (one-window-p t) (quit-window kill))
8917 (delete-frame (selected-frame))))
8918 (w3m-pop-up-windows
8919 (if (fboundp 'quit-window)
8920 (quit-window kill)
8921 (if kill
8922 (progn
8923 (set-buffer-modified-p nil)
8924 (kill-buffer (current-buffer)))
8925 (bury-buffer)))
8926 (unless (eq (next-window nil 'no-mini) (selected-window))
8927 (delete-window)))))
8928
8929 (eval-and-compile
8930 (unless (fboundp 'w3m-add-local-hook)
8931 ;; Silence the byte compiler; `w3m-add-local-hook' will be defined
8932 ;; in w3m-ems.el for GNU Emacs.
8933 (eval-when-compile
8934 (when (eq 'byte-compile-obsolete (get 'make-local-hook 'byte-compile))
8935 (put 'make-local-hook 'byte-compile nil)
8936 (put 'make-local-hook 'byte-obsolete-info nil)))
8937 (defun w3m-add-local-hook (hook function &optional append)
8938 "Add to the buffer-local value of HOOK the function FUNCTION.
8939 This function is designed for XEmacs."
8940 (make-local-hook hook)
8941 (add-hook hook function append t))
8942 (defun w3m-remove-local-hook (hook function)
8943 "Remove to the buffer-local value of HOOK the function FUNCTION.
8944 This function is designed for XEmacs."
8945 (remove-hook hook function t))))
8946
8947 (defun w3m-store-current-position ()
8948 "Memorize the current positions whenever every command starts.
8949 The value will be held in the `w3m-current-position' variable. This
8950 function is designed as the hook function which is registered to
8951 `pre-command-hook' by `w3m-buffer-setup'."
8952 (setq w3m-current-position (list (point)
8953 (copy-marker (point-at-bol))
8954 (copy-marker (point-at-eol)))))
8955
8956 (defun w3m-check-current-position ()
8957 "Run `w3m-after-cursor-move-hook' if the point gets away from the window.
8958 This function is designed as the hook function which is registered to
8959 `post-command-hook' by `w3m-buffer-setup'."
8960 (when (/= (point) (car w3m-current-position))
8961 ;; To bind `deactivate-mark' to nil protects the mark from being
8962 ;; deactivated. `deactivate-mark' is set when any function modifies
8963 ;; a buffer, and it causes the deactivation of the mark.
8964 (let ((deactivate-mark nil))
8965 (run-hooks 'w3m-after-cursor-move-hook))))
8966
8967 (defun w3m-buffer-setup ()
8968 "Generate a new buffer, select it and set it up for emacs-w3m.
8969 When the current buffer has already been prepared, it won't bother to
8970 generate a new buffer."
8971 (unless (eq major-mode 'w3m-mode)
8972 (let ((buffer (w3m-alive-p t)))
8973 (if buffer
8974 (set-buffer buffer)
8975 (set-buffer (w3m-generate-new-buffer "*w3m*"))
8976 (w3m-mode))))
8977 ;; It may have been set to nil for viewing a page source or a header.
8978 (setq truncate-lines t)
8979 (w3m-add-local-hook 'pre-command-hook 'w3m-store-current-position)
8980 (w3m-add-local-hook 'post-command-hook 'w3m-check-current-position)
8981 (w3m-initialize-graphic-icons)
8982 (setq mode-line-buffer-identification
8983 `(,@(w3m-static-if (featurep 'xemacs)
8984 (list (cons modeline-buffer-id-right-extent "%b") " ")
8985 (nconc (propertized-buffer-identification "%b") '(" ")))
8986 (w3m-current-process
8987 w3m-modeline-process-status-on
8988 (w3m-current-ssl
8989 (w3m-display-inline-images
8990 w3m-modeline-ssl-image-status-on
8991 w3m-modeline-ssl-status-off)
8992 (w3m-display-inline-images
8993 w3m-modeline-image-status-on
8994 w3m-modeline-status-off)))
8995 (w3m-show-graphic-icons-in-mode-line
8996 (w3m-use-favicon
8997 (w3m-favicon-image
8998 w3m-modeline-favicon
8999 w3m-modeline-separator)
9000 w3m-modeline-separator)
9001 w3m-modeline-separator)
9002 (w3m-current-process
9003 "Loading..." ,(if (fboundp 'format-mode-line)
9004 '(:eval (w3m-modeline-title))
9005 (if w3m-use-title-buffer-name
9006 ""
9007 'w3m-current-title)))))
9008 (unless (assq 'w3m-current-process mode-line-process)
9009 (setq mode-line-process
9010 (cons (list 'w3m-current-process 'w3m-process-modeline-string)
9011 mode-line-process))))
9012
9013 (defvar w3m-modeline-title-string nil
9014 "Internal variable used to keep contents to be shown in the mode line.
9015 This is a buffer-local variable.")
9016 (make-variable-buffer-local 'w3m-modeline-title-string)
9017
9018 (defvar w3m-modeline-title-timer nil
9019 "Say time has not gone by after the mode line was updated last time.
9020 It is used to control the `w3m-modeline-title' function running too
9021 frequently, set by the function itself and cleared by a timer.")
9022 (make-variable-buffer-local 'w3m-modeline-title-timer)
9023
9024 (eval-when-compile
9025 (unless (fboundp 'format-mode-line)
9026 (defalias 'format-mode-line 'ignore)))
9027
9028 (defun w3m-modeline-title ()
9029 "Return a truncated title not to cut the right end of the mode line.
9030 It currently works only with Emacs 22 and newer."
9031 (if w3m-use-title-buffer-name
9032 ""
9033 (when w3m-current-title
9034 (or (and w3m-modeline-title-timer w3m-modeline-title-string)
9035 (prog2
9036 (setq w3m-modeline-title-string w3m-current-title
9037 w3m-modeline-title-timer t)
9038 (let ((excess (- (string-width
9039 (condition-case nil
9040 (format-mode-line mode-line-format 1)
9041 (error "")))
9042 (window-width)))
9043 (tlen (string-width w3m-current-title)))
9044 (when (and (> excess 0)
9045 (> tlen 3))
9046 (setq w3m-modeline-title-string
9047 (concat (w3m-replace-in-string
9048 (w3m-truncate-string
9049 w3m-current-title (max (- tlen excess 3) 2))
9050 "[\t ]+\\'" "")
9051 "...")))
9052 w3m-modeline-title-string)
9053 (run-at-time 0.5 nil
9054 (lambda (buffer)
9055 (when (buffer-live-p buffer)
9056 (with-current-buffer buffer
9057 (setq w3m-modeline-title-timer nil))))
9058 (current-buffer)))))))
9059
9060 (defconst w3m-buffer-local-url "buffer://")
9061 (defun w3m-buffer-local-url-p (url)
9062 (save-match-data
9063 (string-match (concat "^" w3m-buffer-local-url) url)))
9064
9065 ;;;###autoload
9066 (defun w3m-goto-url (url &optional reload charset post-data referer handler
9067 element no-popup)
9068 "Visit World Wide Web pages. This is the primitive function of `w3m'.
9069 If the second argument RELOAD is non-nil, reload a content of URL.
9070 Except that if it is 'redisplay, re-display the page without reloading.
9071 The third argument CHARSET specifies a charset to be used for decoding
9072 a content.
9073 The fourth argument POST-DATA should be a string or a cons cell. If
9074 it is a string, it makes this function request a body as if the
9075 content-type is \"x-www-form-urlencoded\". If it is a cons cell, the
9076 car of a cell is used as the content-type and the cdr of a cell is
9077 used as the body.
9078 If the fifth argument REFERER is specified, it is used for a Referer:
9079 field for this request.
9080 The remaining HANDLER, ELEMENT[1], and NO-POPUP are for the
9081 internal operations of emacs-w3m.
9082 You can also use \"quicksearch\" url schemes such as \"gg:emacs\" which
9083 would search for the term \"emacs\" with the Google search engine. See
9084 the `w3m-search' function and the variable `w3m-uri-replace-alist'.
9085
9086 \[1] A note for the developers: ELEMENT is a history element which has
9087 already been registered in the `w3m-history-flat' variable. It is
9088 corresponding to URL to be retrieved at this time, not for the url of
9089 the current page."
9090 (interactive
9091 (list (w3m-input-url nil nil nil nil 'feeling-lucky)
9092 current-prefix-arg
9093 (w3m-static-if (fboundp 'universal-coding-system-argument)
9094 coding-system-for-read)))
9095 (when (and (stringp url)
9096 (not (interactive-p)))
9097 (setq url (w3m-canonicalize-url url)))
9098 (set-text-properties 0 (length url) nil url)
9099 (setq url (w3m-uri-replace url))
9100 (unless (or (w3m-url-local-p url)
9101 (string-match "\\`about:" url))
9102 (w3m-string-match-url-components url)
9103 (setq url (concat (w3m-url-transfer-encode-string
9104 (substring url 0 (match-beginning 8))
9105 (or w3m-current-coding-system
9106 w3m-default-coding-system))
9107 (if (match-beginning 8)
9108 (concat "#" (match-string 9 url))
9109 ""))))
9110 (cond
9111 ;; process mailto: protocol
9112 ((string-match "\\`mailto:" url)
9113 (w3m-goto-mailto-url url post-data))
9114 ;; process ftp: protocol
9115 ((and w3m-use-ange-ftp
9116 (string-match "\\`ftps?://" url)
9117 (not (string= "text/html" (w3m-local-content-type url))))
9118 (w3m-goto-ftp-url url))
9119 ;; find-file directly
9120 ((condition-case nil
9121 (and (w3m-url-local-p url)
9122 w3m-local-find-file-function
9123 (let ((base-url (w3m-url-strip-fragment url))
9124 (match (car w3m-local-find-file-regexps))
9125 nomatch file)
9126 (and (or (not match)
9127 (string-match match base-url))
9128 (not (and (setq nomatch (cdr w3m-local-find-file-regexps))
9129 (string-match nomatch base-url)))
9130 (setq file (w3m-url-to-file-name base-url))
9131 (file-exists-p file)
9132 (not (file-directory-p file))
9133 (prog1
9134 t
9135 (funcall (if (functionp w3m-local-find-file-function)
9136 w3m-local-find-file-function
9137 (eval w3m-local-find-file-function))
9138 file)))))
9139 (error nil)))
9140 ;; process buffer-local url
9141 ((w3m-buffer-local-url-p url)
9142 (let (file-part fragment-part)
9143 (w3m-string-match-url-components url)
9144 (setq file-part (concat (match-string 4 url)
9145 (match-string 5 url))
9146 fragment-part (match-string 9 url))
9147 (cond
9148 ((and (string= file-part "")
9149 fragment-part)
9150 (w3m-search-name-anchor fragment-part))
9151 ((not (string= file-part ""))
9152 (w3m-goto-url (w3m-expand-url (substring url (match-beginning 4))
9153 (concat "file://" default-directory))
9154 reload charset post-data referer handler element))
9155 (t (w3m-message "No URL at point")))))
9156 ((w3m-url-valid url)
9157 (w3m-buffer-setup) ; Setup buffer.
9158 (w3m-arrived-setup) ; Setup arrived database.
9159 (unless no-popup
9160 (w3m-popup-buffer (current-buffer)))
9161 (w3m-cancel-refresh-timer (current-buffer))
9162 (when w3m-current-process
9163 (error "%s"
9164 (substitute-command-keys "
9165 Cannot run two w3m processes simultaneously \
9166 \(Type `\\<w3m-mode-map>\\[w3m-process-stop]' to stop asynchronous process)")))
9167 (w3m-process-stop (current-buffer)) ; Stop all processes retrieving images.
9168 (w3m-idle-images-show-unqueue (current-buffer))
9169 ;; Store the current position in the history structure if and only
9170 ;; if this command is called interactively. The other user commands
9171 ;; that calls this function want to store the position by themselves.
9172 (when (interactive-p)
9173 (w3m-history-store-position))
9174 ;; Access url group
9175 (if (string-match "\\`group:" url)
9176 (let ((urls (mapcar 'w3m-url-decode-string
9177 (split-string (substring url (match-end 0)) "&")))
9178 (w3m-async-exec (and w3m-async-exec-with-many-urls
9179 w3m-async-exec)))
9180 (w3m-process-do
9181 (type (prog1
9182 (w3m-goto-url (car urls))
9183 (dolist (url (cdr urls))
9184 (save-window-excursion
9185 (with-current-buffer (w3m-copy-buffer nil nil nil
9186 'empty)
9187 (w3m-goto-url url))))))
9188 type))
9189 ;; Retrieve the page.
9190 (lexical-let ((orig url)
9191 (url (w3m-url-strip-authinfo url))
9192 (reload (and (not (eq reload 'redisplay)) reload))
9193 (redisplay (eq reload 'redisplay))
9194 (charset charset)
9195 (post-data post-data)
9196 (referer referer)
9197 (name)
9198 (history-position (get-text-property (point)
9199 'history-position))
9200 (reuse-history w3m-history-reuse-history-elements))
9201 (when w3m-current-forms
9202 ;; Store the current forms in the history structure.
9203 (w3m-history-plist-put :forms w3m-current-forms))
9204 (let ((w3m-current-buffer (current-buffer)))
9205 (unless element
9206 (setq element
9207 (if (and (equal referer "about://history/")
9208 history-position)
9209 (w3m-history-element history-position t)
9210 (if w3m-history-reuse-history-elements
9211 (w3m-history-assoc url)))))
9212 ;; Set current forms using the history structure.
9213 (when (setq w3m-current-forms
9214 (when (and (not reload) ; If reloading, ignore history.
9215 (null post-data) ; If post, ignore history.
9216 (or (w3m-cache-available-p url)
9217 (w3m-url-local-p url)))
9218 ;; Don't use `w3m-history-plist-get' here.
9219 (plist-get (nthcdr 3 element) :forms)))
9220 ;; Mark that the form is from history structure.
9221 (setq w3m-current-forms (cons t w3m-current-forms)))
9222 (when (and post-data element)
9223 ;; Remove processing url's forms from the history structure.
9224 (w3m-history-set-plist (cadr element) :forms nil))
9225 ;; local directory URL check
9226 (when (and (w3m-url-local-p url)
9227 (file-directory-p (w3m-url-to-file-name url))
9228 (setq url (file-name-as-directory url))
9229 (eq w3m-local-directory-view-method 'w3m-dtree)
9230 (string-match "\\`file:///" url))
9231 (setq url (replace-match "about://dtree/" nil nil url)
9232 orig url))
9233 ;; Split body and fragments.
9234 (w3m-string-match-url-components url)
9235 (and (match-beginning 8)
9236 (setq name (match-string 9 url)
9237 url (substring url 0 (match-beginning 8))))
9238 (when (w3m-url-local-p url)
9239 (unless (string-match "[^\000-\177]" url)
9240 (setq url (w3m-url-decode-string url))))
9241 (w3m-process-do
9242 (action
9243 (if (and (not reload)
9244 (not redisplay)
9245 (stringp w3m-current-url)
9246 (string= url w3m-current-url))
9247 (progn
9248 (w3m-refontify-anchor)
9249 'cursor-moved)
9250 (when w3m-name-anchor-from-hist
9251 (w3m-history-plist-put
9252 :name-anchor-hist
9253 (append (list 1 nil)
9254 (and (integerp (car w3m-name-anchor-from-hist))
9255 (nthcdr (1+ (car w3m-name-anchor-from-hist))
9256 w3m-name-anchor-from-hist)))))
9257 (setq w3m-name-anchor-from-hist
9258 (plist-get (nthcdr 3 element) :name-anchor-hist))
9259 (setq w3m-current-process
9260 (w3m-retrieve-and-render orig reload charset
9261 post-data referer handler))))
9262 (with-current-buffer w3m-current-buffer
9263 (setq w3m-current-process nil)
9264 (if (not action)
9265 (progn
9266 (w3m-history-push w3m-current-url
9267 (list :title (or w3m-current-title
9268 "<no-title>")))
9269 (goto-char (point-min)))
9270 (when (and name
9271 (progn
9272 ;; Redisplay to search an anchor sure.
9273 (sit-for 0)
9274 (w3m-search-name-anchor
9275 (w3m-url-transfer-encode-string
9276 name
9277 (or w3m-current-coding-system
9278 w3m-default-coding-system))
9279 nil (not (eq action 'cursor-moved)))))
9280 (setf (w3m-arrived-time (w3m-url-strip-authinfo orig))
9281 (w3m-arrived-time url)))
9282 (unless (eq action 'cursor-moved)
9283 (if (equal referer "about://history/")
9284 ;; Don't sprout a new branch for the existing history
9285 ;; element.
9286 (let ((w3m-history-reuse-history-elements t))
9287 (w3m-history-push w3m-current-url
9288 (list :title w3m-current-title))
9289 ;; Fix the history position pointers.
9290 (when history-position
9291 (setcar w3m-history
9292 (w3m-history-regenerate-pointers
9293 history-position))))
9294 (let ((w3m-history-reuse-history-elements reuse-history)
9295 (position (when (eq 'reload reuse-history)
9296 (cadar w3m-history))))
9297 (w3m-history-push w3m-current-url
9298 (list :title w3m-current-title))
9299 (when position
9300 (w3m-history-set-current position))))
9301 (w3m-history-add-properties (list :referer referer
9302 :post-data post-data))
9303 (unless w3m-toggle-inline-images-permanently
9304 (setq w3m-display-inline-images
9305 w3m-default-display-inline-images))
9306 (when (and w3m-use-form reload)
9307 (w3m-form-textarea-files-remove))
9308 (cond ((w3m-display-inline-images-p)
9309 (and w3m-force-redisplay (sit-for 0))
9310 (w3m-toggle-inline-images 'force reload))
9311 ((and (w3m-display-graphic-p)
9312 (eq action 'image-page))
9313 (and w3m-force-redisplay (sit-for 0))
9314 (w3m-toggle-inline-image 'force reload)))))
9315 (setq buffer-read-only t)
9316 (set-buffer-modified-p nil)
9317 (setq list-buffers-directory w3m-current-title)
9318 ;; must be `w3m-current-url'
9319 (setq default-directory (w3m-current-directory w3m-current-url))
9320 (w3m-buffer-name-add-title)
9321 (w3m-update-toolbar)
9322 (w3m-select-buffer-update)
9323 (let ((real-url (if (w3m-arrived-p url)
9324 (or (w3m-real-url url) url)
9325 url)))
9326 (run-hook-with-args 'w3m-display-functions real-url)
9327 (run-hook-with-args 'w3m-display-hook real-url))
9328 (w3m-session-crash-recovery-save)
9329 (when (and w3m-current-url
9330 (stringp w3m-current-url)
9331 (or (string-match
9332 "\\`about://\\(?:header\\|source\\)/"
9333 w3m-current-url)
9334 (equal (w3m-content-type w3m-current-url)
9335 "text/plain")))
9336 (setq truncate-lines nil))
9337 ;; restore position must call after hooks for localcgi.
9338 (when (or reload redisplay)
9339 (w3m-history-restore-position))
9340 (w3m-set-buffer-unseen)
9341 (w3m-refresh-at-time)))))))
9342 (t (w3m-message "Invalid URL: %s" url))))
9343
9344 (defun w3m-current-directory (url)
9345 "Return a directory used as the current directory in a page visiting URL.
9346 See `w3m-default-directory'."
9347 (or (and url
9348 (stringp url)
9349 (let (file)
9350 (if (string-match "\\`ftp://" url)
9351 (progn
9352 (setq file (w3m-convert-ftp-url-for-emacsen url))
9353 (file-name-as-directory
9354 (if (string-match "/\\`" file)
9355 file
9356 (file-name-directory file))))
9357 (and (setq file (w3m-url-to-file-name url))
9358 (file-exists-p file)
9359 (file-name-as-directory
9360 (if (file-directory-p file)
9361 file
9362 (file-name-directory file)))))))
9363 (let (directory)
9364 (file-name-as-directory
9365 (or (and (stringp w3m-default-directory)
9366 (file-directory-p w3m-default-directory)
9367 (expand-file-name w3m-default-directory))
9368 (and (symbolp w3m-default-directory)
9369 (boundp w3m-default-directory)
9370 (setq directory (symbol-value w3m-default-directory))
9371 (stringp directory)
9372 (file-directory-p directory)
9373 (expand-file-name directory))
9374 (and (functionp w3m-default-directory)
9375 (stringp (setq directory
9376 (condition-case nil
9377 (funcall w3m-default-directory url)
9378 (error nil))))
9379 (file-directory-p directory)
9380 (expand-file-name directory))
9381 w3m-profile-directory)))))
9382
9383 (defun w3m-refresh-at-time ()
9384 (when (and w3m-use-refresh w3m-current-refresh)
9385 (if (= (car w3m-current-refresh) 0)
9386 (w3m-goto-url-with-timer (cdr w3m-current-refresh) (current-buffer))
9387 (setq w3m-refresh-timer
9388 (run-at-time (car w3m-current-refresh)
9389 nil
9390 'w3m-goto-url-with-timer
9391 (cdr w3m-current-refresh)
9392 (current-buffer))))))
9393
9394 (defun w3m-goto-url-with-timer (url buffer)
9395 "Run the `w3m-goto-url' function by the refresh timer."
9396 (when (and (w3m-url-valid url) buffer (get-buffer buffer))
9397 (cond
9398 ((get-buffer-window buffer)
9399 (save-selected-window
9400 (pop-to-buffer buffer)
9401 (with-current-buffer buffer
9402 (w3m-cancel-refresh-timer buffer)
9403 (if (and w3m-current-url
9404 (string= url w3m-current-url))
9405 (w3m-reload-this-page t)
9406 (w3m-goto-url url)))))
9407 ((buffer-live-p buffer)
9408 (let* ((cwin (selected-window))
9409 (cbuf (window-buffer cwin)))
9410 (with-current-buffer buffer
9411 (w3m-cancel-refresh-timer buffer)
9412 (if (and w3m-current-url
9413 (string= url w3m-current-url))
9414 (w3m-reload-this-page t t)
9415 (w3m-goto-url url nil
9416 nil nil nil nil nil t)))
9417 (set-window-buffer cwin cbuf)))
9418 (t
9419 (with-current-buffer buffer
9420 (w3m-cancel-refresh-timer buffer))))))
9421
9422 (defun w3m-goto-new-session-url (&optional reload)
9423 "Open `w3m-new-session-url' in a new session."
9424 (interactive "P")
9425 (if (not (eq major-mode 'w3m-mode))
9426 (message "This command can be used in w3m mode only")
9427 (w3m-view-this-url-1 w3m-new-session-url reload 'new-session)))
9428
9429 ;;;###autoload
9430 (defun w3m-goto-url-new-session (url &optional reload charset post-data
9431 referer)
9432 "Visit World Wide Web pages in a new session.
9433 If you invoke this command in the emacs-w3m buffer, the new session
9434 will be created by copying the current session. Otherwise, the new
9435 session will start afresh."
9436 (interactive
9437 (list (w3m-input-url nil nil nil nil 'feeling-lucky)
9438 current-prefix-arg
9439 (w3m-static-if (fboundp 'universal-coding-system-argument)
9440 coding-system-for-read)
9441 nil ;; post-data
9442 nil)) ;; referer
9443 (let (buffer)
9444 (if (or (eq 'w3m-mode major-mode)
9445 (and (setq buffer (w3m-alive-p))
9446 (progn
9447 (w3m-popup-buffer buffer)
9448 t)))
9449 (progn
9450 ;; Store the current position in the history structure.
9451 (w3m-history-store-position)
9452 (switch-to-buffer (setq buffer
9453 (w3m-copy-buffer nil nil
9454 w3m-new-session-in-background
9455 'empty)))
9456 (w3m-display-progress-message url)
9457 (w3m-goto-url url
9458 (or reload
9459 ;; When new URL has `name' portion, we have to
9460 ;; goto the base url because generated buffer
9461 ;; has no content at this moment.
9462 (and (progn
9463 (w3m-string-match-url-components url)
9464 (match-beginning 8))
9465 'redisplay))
9466 charset post-data referer)
9467 ;; Delete useless newly created buffer if it is empty.
9468 (w3m-delete-buffer-if-empty buffer))
9469 (w3m-goto-url url))))
9470
9471 (defun w3m-move-point-for-localcgi (url)
9472 (when (and (w3m-url-local-p url)
9473 (file-directory-p (w3m-url-to-file-name url))
9474 (not (eq w3m-local-directory-view-method 'w3m-dtree))
9475 (= (point-min) (point))
9476 (w3m-search-name-anchor "current" 'quiet))
9477 (recenter (/ (window-height) 5))))
9478
9479 ;;;###autoload
9480 (defun w3m-gohome ()
9481 "Go to the Home page."
9482 (interactive)
9483 (unless w3m-home-page
9484 (error "You have to specify the value of `w3m-home-page'"))
9485 (w3m-goto-url w3m-home-page))
9486
9487 (defun w3m-reload-this-page (&optional arg no-popup)
9488 "Reload the current page, disregarding the cached contents.
9489 If the prefix arg ARG is given, it also clears forms and post data."
9490 (interactive "P")
9491 (if w3m-current-url
9492 (let ((w3m-history-reuse-history-elements
9493 ;; Don't move the history position.
9494 'reload)
9495 post-data)
9496 (if arg
9497 (progn
9498 (w3m-history-remove-properties '(:forms nil :post-data nil))
9499 (setq w3m-current-forms nil))
9500 (when (and (setq post-data (w3m-history-plist-get :post-data))
9501 (not (y-or-n-p "Repost form data? ")))
9502 (setq post-data nil)))
9503 (w3m-history-store-position)
9504 (w3m-goto-url w3m-current-url 'reload nil post-data
9505 (w3m-history-plist-get :referer)
9506 nil
9507 (w3m-history-element (cadar w3m-history) t)
9508 no-popup)
9509 (w3m-history-restore-position))
9510 (w3m-message "Can't reload this page")))
9511
9512 (defun w3m-reload-all-pages (&optional arg)
9513 "Reload all pages, disregarding the cached contents.
9514 If the prefix arg ARG is given, it also clears forms and post data."
9515 (interactive "P")
9516 (if arg
9517 (save-window-excursion
9518 (dolist (buffer (w3m-list-buffers))
9519 (switch-to-buffer buffer)
9520 (w3m-reload-this-page)))
9521 (dolist (buffer (w3m-list-buffers))
9522 (save-window-excursion
9523 (switch-to-buffer buffer)
9524 (w3m-reload-this-page)))))
9525
9526 (defun w3m-redisplay-this-page (&optional arg)
9527 "Redisplay the current page.
9528 If the prefix arg ARG is given, it toggles the visibility of images."
9529 (interactive "P")
9530 (if (null w3m-current-url)
9531 (w3m-message "Can't redisplay this page")
9532 (when arg
9533 (setq w3m-display-inline-images (not w3m-display-inline-images)))
9534 (let ((w3m-prefer-cache t)
9535 (w3m-history-reuse-history-elements
9536 ;; Don't move the history position.
9537 'reload))
9538 (w3m-history-store-position)
9539 (w3m-goto-url w3m-current-url 'redisplay)
9540 (w3m-history-restore-position))))
9541
9542 (defun w3m-redisplay-and-reset (&optional arg)
9543 "Redisplay the current page and reset the user-specified values.
9544 This function clears the charset and the content type which the user
9545 specified for overriding the values of what the page requires. The
9546 prefix argument ARG is passed to the `w3m-redisplay-this-page'
9547 function (which see)."
9548 (interactive "P")
9549 (if (null w3m-current-url)
9550 (w3m-message "Can't execute this page")
9551 (setf (w3m-arrived-content-type w3m-current-url) nil)
9552 (setf (w3m-arrived-content-charset
9553 (if (string-match "\\`about://source/" w3m-current-url)
9554 (substring w3m-current-url (match-end 0))
9555 w3m-current-url))
9556 nil)
9557 (w3m-redisplay-this-page arg)))
9558
9559 (defun w3m-redisplay-with-charset (&optional arg)
9560 "Redisplay the current page, specifying a charset.
9561 If the user enters the empty string, the value which once was used for
9562 decoding the page is used. The prefix argument ARG is passed to the
9563 `w3m-redisplay-this-page' function (which see)."
9564 (interactive "P")
9565 (if (null w3m-current-url)
9566 (w3m-message "Can't execute the command")
9567 (setf (w3m-arrived-content-charset
9568 (if (string-match "\\`about://source/" w3m-current-url)
9569 (substring w3m-current-url (match-end 0))
9570 w3m-current-url))
9571 (w3m-read-content-charset
9572 (format "Content-charset (current %s, default reset): "
9573 w3m-current-coding-system)))
9574 (w3m-redisplay-this-page arg)))
9575
9576 (defun w3m-redisplay-with-content-type (&optional arg)
9577 "Redisplay the current page, specifying a content type.
9578 If the user enters the empty string, it uses the value which was
9579 specified by the page's contents itself. The prefix argument ARG is
9580 passed to the `w3m-redisplay-this-page' function (which see)."
9581 (interactive "P")
9582 (if (null w3m-current-url)
9583 (w3m-message "Can't execute this page")
9584 (setf (w3m-arrived-content-type w3m-current-url)
9585 (let ((type (completing-read
9586 (format "Content-type (current %s, default reset): "
9587 (or (w3m-arrived-content-type w3m-current-url)
9588 (w3m-content-type w3m-current-url)))
9589 w3m-content-type-alist nil t)))
9590 (unless (string= type "") type)))
9591 (w3m-redisplay-this-page arg)))
9592
9593 (defun w3m-examine-command-line-args ()
9594 "Return a url when the `w3m' command is invoked from the command line.
9595 The `w3m' Lisp command can be invoked even in the batch mode, e.g.,
9596 ``emacs -f w3m'' or ``emacs -f w3m url''. This function is used in
9597 the very case, it extracts a url string from the command line
9598 arguments and passes it to the `w3m' command. If a url is omitted, it
9599 defaults to the value of `w3m-home-page' or \"about:\"."
9600 (let ((url (car command-line-args-left))
9601 (directives '("-f" "-funcall" "--funcall" "-e"))
9602 args)
9603 (if (and url (not (string-match "\\`-" url)))
9604 (progn
9605 (setq command-line-args-left (cdr command-line-args-left))
9606 (when (string-match "\\`[\t ]*\\'" url)
9607 ;; emacs -f w3m '' ...
9608 (setq url (or w3m-home-page "about:"))))
9609 (setq args (nthcdr (max (- (length command-line-args)
9610 (length command-line-args-left)
9611 2)
9612 1)
9613 command-line-args))
9614 (when (and (equal (cadr args) "w3m")
9615 (member (car args) directives))
9616 (setq url (or w3m-home-page "about:"))))
9617 (unless
9618 (and command-line-args-left
9619 (progn
9620 (setq args (reverse command-line-args-left))
9621 (while (and args
9622 (not (and (setq args (cdr (member "w3m" args)))
9623 (member (car args) directives)))))
9624 args))
9625 (defalias 'w3m-examine-command-line-args (lambda nil)))
9626 ;; Inhibit the startup screen.
9627 (when (and url
9628 ;; Since XEmacs provides `inhibit-startup-message' as
9629 ;; a constant, we don't modify the value.
9630 (not (featurep 'xemacs)))
9631 (let ((var (cond ((boundp 'inhibit-startup-screen)
9632 'inhibit-startup-screen)
9633 ((boundp 'inhibit-startup-message)
9634 'inhibit-startup-message)))
9635 fn)
9636 (when (and var
9637 (not (symbol-value var)))
9638 (set var t)
9639 (setq fn (make-symbol "w3m-inhibit-startup-screen"))
9640 (fset fn `(lambda nil
9641 (set ',var nil)
9642 (remove-hook 'window-setup-hook ',fn)
9643 (fmakunbound ',fn)))
9644 (add-hook 'window-setup-hook fn))))
9645 url))
9646
9647 ;;;###autoload
9648 (defun w3m (&optional url new-session interactive-p)
9649 "Visit World Wide Web pages using the external w3m command.
9650
9651 When you invoke this command interactively for the first time, it will
9652 visit a page which is pointed to by a string like url around the
9653 cursor position or the home page specified by the `w3m-home-page'
9654 variable, but you will be prompted for a URL if `w3m-quick-start' is
9655 nil (default t) or `w3m-home-page' is nil.
9656
9657 The variables `w3m-pop-up-windows' and `w3m-pop-up-frames' control
9658 whether this command should pop to a window or a frame up for the
9659 session.
9660
9661 When emacs-w3m sessions have already been opened, this command will
9662 pop to the existing window or frame up, but if `w3m-quick-start' is
9663 nil, \(default t), you will be prompted for a URL (which defaults to
9664 `popup' meaning to pop to an existing emacs-w3m buffer up).
9665
9666 In addition, if the prefix argument is given or you enter the empty
9667 string for the prompt, it will visit the home page specified by the
9668 `w3m-home-page' variable or the \"about:\" page.
9669
9670 You can also run this command in the batch mode as follows:
9671
9672 emacs -f w3m http://emacs-w3m.namazu.org/ &
9673
9674 In that case, or if this command is called non-interactively, the
9675 variables `w3m-pop-up-windows' and `w3m-pop-up-frames' will be ignored
9676 \(treated as nil) and it will run emacs-w3m at the current (or the
9677 initial) window.
9678
9679 If the optional NEW-SESSION is non-nil, this function makes a new
9680 emacs-w3m buffer. Besides that, it also makes a new emacs-w3m buffer
9681 if `w3m-make-new-session' is non-nil and a user specifies a url string.
9682
9683 The optional INTERACTIVE-P is for the internal use; it is mainly used
9684 to check whether Emacs 22 or later calls this function as an
9685 interactive command in the batch mode."
9686 (interactive
9687 (let ((url
9688 ;; Emacs 22 or later calls a Lisp command interactively even
9689 ;; if it is in the batch mode. If the following function
9690 ;; returns non-nil value, it means this function is called in
9691 ;; the batch mode, and we don't treat it as what it is called
9692 ;; to interactively.
9693 (w3m-examine-command-line-args))
9694 new)
9695 (list
9696 ;; url
9697 (or url
9698 (let ((default (if (w3m-alive-p) 'popup w3m-home-page)))
9699 (setq new (if current-prefix-arg
9700 default
9701 (w3m-input-url nil nil default w3m-quick-start
9702 'feeling-lucky)))))
9703 ;; new-session
9704 (and w3m-make-new-session
9705 (w3m-alive-p)
9706 (not (eq new 'popup)))
9707 ;; interactive-p
9708 (not url))))
9709 (let ((nofetch (eq url 'popup))
9710 (alived (w3m-alive-p))
9711 (buffer (unless new-session (w3m-alive-p t)))
9712 (w3m-pop-up-frames (and interactive-p w3m-pop-up-frames))
9713 (w3m-pop-up-windows (and interactive-p w3m-pop-up-windows)))
9714 (unless (and (stringp url)
9715 (> (length url) 0))
9716 (if buffer
9717 (setq nofetch t)
9718 ;; This command was possibly be called non-interactively or as
9719 ;; the batch mode.
9720 (setq url (or (w3m-examine-command-line-args)
9721 ;; Unlikely but this function was called with no url.
9722 "about:")
9723 nofetch nil)))
9724 (unless buffer
9725 ;; It means `new-session' is non-nil or there's no emacs-w3m buffer.
9726 ;; At any rate, we create a new emacs-w3m buffer in this case.
9727 (with-current-buffer (setq buffer (w3m-generate-new-buffer "*w3m*"))
9728 (w3m-mode)))
9729 (w3m-popup-buffer buffer)
9730 (unless nofetch
9731 ;; `unwind-protect' is needed since a process may be terminated by C-g.
9732 (unwind-protect
9733 (let* ((crash (and (not alived)
9734 (w3m-session-last-crashed-session)))
9735 (last (and (not alived)
9736 (not crash)
9737 (w3m-session-last-autosave-session))))
9738 (w3m-goto-url url)
9739 (when (or crash last)
9740 (w3m-session-goto-session (or crash last))))
9741 ;; Delete useless newly created buffer if it is empty.
9742 (w3m-delete-buffer-if-empty buffer)))))
9743
9744 (eval-when-compile
9745 (autoload 'browse-url-interactive-arg "browse-url"))
9746
9747 ;;;###autoload
9748 (defun w3m-browse-url (url &optional new-session)
9749 "Ask emacs-w3m to browse URL.
9750 NEW-SESSION specifies whether to create a new emacs-w3m session. URL
9751 defaults to the string looking like a url around the cursor position.
9752 Pop to a window or a frame up according to `w3m-pop-up-windows' and
9753 `w3m-pop-up-frames'."
9754 (interactive (progn
9755 (require 'browse-url)
9756 (browse-url-interactive-arg "Emacs-w3m URL: ")))
9757 (when (stringp url)
9758 (setq url (w3m-canonicalize-url url))
9759 (if new-session
9760 (w3m-goto-url-new-session url)
9761 (w3m-goto-url url))))
9762
9763 ;;;###autoload
9764 (defun w3m-find-file (file)
9765 "Function used to open FILE whose name is expressed in ordinary format.
9766 The file name will be converted into the file: scheme."
9767 (interactive "fFilename: ")
9768 (w3m-goto-url (w3m-expand-file-name-as-url file)
9769 nil
9770 (w3m-static-if (fboundp 'universal-coding-system-argument)
9771 coding-system-for-read)))
9772
9773 (defun w3m-cygwin-path (path)
9774 "Convert PATH in the win32 style into the cygwin format.
9775 ex. c:/dir/file => //c/dir/file"
9776 (if (string-match "^\\([A-Za-z]\\):" path)
9777 (replace-match "//\\1" nil nil path)
9778 path))
9779
9780 ;;;###autoload
9781 (defun w3m-region (start end &optional url charset)
9782 "Render the region of the current buffer between START and END.
9783 URL specifies the address where the contents come from. It can be
9784 omitted or nil when the address is not identified. CHARSET is used
9785 for decoding the contents. If it is nil, this function attempts to
9786 parse the meta tag to extract the charset."
9787 (interactive
9788 (list (region-beginning)
9789 (region-end)
9790 (w3m-expand-file-name-as-url
9791 (or (buffer-file-name) default-directory))))
9792 (save-restriction
9793 (w3m-process-stop (current-buffer))
9794 (narrow-to-region start end)
9795 (w3m-clear-local-variables)
9796 (let ((w3m-current-buffer (current-buffer)))
9797 (unless charset
9798 (setq charset (w3m-correct-charset (w3m-detect-meta-charset))))
9799 (setq url (or url
9800 w3m-buffer-local-url)
9801 w3m-current-url url
9802 w3m-current-base-url url
9803 w3m-current-coding-system
9804 (if charset
9805 (w3m-charset-to-coding-system charset)
9806 w3m-coding-system)
9807 w3m-current-title
9808 (let (w3m-use-refresh)
9809 (w3m-rendering-buffer charset)))
9810 (w3m-fontify)
9811 (when (w3m-display-inline-images-p)
9812 (and w3m-force-redisplay (sit-for 0))
9813 (w3m-toggle-inline-images 'force)))))
9814
9815 ;;;###autoload
9816 (defun w3m-buffer (&optional url charset)
9817 "Render the current buffer.
9818 See `w3m-region' for the optional arguments."
9819 (interactive (list (w3m-expand-file-name-as-url (or (buffer-file-name)
9820 default-directory))))
9821 (w3m-region (point-min) (point-max) url charset))
9822
9823 ;;; About:
9824 (defun w3m-about (url &rest args)
9825 (insert "<!doctype html public \"-//W3C//DTD HTML 3.2//EN\">
9826 <html>
9827 <head><title>About emacs-w3m</title></head>
9828 <body>
9829 <center>
9830 Welcome to <a href=\"http://emacs-w3m.namazu.org/\">\
9831 <img src=\"about://emacs-w3m.gif\" alt=\"emacs-w3m\" width=\"83\"
9832 height=\"14\"></a>!<br><br>
9833 emacs-w3m is an interface program of
9834 <a href=\"http://w3m.sourceforge.net/\">w3m</a>,
9835 works on Emacs.
9836 </center>
9837 </body>
9838 </html>")
9839 "text/html")
9840
9841 (defun w3m-view-source (&optional arg)
9842 "Display an html source of a page visited in the current buffer.
9843 ARG should be a number (a non-numeric value is treated as `1') which
9844 controls how much to decode a source. A number larger than or equal
9845 to 4 (which the `C-u' prefix produces) means don't decode. The number
9846 2 or 3 means decode normal text. The number 1 means decodes `&#nnn;'
9847 entities in 128..159 and 160 in addition to normal text (the default).
9848 A number less than or equal to zero means also encode urls containing
9849 non-ASCII characters."
9850 (interactive "p")
9851 (if w3m-current-url
9852 (let ((w3m-prefer-cache t)
9853 (w3m-view-source-decode-level (if (numberp arg) arg 0))
9854 (w3m-history-reuse-history-elements t))
9855 (w3m-history-store-position)
9856 (cond
9857 ((string-match "\\`about://source/" w3m-current-url)
9858 (w3m-goto-url (substring w3m-current-url (match-end 0))))
9859 ((string-match "\\`about://header/" w3m-current-url)
9860 (w3m-goto-url (concat "about://source/"
9861 (substring w3m-current-url (match-end 0)))))
9862 (t
9863 (w3m-goto-url (concat "about://source/" w3m-current-url))))
9864 (w3m-history-restore-position))
9865 (w3m-message "Can't view page source")))
9866
9867 (defun w3m-make-separator ()
9868 (if (string= w3m-language "Japanese")
9869 (make-string (/ (w3m-display-width) 2)
9870 (make-char 'japanese-jisx0208 40 44))
9871 (make-string (w3m-display-width) ?-)))
9872
9873 (defun w3m-about-header (url &optional no-uncompress no-cache &rest args)
9874 (when (string-match "\\`about://header/" url)
9875 (setq url (substring url (match-end 0)))
9876 (insert "Page Information\n"
9877 "\nTitle: " (or (w3m-arrived-title
9878 (w3m-url-strip-authinfo url))
9879 "")
9880 "\nURL: " url
9881 "\nDocument Type: " (or (w3m-content-type url) "")
9882 "\nLast Modified: "
9883 (let ((time (w3m-last-modified url)))
9884 (if time (current-time-string time) ""))
9885 (let ((anchor (with-current-buffer w3m-current-buffer
9886 (and (equal url w3m-current-url) (w3m-anchor)))))
9887 (if anchor
9888 (concat "\nCurrent Anchor: " anchor)
9889 "")))
9890 (let ((ct (w3m-arrived-content-type url))
9891 (charset (w3m-arrived-content-charset url))
9892 (separator (w3m-make-separator))
9893 (case-fold-search t)
9894 header ssl beg)
9895 (when (or ct charset)
9896 (insert "\n\n" separator "\n\nModifier Information\n")
9897 (insert "\nDocument Content-Type: " (or ct ""))
9898 (insert "\nDocument Charset: " (or charset "")))
9899 (when (and (not (w3m-url-local-p url))
9900 (setq header (condition-case nil
9901 (or (unless no-cache
9902 (w3m-cache-request-header url))
9903 (w3m-process-with-wait-handler
9904 (w3m-w3m-dump-head url handler)))
9905 (w3m-process-timeout nil))))
9906 (insert "\n\n" separator "\n\nHeader Information\n\n" header)
9907 (goto-char (point-min))
9908 (when (re-search-forward "^w3m-ssl-certificate: " nil t)
9909 (setq beg (match-end 0))
9910 (forward-line)
9911 (while (and (not (eobp)) (looking-at "^[ \t]"))
9912 (forward-line))
9913 (setq ssl (buffer-substring beg (point)))
9914 (delete-region beg (point))
9915 (goto-char beg)
9916 (insert "SSL\n")
9917 (goto-char (point-max))
9918 (insert separator "\n\nSSL Information\n\n")
9919 (setq beg (point))
9920 (insert ssl)
9921 (goto-char beg)
9922 (while (re-search-forward "^\t" nil t)
9923 (delete-char -1)
9924 (when (looking-at "Certificate:")
9925 (insert "\n"))))))
9926 "text/plain"))
9927
9928 (defun w3m-view-header ()
9929 "Display the header of the current page."
9930 (interactive)
9931 (if w3m-current-url
9932 (let ((w3m-prefer-cache t)
9933 (w3m-history-reuse-history-elements t)
9934 (url (cond
9935 ((string-match "\\`about://header/" w3m-current-url)
9936 (substring w3m-current-url (match-end 0)))
9937 ((string-match "\\`about://source/" w3m-current-url)
9938 (let ((real-url (substring w3m-current-url (match-end 0))))
9939 (unless (string-match "\\`about:" real-url)
9940 (concat "about://header/" real-url))))
9941 ((string-match "\\`about:" w3m-current-url)
9942 nil)
9943 (t
9944 (concat "about://header/" w3m-current-url)))))
9945 (if url
9946 (progn
9947 (w3m-history-store-position)
9948 (w3m-goto-url url)
9949 (w3m-history-restore-position))
9950 (w3m-message "Can't load a header for %s" w3m-current-url)))
9951 (w3m-message "Can't view page header")))
9952
9953 (defvar w3m-about-history-max-indentation '(/ (* (window-width) 2) 3)
9954 "*Number used to limit the identation level when showing a history.
9955 This value is evaluated whenever a history page is displayed by the
9956 `w3m-about-history' command. So, it can be any s-expression returning
9957 a number.")
9958
9959 (defvar w3m-about-history-indent-level 4
9960 "*Number used to specify the indentation level when showing a history.
9961 A history page is invoked by the `w3m-about-history' command.")
9962
9963 (defun w3m-about-history (&rest args)
9964 "Show a tree-structured history."
9965 (let (start history current)
9966 (with-current-buffer w3m-current-buffer
9967 (setq history w3m-history-flat
9968 current (cadar w3m-history)))
9969 (insert "\
9970 <head><title>URL history</title></head><body>
9971 <h1>List of all the links you have visited in this session.</h1><pre>\n")
9972 (setq start (point))
9973 (when history
9974 (let ((form
9975 (format
9976 "%%0%dd"
9977 (length
9978 (number-to-string
9979 (apply 'max
9980 (apply 'append
9981 (mapcar
9982 ;; Don't use `caddr' here, since it won't
9983 ;; be substituted by the compiler macro.
9984 (lambda (e)
9985 (car (cdr (cdr e))))
9986 history)))))))
9987 (cur (current-buffer))
9988 (margin (if (> w3m-about-history-indent-level 1)
9989 1
9990 0))
9991 (max-indent (condition-case nil
9992 ;; Force the value to be a number or nil.
9993 (+ 0 (eval w3m-about-history-max-indentation))
9994 (error nil)))
9995 (last-indent -1)
9996 (sub-indent 0)
9997 element url about title position bol indent)
9998 (while history
9999 (setq element (pop history)
10000 url (car element)
10001 ;; FIXME: an ad-hoc workaround to avoid illegal-type errors.
10002 about (or (not (stringp url))
10003 (string-match w3m-history-ignored-regexp url))
10004 title (plist-get (cadr element) :title)
10005 position (caddr element))
10006 (when url
10007 (insert (format "h%s %d %d <a href=\"%s\">%s%s%s %s</a>\n"
10008 (mapconcat (lambda (d) (format form d))
10009 position
10010 "-")
10011 (/ (1- (length position)) 2)
10012 (if (equal current position) 1 0)
10013 url
10014 (if about "&lt;" "")
10015 (if (or (not title)
10016 (string-equal "<no-title>" title)
10017 (string-match "^[\t \e$B!!\e(B]*$" title))
10018 url
10019 (w3m-encode-specials-string title))
10020 (if about "&gt;" "")
10021 position))))
10022 (sort-fields 0 start (point-max))
10023 (goto-char start)
10024 (while (not (eobp))
10025 (setq bol (point))
10026 (skip-chars-forward "^ ")
10027 (setq indent (read cur)
10028 sub-indent (if (= indent last-indent)
10029 (1+ sub-indent)
10030 0)
10031 last-indent indent
10032 indent (+ (* w3m-about-history-indent-level indent)
10033 sub-indent))
10034 (when (prog1
10035 (= (read cur) 1)
10036 (delete-region bol (point))
10037 (insert-char ?\ (+ margin (if max-indent
10038 (min max-indent indent)
10039 indent))))
10040 (beginning-of-line)
10041 (delete-char 1)
10042 (insert "&gt;"))
10043 (forward-line 1))))
10044 (insert "</pre></body>")
10045 "text/html"))
10046
10047 (defun w3m-about-db-history (url &rest args)
10048 (let ((start 0)
10049 (size nil)
10050 (width (- (w3m-display-width) 18))
10051 (now (current-time))
10052 title time alist prev next page total)
10053 (when (string-match "\\`about://db-history/\\?" url)
10054 (dolist (s (split-string (substring url (match-end 0)) "&"))
10055 (when (string-match "\\`\\(?:start\\|\\(size\\)\\)=" s)
10056 (set (if (match-beginning 1) 'size 'start)
10057 (string-to-number (substring s (match-end 0)))))))
10058 (when w3m-arrived-db
10059 (mapatoms
10060 (lambda (sym)
10061 (and sym
10062 (setq url (symbol-name sym))
10063 (not (string-match "#" url))
10064 (not (string-match w3m-history-ignored-regexp url))
10065 (push (cons url (w3m-arrived-time url)) alist)))
10066 w3m-arrived-db)
10067 (setq alist (sort alist
10068 (lambda (a b)
10069 (w3m-time-newer-p (cdr a) (cdr b))))))
10070 (setq total (length alist))
10071 (setq alist (nthcdr start alist))
10072 (when size
10073 (when (> start 0)
10074 (setq prev
10075 (format "about://db-history/?start=%d&size=%d"
10076 (max 0 (- start size)) size)))
10077 (when (> (length alist) size)
10078 (setq next
10079 (format "about://db-history/?start=%d&size=%d"
10080 (+ start size) size)))
10081 (when (> total 0)
10082 (setq total (+ (/ total size) (if (> (% total size) 0) 1 0)))
10083 (setq page (1+ (/ start size)))))
10084 (insert "<html><head><title>URL history in DataBase</title>"
10085 (if prev (format "<link rel=\"prev\" href=\"%s\">\n" prev) "")
10086 (if next (format "<link rel=\"next\" href=\"%s\">\n" next) "")
10087 (format
10088 "</head>\n<body>\n<h1>Arrived URL history in DataBase%s</h1>\n"
10089 (if (and page total)
10090 (format " (%d/%d)" page total) "")))
10091 (setq prev
10092 (if (or prev next)
10093 (setq next
10094 (concat
10095 "<p align=\"left\">"
10096 (if prev
10097 (format "[<a href=\"%s\">Prev History</a>]" prev)
10098 "")
10099 (if next
10100 (format "[<a href=\"%s\">Next History</a>]" next)
10101 "")
10102 "</p>\n"))
10103 ""))
10104 (if (null alist)
10105 (insert "<em>Nothing in DataBase.</em>\n")
10106 (insert prev "<table cellpadding=0>
10107 <tr><td><h2> Title/URL </h2></td><td><h2>Time/Date</h2></td></tr>\n")
10108 (while (and alist
10109 (or (not size)
10110 (>= (decf size) 0)))
10111 (setq url (car (car alist))
10112 time (cdr (car alist))
10113 alist (cdr alist)
10114 title (w3m-arrived-title url))
10115 (if (or (null title)
10116 (string= "<no-title>" title))
10117 (setq title (concat "<" (w3m-truncate-string url width) ">"))
10118 (when (>= (string-width title) width)
10119 (setq title (concat (w3m-truncate-string title width) "..."))))
10120 (insert (format "<tr><td><a href=\"%s\">%s</a></td>"
10121 url
10122 (w3m-encode-specials-string title)))
10123 (when time
10124 (insert "<td>"
10125 (if (<= (w3m-time-lapse-seconds time now)
10126 64800) ;; = (* 60 60 18) 18hours.
10127 (format-time-string "%H:%M:%S" time)
10128 (format-time-string "%Y-%m-%d" time))
10129 "</td>"))
10130 (insert "</tr>\n"))
10131 (insert "</table>"
10132 (if next "\n<br>\n<hr>\n" "")
10133 prev))
10134 (insert "</body></html>\n"))
10135 "text/html")
10136
10137 (defun w3m-history-highlight-current-url (url)
10138 "Highlight the current url if it is a page for the history.
10139 It does manage history position data as well."
10140 (when (string-equal "about://history/" url)
10141 (let ((inhibit-read-only t)
10142 (buffer (current-buffer))
10143 start)
10144 ;; Make history position data invisible.
10145 (goto-char (point-min))
10146 (w3m-next-anchor)
10147 (while (progn
10148 (setq start (point))
10149 (re-search-forward " (\\(?:[0-9]+ \\)*[0-9]+)$" nil t))
10150 (goto-char (match-beginning 0))
10151 (put-text-property start (match-beginning 0)
10152 'history-position (read buffer))
10153 (add-text-properties (match-beginning 0) (match-end 0)
10154 '(invisible t intangible t))
10155 (forward-char 2)
10156 (skip-chars-forward "\t "))
10157 ;; Highlight the current url.
10158 (goto-char (point-min))
10159 (when (search-forward "\n>" nil t)
10160 (w3m-next-anchor)
10161 (setq start (point))
10162 (end-of-line)
10163 (w3m-add-face-property start (point) 'w3m-history-current-url)
10164 (goto-char start)))
10165 (set-buffer-modified-p nil)))
10166
10167 (defcustom w3m-db-history-display-size
10168 (and (> w3m-keep-arrived-urls 500) 500)
10169 "*Maximum number of arrived URLs which are displayed per page."
10170 :group 'w3m
10171 :type '(radio (const :tag "All entries are displayed in single page." nil)
10172 (integer :format "%t: %v\n" :size 0)))
10173
10174 (defun w3m-db-history (&optional start size)
10175 "Display arrived URLs."
10176 (interactive
10177 (list nil w3m-db-history-display-size))
10178 (w3m-goto-url (concat
10179 (format "about://db-history/?start=%d" (or start 0))
10180 (if size (format "&size=%d" size) ""))))
10181
10182 (defun w3m-history (&optional arg)
10183 "Display the history of all the links you have visited in the session.
10184 If it is called with the prefix argument, display the arrived URLs."
10185 (interactive "P")
10186 (if (null arg)
10187 (w3m-goto-url "about://history/")
10188 (w3m-db-history nil w3m-db-history-display-size)))
10189
10190 (defun w3m-w32-browser-with-fiber (url)
10191 (let ((proc (start-process "w3m-w32-browser-with-fiber"
10192 (current-buffer)
10193 "fiber.exe" "-s"
10194 (if (w3m-url-local-p url)
10195 (w3m-url-to-file-name url)
10196 url))))
10197 (set-process-filter proc 'ignore)
10198 (set-process-sentinel proc 'ignore)))
10199
10200 (defun w3m-pipe-source (&optional url command)
10201 "Pipe the page source of url URL in binary to a shell command COMMAND.
10202 For the interactive use, URL defaults to that of a link at the point;
10203 if there are both a link to a page and a link to an image at the point,
10204 the link to a page is preferred unless the prefix argument is given."
10205 (interactive
10206 (let ((url (or (if current-prefix-arg
10207 (or (w3m-image) (w3m-anchor))
10208 (or (w3m-anchor) (w3m-image)))
10209 (and w3m-current-url
10210 (prog1
10211 (y-or-n-p (format "Pipe <%s> ? " w3m-current-url))
10212 (message nil))
10213 w3m-current-url)))
10214 command)
10215 (if (and (w3m-url-valid url)
10216 (progn
10217 (setq command (read-string "Command: "))
10218 (not (string-match "\\`[\000-\040]*\\'" command))))
10219 (list url command)
10220 (list 'none nil))))
10221 (cond ((eq url 'none) nil)
10222 ((and (stringp url)
10223 (w3m-url-valid url)
10224 (stringp command)
10225 (not (string-match "\\`[\000-\040]*\\'" command)))
10226 (w3m-message "Pipe <%s> to \"| %s\"..." url command)
10227 (with-temp-buffer
10228 (set-buffer-multibyte nil)
10229 (w3m-process-with-wait-handler
10230 (w3m-retrieve (cond ((string-match "\\`about://source/" url)
10231 url)
10232 ((string-match "\\`about://header/" url)
10233 (concat "about://source/"
10234 (substring url (match-end 0))))
10235 (t
10236 (concat "about://source/" url)))))
10237 (shell-command-on-region (point-min) (point-max) command nil)
10238 (w3m-message "Pipe <%s> to \"| %s\"...done" url command)
10239 (let ((buffer (get-buffer "*Shell Command Output*")))
10240 (when (and buffer
10241 (not (zerop (buffer-size buffer))))
10242 (display-buffer buffer)))))
10243 (t (error "Can't pipe page source"))))
10244
10245 ;;; Interactive select buffer.
10246 (defcustom w3m-select-buffer-horizontal-window t
10247 "*Non-nil means split windows horizontally to open the selection window."
10248 :group 'w3m
10249 :type 'boolean)
10250
10251 (defcustom w3m-select-buffer-window-ratio '(18 . 12)
10252 "*The percentage of the selection window to the whole frame.
10253 The car is used when splitting windows horizontally and the cdr is for
10254 splitting windows vertically."
10255 :group 'w3m
10256 :type '(cons (integer :format "H: %v[%%] " :size 0)
10257 (integer :format "V: %v[%%]\n" :size 0)))
10258
10259 (defvar w3m-select-buffer-window nil)
10260 (defconst w3m-select-buffer-message
10261 "n: next buffer, p: previous buffer, q: quit."
10262 "Help message used when the emacs-w3m buffers selection window is open.")
10263
10264 ;; Why this function is here abruptly is because of `w-s-b-horizontal-window'.
10265 (defun w3m-display-width ()
10266 "Return the maximum width which should display lines within the value."
10267 (if (< 0 w3m-fill-column)
10268 w3m-fill-column
10269 (+ (if (and w3m-select-buffer-horizontal-window
10270 (get-buffer-window w3m-select-buffer-name))
10271 ;; Show pages as if there is no buffers selection window.
10272 (frame-width)
10273 (window-width))
10274 (or w3m-fill-column -1))))
10275
10276 (defun w3m-select-buffer (&optional toggle nomsg)
10277 "Pop to the emacs-w3m buffers selection window up.
10278 It provides the feature for switching emacs-w3m buffers using the
10279 buffer list. The following command keys are available:
10280
10281 \\{w3m-select-buffer-mode-map}"
10282 (interactive "P")
10283 (when toggle
10284 (setq w3m-select-buffer-horizontal-window
10285 (not w3m-select-buffer-horizontal-window))
10286 (when (get-buffer-window w3m-select-buffer-name)
10287 (delete-windows-on w3m-select-buffer-name)))
10288 (unless (or (eq major-mode 'w3m-mode)
10289 (eq major-mode 'w3m-select-buffer-mode))
10290 (let ((buffer (w3m-alive-p t)))
10291 (if buffer
10292 (w3m-popup-buffer buffer)
10293 (w3m-goto-url (or w3m-home-page "about:")))))
10294 (let ((selected-window (selected-window))
10295 (current-buffer (current-buffer)))
10296 (set-buffer (w3m-get-buffer-create w3m-select-buffer-name))
10297 (unless (eq nomsg 'update)
10298 (setq w3m-select-buffer-window selected-window))
10299 (let ((w (or (get-buffer-window w3m-select-buffer-name)
10300 (split-window selected-window
10301 (w3m-select-buffer-window-size)
10302 w3m-select-buffer-horizontal-window))))
10303 (set-window-buffer w (current-buffer))
10304 (select-window w))
10305 (w3m-select-buffer-generate-contents current-buffer))
10306 (w3m-select-buffer-mode)
10307 (or nomsg (w3m-message w3m-select-buffer-message)))
10308
10309 (defun w3m-select-buffer-update (&rest args)
10310 (when (get-buffer-window w3m-select-buffer-name)
10311 (save-selected-window
10312 (w3m-select-buffer nil 'update)))
10313 (when w3m-use-tab
10314 (w3m-force-window-update)))
10315
10316 (defun w3m-select-buffer-generate-contents (current-buffer)
10317 (let ((i 0)
10318 (inhibit-read-only t))
10319 (delete-region (point-min) (point-max))
10320 (dolist (buffer (w3m-list-buffers))
10321 (put-text-property (point)
10322 (progn
10323 (insert (format "%d:%s %s\n" (incf i)
10324 (if (w3m-unseen-buffer-p buffer)
10325 "(u)" " ")
10326 (w3m-buffer-title buffer)))
10327 (point))
10328 'w3m-select-buffer buffer))
10329 (skip-chars-backward " \t\r\f\n")
10330 (delete-region (point) (point-max))
10331 (set-buffer-modified-p nil)
10332 (goto-char (or (text-property-any (point-min) (point-max)
10333 'w3m-select-buffer current-buffer)
10334 (point-min)))))
10335
10336 (defvar w3m-select-buffer-mode-map nil)
10337 (unless w3m-select-buffer-mode-map
10338 (let ((map (make-keymap)))
10339 (suppress-keymap map)
10340 (substitute-key-definition
10341 'next-line 'w3m-select-buffer-next-line map global-map)
10342 (substitute-key-definition
10343 'previous-line 'w3m-select-buffer-previous-line map global-map)
10344 (substitute-key-definition
10345 'w3m-copy-buffer 'w3m-select-buffer-copy-buffer map w3m-mode-map)
10346 (substitute-key-definition
10347 'w3m-next-buffer 'w3m-select-buffer-next-line map w3m-mode-map)
10348 (substitute-key-definition
10349 'w3m-previous-buffer 'w3m-select-buffer-previous-line map w3m-mode-map)
10350 (substitute-key-definition
10351 'w3m-delete-buffer 'w3m-select-buffer-delete-buffer map w3m-mode-map)
10352 (substitute-key-definition
10353 'w3m-delete-other-buffers
10354 'w3m-select-buffer-delete-other-buffers map w3m-mode-map)
10355 (substitute-key-definition
10356 'w3m-scroll-up-or-next-url
10357 'w3m-select-buffer-show-this-line map w3m-mode-map)
10358 (substitute-key-definition
10359 'w3m-scroll-down-or-previous-url
10360 'w3m-select-buffer-show-this-line-and-down map w3m-mode-map)
10361 (substitute-key-definition
10362 'w3m-select-buffer 'w3m-select-buffer-toggle-style map w3m-mode-map)
10363 (define-key map " " 'w3m-select-buffer-show-this-line)
10364 (define-key map "g" 'w3m-select-buffer-recheck)
10365 (define-key map "j" 'w3m-select-buffer-next-line)
10366 (define-key map "k" 'w3m-select-buffer-previous-line)
10367 (define-key map "n" 'w3m-select-buffer-next-line)
10368 (define-key map "p" 'w3m-select-buffer-previous-line)
10369 (define-key map "q" 'w3m-select-buffer-quit)
10370 (define-key map "h" 'w3m-select-buffer-show-this-line-and-switch)
10371 (define-key map "w" 'w3m-select-buffer-show-this-line-and-switch)
10372 (define-key map "\C-m" 'w3m-select-buffer-show-this-line-and-quit)
10373 (define-key map "\C-c\C-c" 'w3m-select-buffer-show-this-line-and-quit)
10374 (define-key map "\C-c\C-k" 'w3m-select-buffer-quit)
10375 (define-key map "\C-c\C-q" 'w3m-select-buffer-quit)
10376 (define-key map "\C-g" 'w3m-select-buffer-quit)
10377 (define-key map "?" 'describe-mode)
10378 (setq w3m-select-buffer-mode-map map)))
10379
10380 (defun w3m-select-buffer-mode ()
10381 "Major mode for switching emacs-w3m buffers using the buffer list.
10382
10383 \\<w3m-select-buffer-mode-map>\
10384 \\[w3m-select-buffer-next-line]\
10385 Next buffer.
10386 \\[w3m-select-buffer-previous-line]\
10387 Previous buffer.
10388
10389 \\[w3m-select-buffer-show-this-line]\
10390 Show the buffer on the current menu line or scroll it up.
10391 \\[w3m-select-buffer-show-this-line-and-down]\
10392 Show the buffer on the current menu line or scroll it down.
10393 \\[w3m-select-buffer-show-this-line-and-switch]\
10394 Show the buffer on the menu and switch to the buffer.
10395 \\[w3m-select-buffer-show-this-line-and-quit]\
10396 Show the buffer on the menu and quit the buffers selection.
10397
10398 \\[w3m-select-buffer-copy-buffer]\
10399 Create a copy of the buffer on the menu, and show it.
10400 \\[w3m-select-buffer-delete-buffer]\
10401 Delete the buffer on the current menu line.
10402 \\[w3m-select-buffer-delete-other-buffers]\
10403 Delete emacs-w3m buffers except for the buffer on the menu.
10404
10405 \\[w3m-select-buffer-toggle-style]\
10406 Toggle the style of the selection between horizontal and vertical.
10407 \\[w3m-select-buffer-recheck]\
10408 Do the roll call to all emacs-w3m buffers.
10409 \\[w3m-select-buffer-quit]\
10410 Quit the buffers selection.
10411 "
10412 (setq major-mode 'w3m-select-buffer-mode
10413 mode-name "w3m buffers"
10414 truncate-lines t
10415 buffer-read-only t)
10416 (use-local-map w3m-select-buffer-mode-map)
10417 (w3m-run-mode-hooks 'w3m-select-buffer-mode-hook))
10418
10419 (defun w3m-select-buffer-recheck ()
10420 "Do the roll call to all emacs-w3m buffers and regenerate the menu."
10421 (interactive)
10422 (let ((inhibit-read-only t))
10423 (erase-buffer))
10424 (w3m-select-buffer-generate-contents
10425 (window-buffer w3m-select-buffer-window))
10426 (w3m-select-buffer-show-this-line))
10427
10428 (defmacro w3m-select-buffer-current-buffer ()
10429 '(get-text-property (point-at-bol) 'w3m-select-buffer))
10430
10431 (defun w3m-select-buffer-show-this-line (&optional interactive-p)
10432 "Show the buffer on the current menu line or scroll it up."
10433 (interactive (list t))
10434 (forward-line 0)
10435 (let ((obuffer (and (window-live-p w3m-select-buffer-window)
10436 (window-buffer w3m-select-buffer-window)))
10437 (buffer (w3m-select-buffer-current-buffer)))
10438 (unless buffer
10439 (error "No buffer at point"))
10440 (cond
10441 ((get-buffer-window buffer)
10442 (setq w3m-select-buffer-window (get-buffer-window buffer)))
10443 ((window-live-p w3m-select-buffer-window)
10444 ())
10445 ((one-window-p t)
10446 (setq w3m-select-buffer-window (selected-window))
10447 (select-window
10448 (split-window nil
10449 (w3m-select-buffer-window-size)
10450 w3m-select-buffer-horizontal-window)))
10451 (t (setq w3m-select-buffer-window (get-largest-window))))
10452 (set-window-buffer w3m-select-buffer-window buffer)
10453 (when (and interactive-p (eq obuffer buffer))
10454 (save-selected-window
10455 (pop-to-buffer buffer)
10456 (w3m-scroll-up-or-next-url nil)))
10457 (w3m-force-window-update w3m-select-buffer-window)
10458 (w3m-message w3m-select-buffer-message)
10459 buffer))
10460
10461 (defun w3m-select-buffer-show-this-line-and-down ()
10462 "Show the buffer on the current menu line or scroll it down."
10463 (interactive)
10464 (let ((obuffer (and (window-live-p w3m-select-buffer-window)
10465 (window-buffer w3m-select-buffer-window)))
10466 (buffer (w3m-select-buffer-show-this-line)))
10467 (when (eq obuffer buffer)
10468 (save-selected-window
10469 (pop-to-buffer buffer)
10470 (w3m-scroll-down-or-previous-url nil)))))
10471
10472 (defun w3m-select-buffer-next-line (&optional n)
10473 "Move cursor vertically down N lines and show the buffer on the menu."
10474 (interactive "p")
10475 (forward-line n)
10476 (prog1
10477 (w3m-select-buffer-show-this-line)
10478 (w3m-static-when (featurep 'xemacs)
10479 (save-window-excursion
10480 ;; Update gutter tabs.
10481 (select-window w3m-select-buffer-window)))))
10482
10483 (defun w3m-select-buffer-previous-line (&optional n)
10484 "Move cursor vertically up N lines and show the buffer on the menu."
10485 (interactive "p")
10486 (w3m-select-buffer-next-line (- n)))
10487
10488 (defun w3m-select-buffer-copy-buffer ()
10489 "Create a copy of the buffer on the current menu line, and show it."
10490 (interactive)
10491 (w3m-select-buffer-show-this-line)
10492 (let ((window (selected-window)))
10493 (select-window (get-buffer-window (w3m-select-buffer-current-buffer)))
10494 ;; The selection buffer will be updated automatically because
10495 ;; `w3m-copy-buffer' calls `w3m-select-buffer-update' by way of
10496 ;; `w3m-goto-url'.
10497 (w3m-copy-buffer)
10498 (select-window window)))
10499
10500 (defun w3m-select-buffer-delete-buffer (&optional force)
10501 "Delete the buffer on the current menu line.
10502 If there is the sole emacs-w3m buffer, it is assumed to be called for
10503 terminating the emacs-w3m session; the prefix argument FORCE will be
10504 passed to the `w3m-quit' function (which see)."
10505 (interactive "P")
10506 (w3m-select-buffer-show-this-line)
10507 (if (= 1 (count-lines (point-min) (point-max)))
10508 (w3m-quit force)
10509 (let ((buffer (w3m-select-buffer-current-buffer)))
10510 (forward-line -1)
10511 (w3m-process-stop buffer)
10512 (w3m-idle-images-show-unqueue buffer)
10513 (kill-buffer buffer)
10514 (when w3m-use-form
10515 (w3m-form-kill-buffer buffer))
10516 (run-hooks 'w3m-delete-buffer-hook)
10517 (w3m-select-buffer-generate-contents (w3m-select-buffer-current-buffer))
10518 (w3m-select-buffer-show-this-line))))
10519
10520 (defun w3m-select-buffer-delete-other-buffers ()
10521 "Delete emacs-w3m buffers except for the buffer on the current menu."
10522 (interactive)
10523 (w3m-select-buffer-show-this-line)
10524 (w3m-delete-other-buffers (w3m-select-buffer-current-buffer)))
10525
10526 (defun w3m-select-buffer-quit ()
10527 "Quit the buffers selection."
10528 (interactive)
10529 (if (one-window-p t)
10530 (set-window-buffer (selected-window)
10531 (or (w3m-select-buffer-current-buffer)
10532 (w3m-alive-p)))
10533 (let ((buf (or (w3m-select-buffer-current-buffer)
10534 (w3m-alive-p)))
10535 pop-up-frames)
10536 (pop-to-buffer buf)
10537 (and (get-buffer-window w3m-select-buffer-name)
10538 (delete-windows-on w3m-select-buffer-name)))))
10539
10540 (defun w3m-select-buffer-show-this-line-and-switch ()
10541 "Show the buffer on the menu and switch to the buffer."
10542 (interactive)
10543 (pop-to-buffer (w3m-select-buffer-show-this-line))
10544 (message nil))
10545
10546 (defun w3m-select-buffer-show-this-line-and-quit ()
10547 "Show the buffer on the menu and quit the buffers selection."
10548 (interactive)
10549 (w3m-select-buffer-show-this-line-and-switch)
10550 (and (get-buffer-window w3m-select-buffer-name)
10551 (delete-windows-on w3m-select-buffer-name)))
10552
10553 (defun w3m-select-buffer-close-window ()
10554 "Close the window which displays the buffers selection."
10555 (let ((window (get-buffer-window w3m-select-buffer-name)))
10556 (when window
10557 (if (one-window-p t)
10558 (set-window-buffer window (other-buffer))
10559 (delete-window window)))))
10560
10561 (defun w3m-select-buffer-toggle-style()
10562 "Toggle the style of the selection between horizontal and vertical."
10563 (interactive)
10564 (w3m-select-buffer t))
10565
10566 (defun w3m-select-buffer-window-size ()
10567 (if w3m-select-buffer-horizontal-window
10568 (- (window-width)
10569 (/ (* (frame-width) (car w3m-select-buffer-window-ratio)) 100))
10570 (- (window-height)
10571 (/ (* (frame-height) (cdr w3m-select-buffer-window-ratio)) 100))))
10572
10573
10574 ;;; Header line
10575 (defcustom w3m-use-header-line t
10576 "*Non-nil means display the header line."
10577 :group 'w3m
10578 :type 'boolean)
10579
10580 (defcustom w3m-use-header-line-title nil
10581 "Non-nil means display the current title at the header line.
10582 This variable is effective only when `w3m-use-tab' is nil."
10583 :group 'w3m
10584 :type 'boolean)
10585
10586 (defface w3m-header-line-location-title
10587 '((((class color) (background light))
10588 (:foreground "Blue" :background "Gray90"))
10589 (((class color) (background dark))
10590 (:foreground "Cyan" :background "Gray20")))
10591 "Face used to highlight title when displaying location in the header line."
10592 :group 'w3m-face)
10593 ;; backward-compatibility alias
10594 (put 'w3m-header-line-location-title-face
10595 'face-alias 'w3m-header-line-location-title)
10596
10597 (defface w3m-header-line-location-content
10598 '((((class color) (background light))
10599 (:foreground "DarkGoldenrod" :background "Gray90"))
10600 (((class color) (background dark))
10601 (:foreground "LightGoldenrod" :background "Gray20")))
10602 "Face used to highlight url when displaying location in the header line."
10603 :group 'w3m-face)
10604 ;; backward-compatibility alias
10605 (put 'w3m-header-line-location-content-face
10606 'face-alias 'w3m-header-line-location-content)
10607
10608 (defvar w3m-header-line-map nil)
10609 (unless w3m-header-line-map
10610 (let ((map (make-sparse-keymap)))
10611 (set-keymap-parent map w3m-mode-map)
10612 (define-key map [mouse-2] 'w3m-goto-url)
10613 ;; Prevent tool-bar from being doubled under GNU Emacs.
10614 (define-key map [tool-bar] 'undefined)
10615 (setq w3m-header-line-map map)))
10616
10617 (defun w3m-header-line-insert ()
10618 "Put the header line into the current buffer."
10619 (when (and (or (featurep 'xemacs)
10620 (w3m-use-tab-p))
10621 w3m-use-header-line
10622 w3m-current-url
10623 (eq 'w3m-mode major-mode))
10624 (goto-char (point-min))
10625 (let ((ct (w3m-arrived-content-type w3m-current-url))
10626 (charset (w3m-arrived-content-charset w3m-current-url)))
10627 (insert (format "Location%s: " (cond ((and ct charset) " [TC]")
10628 (ct " [T]")
10629 (charset " [C]")
10630 (t "")))))
10631 (w3m-add-face-property (point-min) (point) 'w3m-header-line-location-title)
10632 (let ((start (point)))
10633 (insert (w3m-puny-decode-url
10634 (if (string-match "[^\000-\177]" w3m-current-url)
10635 w3m-current-url
10636 (w3m-url-decode-string w3m-current-url w3m-current-coding-system))))
10637 (w3m-add-face-property start (point) 'w3m-header-line-location-content)
10638 (w3m-add-text-properties start (point)
10639 `(mouse-face highlight
10640 keymap ,w3m-header-line-map
10641 ,@(if (featurep 'xemacs)
10642 '(help-echo
10643 "button2 prompts to input URL"
10644 balloon-help
10645 "button2 prompts to input URL")
10646 '(help-echo
10647 "mouse-2 prompts to input URL"))))
10648 (setq start (point))
10649 (insert-char ?\ (max
10650 0
10651 (- (if (and w3m-select-buffer-horizontal-window
10652 (get-buffer-window w3m-select-buffer-name))
10653 (frame-width)
10654 (window-width))
10655 (current-column) 1)))
10656 (w3m-add-face-property start (point) 'w3m-header-line-location-content)
10657 (unless (eolp)
10658 (insert "\n")))))
10659
10660 ;;; w3m-minor-mode
10661 (defcustom w3m-goto-article-function nil
10662 "Function used to visit an article pointed to by a given URL
10663 in `w3m-minor-mode' buffer. Normally, this option is used only
10664 when you follow a link in an html article. A function set to
10665 this variable must take one argument URL, and should display the
10666 specified page. It may return the symbol `w3m-goto-url' when it
10667 fails displaying the page. In this case, either `w3m-goto-url'
10668 or `w3m-goto-url-new-session' is employed to display the page."
10669 :group 'w3m
10670 :type '(radio (const :tag "Use emacs-w3m" nil)
10671 (function :value browse-url)))
10672
10673 (defun w3m-safe-view-this-url (&optional force)
10674 "View the URL of the link under point.
10675 This command is quite similar to `w3m-view-this-url' except for the
10676 four differences: [1]don't handle forms, [2]don't consider URL-like
10677 string under the cursor, [3]compare URL with `w3m-safe-url-regexp'
10678 first to check whether it is safe, and [4]the arguments list differs;
10679 the optional FORCE, if it is non-nil, specifies URL is safe. You
10680 should use this command rather than `w3m-view-this-url' when viewing
10681 doubtful pages that might contain vicious forms.
10682
10683 This command makes a new emacs-w3m buffer if `w3m-make-new-session' is
10684 non-nil and a user invokes this command in a buffer not being running
10685 the `w3m-mode', otherwise use an existing emacs-w3m buffer."
10686 (interactive "P")
10687 (let ((w3m-pop-up-windows nil)
10688 (url (w3m-url-valid (w3m-anchor)))
10689 safe-regexp)
10690 (cond
10691 (url
10692 (setq safe-regexp (get-text-property (point) 'w3m-safe-url-regexp))
10693 (if (or (not safe-regexp)
10694 (w3m-buffer-local-url-p url)
10695 (string-match safe-regexp url)
10696 force)
10697 (unless (and (functionp w3m-goto-article-function)
10698 (not (eq 'w3m-goto-url
10699 (funcall w3m-goto-article-function url))))
10700 (if (and w3m-make-new-session
10701 (not (eq major-mode 'w3m-mode)))
10702 (w3m-goto-url-new-session url)
10703 (w3m-goto-url url)))
10704 (when (interactive-p)
10705 (w3m-message "\
10706 This link is considered to be unsafe; use the prefix arg to view anyway"))))
10707 ((w3m-url-valid (w3m-image))
10708 (if (w3m-display-graphic-p)
10709 (if (interactive-p)
10710 (call-interactively 'w3m-toggle-inline-image)
10711 (w3m-toggle-inline-image force))
10712 (w3m-view-image)))
10713 (t (w3m-message "No URL at point")))))
10714
10715 (defun w3m-mouse-safe-view-this-url (event)
10716 "Perform the command `w3m-safe-view-this-url' by the mouse event."
10717 ;; Note: a command invoked by [mouse-N] cannot accept the prefix
10718 ;; argument since [down-mouse-N] eats it.
10719 (interactive "e")
10720 (mouse-set-point event)
10721 (let ((url (w3m-url-valid (or (w3m-anchor) (w3m-image)))))
10722 (if url
10723 (let ((safe-regexp (get-text-property (point) 'w3m-safe-url-regexp))
10724 (use-dialog-box t))
10725 (when (or (not safe-regexp)
10726 (w3m-buffer-local-url-p url)
10727 (string-match safe-regexp url)
10728 (y-or-n-p "\
10729 This link is considered to be unsafe; continue? "))
10730 (w3m-safe-view-this-url t)))
10731 (w3m-message "No URL at point"))))
10732
10733 (defconst w3m-minor-mode-command-alist
10734 '((w3m-next-anchor)
10735 (w3m-previous-anchor)
10736 (w3m-next-image)
10737 (w3m-previous-image)
10738 (w3m-toggle-inline-image)
10739 (w3m-toggle-inline-images)
10740 (w3m-view-this-url . w3m-safe-view-this-url)
10741 (w3m-mouse-view-this-url . w3m-mouse-safe-view-this-url)
10742 (w3m-print-this-url))
10743 "Alist of commands and commands to be defined in `w3m-minor-mode-map'.
10744 Each element looks like (FROM-COMMAND . TO-COMMAND); those keys which
10745 are defined as FROM-COMMAND in `w3m-mode-map' are redefined as
10746 TO-COMMAND in `w3m-minor-mode-map'. When TO-COMMAND is nil,
10747 FROM-COMMAND is defined in `w3m-minor-mode-map' with the same key in
10748 `w3m-mode-map'.")
10749
10750 (defun w3m-make-minor-mode-keymap ()
10751 "Return a keymap used for `w3m-minor-mode'."
10752 (let ((keymap (make-sparse-keymap)))
10753 (dolist (pair w3m-minor-mode-command-alist)
10754 (substitute-key-definition (car pair)
10755 (or (cdr pair) (car pair))
10756 keymap w3m-mode-map))
10757 (unless (featurep 'xemacs)
10758 ;; Inhibit the `widget-button-click' command when
10759 ;; `w3m-imitate-widget-button' is activated.
10760 (define-key keymap [down-mouse-2] 'undefined))
10761 keymap))
10762
10763 (defvar w3m-minor-mode-map (w3m-make-minor-mode-keymap)
10764 "*Keymap used when `w3m-minor-mode' is active.")
10765
10766 (defcustom w3m-minor-mode-hook nil
10767 "*Hook run after `w3m-minor-mode' initialization."
10768 :group 'w3m
10769 :type 'hook)
10770
10771 (defvar w3m-minor-mode nil "Non-nil if w3m minor mode is enabled.")
10772 (make-variable-buffer-local 'w3m-minor-mode)
10773 (unless (assq 'w3m-minor-mode minor-mode-alist)
10774 (push (list 'w3m-minor-mode " w3m") minor-mode-alist))
10775 (unless (assq 'w3m-minor-mode minor-mode-map-alist)
10776 (push (cons 'w3m-minor-mode w3m-minor-mode-map) minor-mode-map-alist))
10777
10778 (defun w3m-minor-mode (&optional arg)
10779 "Minor mode to view text/html parts in articles."
10780 (interactive "P")
10781 (when (setq w3m-minor-mode
10782 (if arg
10783 (> (prefix-numeric-value arg) 0)
10784 (not w3m-minor-mode)))
10785 (run-hooks 'w3m-minor-mode-hook)))
10786
10787 (defcustom w3m-do-cleanup-temp-files nil
10788 "*Whether to clean up temporary files when emacs-w3m shutdown."
10789 :group 'w3m
10790 :type 'boolean)
10791
10792 (defun w3m-cleanup-temp-files ()
10793 (when w3m-do-cleanup-temp-files
10794 (dolist (f (directory-files w3m-profile-directory))
10795 (when (string-match "^w3m\\(el\\|src\\)" f)
10796 (delete-file (expand-file-name f w3m-profile-directory))))))
10797
10798 (provide 'w3m)
10799
10800 (unless noninteractive
10801 (if (string-match "\\.el\\'" w3m-init-file)
10802 (or (load (concat w3m-init-file "c") t t t)
10803 (load w3m-init-file t t t))
10804 (load w3m-init-file t t))
10805 (run-hooks 'w3m-load-hook))
10806
10807 ;;; w3m.el ends here