1 ;;; w3m.el --- an Emacs interface to w3m -*- coding: iso-2022-7bit; -*-
3 ;; Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, 2009,
4 ;; 2010 TSUCHIYA Masatoshi <tsuchiya@namazu.org>
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
17 ;; This file is the main part of emacs-w3m.
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)
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.
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.
37 ;; Emacs-w3m is an Emacs interface to the w3m program. For more
38 ;; detail about w3m, see:
40 ;; http://w3m.sourceforge.net/
45 ;; See the README file in any case. We also recommend you check
46 ;; whether a newer version of w3m is released.
48 ;; The outline of installation is: run the `configure' script and type
49 ;; `make install' in the top directory of the emacs-w3m distribution.
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.
65 (unless (dolist (var nil t))
66 ;; Override the `dolist' macro which may be faultily provided by
68 (load "cl-macs" nil t)))
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.
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."))
83 ;; Silence the Emacs' byte-compiler that says ``might not be defined''.
85 (defalias 'w3m-setup-menu 'ignore))
91 ((>= emacs-major-version 21)
94 (error "Emacs-w3m of this version no longer supports Emacs %s"
96 (nbutlast (split-string emacs-version "\\."))
102 (require 'image-mode nil t)
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"))
181 ;; Avoid byte-compile warnings.
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))
207 (defconst emacs-w3m-version
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.")
216 "Emacs-w3m - the web browser of choice."
219 (defgroup w3m-face nil
220 "Faces used for emacs-w3m."
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.
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."
236 :type '(radio (const :format "Not specified " nil)
237 (string :format "Command: %v\n" :size 0)))
239 (defcustom w3m-display-ins-del 'auto
240 "*Value of `display_ins_del' option."
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)))
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.")
255 ;; Set w3m-command, w3m-type, w3m-version and w3m-compile-options
256 (if noninteractive ;; Don't call the external command when compiling.
258 (setq w3m-command "w3m"))
259 (when (or (null w3m-command)
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"))))
268 (setq w3m-command command)
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))
279 ((match-beginning 3) 'w3mmee)
280 ((match-beginning 2) 'w3m-m17n)
281 ((match-beginning 1) 'w3m)
283 (when (re-search-forward "options +" nil t)
284 (setq w3m-compile-options
285 (or (split-string (buffer-substring (match-end 0)
289 (when (member "m17n" w3m-compile-options)
290 (setq w3m-type 'w3m-m17n))))))))
292 (when (not (stringp w3m-command))
294 Install w3m command in `exec-path' or set `w3m-command' variable correctly"))
296 (defcustom w3m-user-agent (concat "Emacs-w3m/" emacs-w3m-version
298 "String used for the User-Agent field. See also `w3m-add-user-agent'."
300 :type '(string :size 0))
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."
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)))
314 "*Your preferred language used in emacs-w3m sessions."
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))
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"))))
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'."
332 :type '(repeat (string :format "Argument: %v\n" :size 0)))
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:
340 \(setq w3m-command-arguments-alist
341 '(;; Don't use the proxy server to visit local web pages.
342 (\"^http://\\\\(?:[^/]*\\\\.\\\\)*your-company\\\\.com\\\\(?:/\\\\|$\\\\)\"
344 ;; Use the proxy server to visit any foreign urls.
346 \"-o\" \"http_proxy=http://proxy.your-company.com:8080/\")))
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."
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)))))
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."
364 :type '(repeat (string :format "Domain name: %v\n" :size 0)))
366 (defcustom w3m-command-environment
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."
376 (cons :format "%v" :indent 4
377 (string :format "Name: %v\n" :size 0)
378 (string :format " Value: %v\n" :size 0))))
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."
387 :type '(integer :size 0))
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."
395 :type '(radio (const :tag "Not specified" nil)
396 (function :format "%t: %v\n" :size 0)))
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."
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))))
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."
424 (when w3m-use-mule-ucs
427 (error (setq w3m-use-mule-ucs nil))))
429 (defcustom w3m-use-ange-ftp nil
430 "*Non-nil means that `ange-ftp' or `efs' is used to access FTP servers."
434 (defcustom w3m-doc-view-content-types
436 (delq nil (mapcar (lambda (type)
437 (if (doc-view-mode-p type)
438 (format "application/%s" type)))
439 '(dvi postscript pdf)))
441 "List of content types for which to use `doc-view-mode' to view contents.
442 This overrides `w3m-content-type-alist'."
444 :type '(repeat (string :tag "Type" :value "application/")))
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."
451 :type '(sexp :size 0))
453 (defcustom w3m-treat-image-size t
454 "*Non-nil means let w3m mind the ratio of the size of images and text.
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.
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."
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."
475 :type '(choice (const :tag "Auto Detect" nil)
476 (integer :tag "Specify Pixels")))
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."
485 :type '(radio (const :tag "Auto Detect" nil)
486 (integer :format "Specify Pixels: %v\n" :size 0)))
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
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" "")))
500 (defvar w3m-accept-japanese-characters
501 (and (not noninteractive)
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.
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)))))
516 (set-buffer-multibyte nil)
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)
527 "Non-nil means that the w3m command accepts Japanese characters.")
529 (defcustom w3m-coding-system (if (featurep 'mule)
530 (if (eq w3m-type 'w3mmee)
534 "*Default coding system used to communicate with the w3m command."
536 :type '(coding-system :size 0))
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
547 :type '(coding-system :size 0))
549 (defcustom w3m-output-coding-system
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)
557 (= emacs-major-version 21))))
560 (w3m-accept-japanese-characters 'w3m-euc-japan)
561 (t 'w3m-iso-latin-1))
562 "*Coding system used when reading from w3m processes."
564 :type '(coding-system :size 0))
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
571 'w3m-euc-japan-mule-ucs
572 (if (featurep 'w3m-ems)
576 'w3m-iso-latin-1-mule-ucs
577 (if (featurep 'w3m-ems)
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
585 :type '(coding-system :size 0))
587 (defcustom w3m-file-coding-system (if (featurep 'mule)
590 "*Coding system used when writing configuration files.
591 This value will be referred to by the `w3m-save-list' function."
593 :type '(coding-system :size 0))
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.")
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."
606 :type '(coding-system :size 0))
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."
612 :type '(coding-system :size 0))
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."
618 :type '(repeat (coding-system :format "%t: %v\n" :size 0)))
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."
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)
632 (custom-set-default symbol value)
633 (if (or noninteractive
634 ;; Loading w3m.elc is just in progress...
635 (not (featurep 'w3m)))
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.
643 '(setq w3m-mode-map (if (eq value 'info)
646 w3m-minor-mode-map (w3m-make-minor-mode-keymap))))
647 (let ((buffers (buffer-list)))
650 (set-buffer (car buffers))
651 (if (eq major-mode 'w3m-mode)
654 (use-local-map (symbol-value 'w3m-mode-map))
658 (setq buffers (cdr buffers)))))))))
660 (defcustom w3m-use-cygdrive (eq system-type 'windows-nt)
661 "*If non-nil, use the /cygdrive/ rule when performing `expand-file-name'."
666 (defconst w3m-treat-drive-letter (memq system-type '(windows-nt OS/2 emx))
667 "Say whether the system uses drive letters."))
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."
674 :type '(directory :size 0))
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
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."
685 :type '(file :size 0))
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."
692 :type '(directory :size 0))
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.
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."
706 :type '(radio (directory :format "%{%t%}: %v\n" :size 0 :value "~/")
707 (symbol :format "%{%t%}: %v\n"
708 :match (lambda (widget value) value)
710 :value default-directory)
711 (function :format "%{%t%}: %v\n"
715 (defcustom w3m-accept-languages
716 (let ((file (expand-file-name "config" w3m-profile-directory)))
717 (or (when (file-readable-p file)
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")
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\")."
730 :type '(repeat (string :format "Lang: %v\n" :size 0)))
732 (defcustom w3m-delete-duplicated-empty-lines t
733 "*Non-nil means display two or more continuous empty lines into single."
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)
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'."
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."
767 (defcustom w3m-icon-directory
771 (let* ((path (locate-library "w3m"))
773 (cons (file-name-directory path) load-path)
776 (setq path (car paths)
780 (if (file-directory-p
782 (expand-file-name "../../etc/images/w3m/" path)))
783 (throw 'found-dir dir))
784 (if (file-directory-p
786 (expand-file-name "../etc/images/w3m/" path)))
787 (throw 'found-dir dir))
788 (if (file-directory-p
790 (expand-file-name "../../etc/w3m/icons/" path)))
791 (throw 'found-dir dir))
792 (if (file-directory-p
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)))
802 (and (file-directory-p
803 (setq dir (expand-file-name "w3m/icons/" data-directory)))
805 "*Directory where emacs-w3m should find icon files."
807 :type '(radio (const :tag "Not specified")
808 (directory :format "%t: %v\n" :size 0)))
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."
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."
829 (defcustom w3m-home-page
830 (or (getenv "HTTP_HOME")
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. ;-)"
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))))
848 (defcustom w3m-arrived-file
849 (expand-file-name ".arrived" w3m-profile-directory)
850 "*Name of the file to keep the arrived URLs database."
852 :type '(file :size 0))
854 (defcustom w3m-keep-arrived-urls 500
855 "*Maximum number of URLs which the arrived URLs database keeps."
857 :type '(integer :size 0))
859 (defcustom w3m-prefer-cache nil
860 "*Non-nil means that cached contents are used without checking headers."
864 (defcustom w3m-keep-cache-size 300
865 "*Maximum number of pages to be cached in emacs-w3m."
867 :type '(integer :size 0))
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."
875 :type '(radio (const :format "Ignore redirections " nil)
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:
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."
891 (defcustom w3m-resize-image-scale 50
892 "*Number of steps in percent used when resizing images."
894 :type '(integer :size 0))
897 '((((class color) (background light)) (:foreground "blue"))
898 (((class color) (background dark)) (:foreground "cyan"))
900 "Face used for displaying anchors."
902 ;; backward-compatibility alias
903 (put 'w3m-anchor-face 'face-alias 'w3m-anchor)
905 (defface w3m-arrived-anchor
906 '((((class color) (background light)) (:foreground "navy"))
907 (((class color) (background dark)) (:foreground "LightSkyBlue"))
909 "Face used for displaying anchors which have already arrived."
911 ;; backward-compatibility alias
912 (put 'w3m-arrived-anchor-face 'face-alias 'w3m-arrived-anchor)
914 (defface w3m-current-anchor
915 '((t (:underline t :bold t)))
916 "Face used to highlight the current anchor."
918 ;; backward-compatibility alias
919 (put 'w3m-current-anchor-face 'face-alias 'w3m-current-anchor)
922 '((((class color) (background light)) (:foreground "ForestGreen"))
923 (((class color) (background dark)) (:foreground "PaleGreen"))
925 "Face used for displaying alternate strings of images."
927 ;; backward-compatibility alias
928 (put 'w3m-image-face 'face-alias 'w3m-image)
930 (defface w3m-image-anchor
931 '((((class color) (background light)) (:background "light yellow"))
932 (((class color) (background dark)) (:background "dark green"))
934 "Face used for displaying alternate strings of images which are in anchors."
936 ;; backward-compatibility alias
937 (put 'w3m-image-anchor-face 'face-alias 'w3m-image-anchor)
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."
963 ;; backward-compatibility alias
964 (put 'w3m-history-current-url-face 'face-alias 'w3m-history-current-url)
966 (defface w3m-bold '((t (:bold t)))
967 "Face used for displaying bold text."
969 ;; backward-compatibility alias
970 (put 'w3m-bold-face 'face-alias 'w3m-bold)
972 (defface w3m-italic '((((type tty)) (:underline t))
974 "Face used for displaying italic text.
975 By default it will be a underline face on a non-window system."
977 ;; backward-compatibility alias
978 (put 'w3m-italic-face 'face-alias 'w3m-italic)
980 (defface w3m-underline '((t (:underline t)))
981 "Face used for displaying underlined text."
983 ;; backward-compatibility alias
984 (put 'w3m-underline-face 'face-alias 'w3m-underline)
986 (defface w3m-strike-through
988 ,(if (featurep 'xemacs)
990 '(:strike-through t)))
992 "Face used for displaying strike-through text."
994 ;; backward-compatibility alias
995 (put 'w3m-strike-through-face 'face-alias 'w3m-strike-through)
998 '((((class color) (background light))
999 (:foreground "purple"))
1000 (((class color) (background dark))
1001 (:foreground "orchid"))
1003 "Face used for displaying insert text."
1005 ;; backward-compatibility alias
1006 (put 'w3m-insert-face 'face-alias 'w3m-insert)
1008 (defcustom w3m-mode-hook nil
1009 "*Hook run after `w3m-mode' initialization.
1010 This hook is evaluated by the `w3m-mode' function."
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."
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."
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."
1034 :initialize 'w3m-custom-hook-initialize)
1036 (defcustom w3m-after-cursor-move-hook
1037 '(w3m-highlight-current-anchor
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'."
1045 :initialize 'w3m-custom-hook-initialize)
1047 (defcustom w3m-delete-buffer-hook
1048 '(w3m-pack-buffer-numbers)
1049 "*Hook run when every emacs-w3m buffer is deleted."
1052 :initialize 'w3m-custom-hook-initialize)
1054 (defcustom w3m-select-buffer-hook nil
1055 "*Hook run when a different emacs-w3m buffer is selected."
1059 (defcustom w3m-async-exec t
1060 "*Non-nil means execute the w3m command asynchronously in Emacs process."
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.
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."
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."
1092 (defcustom w3m-default-content-type "text/html"
1093 "*Default value assumed as the content type of local files."
1095 :type '(string :size 0))
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'.")
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)))
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))
1118 (symbol-value 'browse-url-browser-function)))
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
1145 ((w3m-which-command "gv") (list "gv" 'file))
1146 ((w3m-which-command "gs") (list "gs" 'file)))))
1147 (pdf-viewer (or fiber-viewer
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:
1179 2. Regexp matching a url or a file name.
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.
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."
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
1213 :match-alternatives (stringp 'file 'url)
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)))))
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."
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))))
1234 (defcustom w3m-decoder-alist
1235 `((gzip "gzip" ("-d")) ;; Don't use "gunzip" and "bunzip2"
1236 (bzip "bzip2" ("-d")) ;; for broken OS and implementations.
1238 ,(if (not noninteractive)
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")))
1248 "Alist of encoding types, decoder commands, and arguments."
1252 (radio :format "Encoding: %v"
1253 (const :format "%v " gzip)
1254 (const :format "%v " bzip)
1256 (string :format "Command: %v\n" :size 0)
1257 (repeat :tag "Arguments" :extra-offset 2
1258 (string :format "%v\n" :size 0)))))
1260 (defcustom w3m-charset-coding-system-alist
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)
1269 (windows-874 . tis-620)
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)
1287 (x-euc-jp . euc-japan)
1288 (x-shift-jis . shift_jis)
1289 (x-shift_jis . shift_jis)
1290 (x-sjis . shift_jis)))
1293 (or (w3m-find-coding-system (car (car rest)))
1294 (setq dest (cons (car rest) dest)))
1295 (setq rest (cdr rest)))
1297 "Alist of MIME charsets and coding systems.
1298 Both charsets and coding systems must be symbols."
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))))
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."
1324 :type '(repeat (cons :format "%v" :indent 11
1325 (string :format "From: %v\n" :size 0)
1326 (string :format "To: %v\n" :size 0))))
1328 (defcustom w3m-horizontal-scroll-columns 10
1329 "*Number of steps in columns used when scrolling a window horizontally."
1331 :type '(integer :size 0))
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."
1337 :type '(integer :size 0))
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
1345 nil means don't recenter, let the display follow point in the
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)))
1354 (defcustom w3m-use-form t
1355 "*Non-nil means make it possible to use form extensions. (EXPERIMENTAL)"
1360 (defcustom w3m-submit-form-safety-check nil
1361 "Non-nil means ask you for confirmation when submitting a form."
1365 (defcustom w3m-use-cookies nil
1366 "*Non-nil means enable emacs-w3m to use cookies. (EXPERIMENTAL)"
1370 (defcustom w3m-use-filter nil
1371 "*Non-nil means use filter programs to convert web contents.
1372 See also `w3m-filter-rules'."
1375 :require 'w3m-filter)
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)
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."
1391 :require 'w3m-symbol)
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."
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
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."
1414 :type '(repeat (cons :format "%v" :indent 3
1415 (regexp :format "URL: %v\n" :size 0)
1418 (defcustom w3m-url-local-directory-alist
1419 (when (boundp 'yahtml-path-url-alist)
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."
1431 (cons :format "%v" :indent 3
1432 (string :format "URL: %v\n" :size 0)
1433 (directory :format "%t: %v\n" :size 0)))
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.
1440 A tip for XEmacs users:
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:
1447 For ol[v]wm use this in .Xdefaults:
1448 olvwm.NoDecor: balloon-help
1450 olwm.MinimalDecor: balloon-help
1452 For fvwm version 1 use this in your .fvwmrc:
1453 NoTitle balloon-help
1455 Style \"balloon-help\" NoTitle, NoHandles, BorderWidth 0
1457 For twm use this in your .twmrc:
1458 NoTitle { \"balloon-help\" }
1460 See the balloon-help.el file for more information."
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)
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:
1474 Decode URIs using the encoding guessed from the value of
1475 `w3m-coding-system-priority-list'.
1478 Decode URIs using this value.
1480 3. List of coding systems:
1481 Decode URIs using the encoding assumed based on this list.
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
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
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"
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)
1517 "Rules to select an encoding of URIs on the current page:\n%v%i\n"
1520 :format "%v" :indent 2
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"))
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)
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
1537 (group :tag "List of prefered encodings"
1538 (repeat :tag "List of prefered encodings"
1541 (coding-system :tag "Encoding")))
1542 (const :tag "Don't decode URIs"
1543 :format "%t: %{nil%}\n" :sample-face widget-field-face
1545 (const :tag "Don't decode URIs"
1546 :format "%t: %{nil%}\n" :sample-face widget-field-face
1549 (defcustom w3m-use-title-buffer-name nil
1550 "Non-nil means use name of buffer included current title."
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."
1569 (defcustom w3m-menu-on-forefront nil
1570 "Non-nil means place the emacs-w3m menus on the forefront of the menu bar."
1573 :set (lambda (symbol value)
1575 (custom-set-default symbol value)
1576 (unless noninteractive
1577 (w3m-menu-on-forefront value)))))
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'."
1587 (defcustom w3m-add-tab-number nil
1588 "Non-nil means put sequential number to a title on tab."
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'."
1602 (defcustom w3m-new-session-url "about://bookmark/"
1603 "*Default url to be opened in a tab or a session which is created newly."
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)
1612 (string :format "URL: %v\n" :size 0
1613 :value "http://emacs-w3m.namazu.org"))))
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
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)
1636 (w3m-favicon-usable-p))))
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)
1646 (custom-set-default symbol value)
1647 (if (and (not noninteractive)
1648 ;; Make sure it is not the first time.
1650 (fboundp 'w3m-initialize-graphic-icons))
1651 (w3m-initialize-graphic-icons))))
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."
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."
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."
1682 (defcustom w3m-view-this-url-new-session-in-background nil
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."
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."
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"
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"
1709 (sexp :format "%t: %v\n" :size 0))))))
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
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."
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
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
1737 This feature doesn't work if `w3m-auto-show' is nil. The value must
1738 be a larger integer than 1."
1740 :type '(integer :size 0)
1741 :set (lambda (symbol value)
1742 (custom-set-default symbol (if (and (integerp value) (> value 1))
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
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."
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'."
1765 :type '(string :size 0))
1767 (defcustom w3m-local-find-file-regexps
1770 (regexp-opt (append '("htm"
1777 (and (w3m-image-type-available-p 'jpeg)
1779 (and (w3m-image-type-available-p 'gif)
1781 (and (w3m-image-type-available-p 'png)
1783 (and (w3m-image-type-available-p 'xbm)
1785 (and (w3m-image-type-available-p 'xpm)
1787 t) ;; with surrounding parens (for old Emacsen).
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.
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:
1804 \(setq w3m-local-find-file-regexps
1805 '(nil . \"\\\\.\\\\(?:[sx]?html?\\\\|dvi\\\\|ps\\\\|pdf\\\\)\\\\'\"))
1807 It is effective only when the `w3m-local-find-file-function' variable
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))))
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.
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."
1830 :type '(sexp :size 0))
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."
1838 :type '(radio (const :format "Dirlist CGI " w3m-cgi)
1839 (const :tag "Directory tree" w3m-dtree)))
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")))
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."
1851 (const :tag "w3m internal CGI" nil)
1852 (file :format "path of 'dirlist.cgi': %v\n"
1854 :value ,(if (not noninteractive)
1857 (file-name-nondirectory w3m-command)
1859 (file-name-directory
1860 (w3m-which-command w3m-command)))))))
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.
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
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.
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
1887 \(setq w3m-add-referer
1889 . \"\\\\`http://\\\\(?:[^./]+\\\\.\\\\)*example\\\\.net/\")\)
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
1900 (regexp :format "%t: %v\n" :size 0)
1901 (const :tag "Don't allow all" nil))
1902 (radio :indent 2 :sample-face underline
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")))
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."
1913 :type '(string :size 0))
1915 (defcustom w3m-puny-utf-16be
1917 ((w3m-find-coding-system 'utf-16-be-no-signature)
1918 'utf-16-be-no-signature)
1919 ((w3m-find-coding-system 'utf-16be)
1922 "*Coding system for PUNY coding. if nil, don't use PUNY code."
1924 :type '(radio (coding-system :tag "UTF-16BE without BOM")
1925 (const "Don't use" nil)))
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.
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).
1947 Here are some predefined functions which can be used for those ways:
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
1954 `w3m-search-uri-replace'
1955 Generate the valid forms to query words to some specified search
1956 engines. For example, the element
1958 (\"\\\\`gg:\" w3m-search-uri-replace \"google\")
1960 makes it possible to replace the URI \"gg:emacs\" to the form to
1961 query the word \"emacs\" to the Google site.\
1965 :convert-widget w3m-widget-type-convert-widget
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"
1975 (function-item :format "" w3m-search-uri-replace)
1976 (string :format "Quick Search Engine: %v\n"
1979 (require 'w3m-search)
1982 (let* ((engine (car elem))
1983 (prefix (mapconcat 'identity
1984 (split-string (downcase engine))
1987 :format "Quick Search:\n%v"
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)
1998 :format "%t: %v\n" :size 0
1999 ;; Fix a bug in Emacs versions prior to 22.
2001 (lambda (widget value)
2003 (if (string-match "\\`\".*\"\\'" value)
2004 (substring value 1 -1)
2006 (prin1-to-string value))))
2007 (repeat :extra-offset 2 :tag "Options"
2008 (sexp :format "%t: %v\n" :size 0)))))))
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>\\)")
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\">")
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")
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>")
2043 (w3m-relationship-simple-estimate
2044 "\\`http://freshmeat\\.net/\\(search\\|browse\\)/"
2045 ,(concat "<A HREF=" w3m-html-string-regexp ">\\[»\\]</A>")
2046 ,(concat "<A HREF=" w3m-html-string-regexp ">\\[«\\]</A>")
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."
2056 :format "%[Value Menu%] %v"
2057 (list :tag "Estimate relationships from anchors matching"
2059 (const :format "Function: %v\n"
2060 w3m-relationship-simple-estimate)
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"
2071 (repeat :tag "Args" :extra-offset 1 (sexp :format "%v"))))))
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."
2079 (defcustom w3m-google-feeling-lucky-charset
2081 ((or (featurep 'un-define) (fboundp 'utf-translate-cjk-mode))
2083 ((equal "Japanese" w3m-language)
2085 ((w3m-find-coding-system 'utf-8)
2088 "*Character set for \"I'm Feeling Lucky on Google\"."
2090 :type '(string :size 0))
2092 (defconst w3m-entity-table
2093 (let ((table (make-hash-table :test 'equal)))
2094 (dolist (entity '(("nbsp" . " ")
2102 (puthash (car entity) (cdr entity) table))
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)
2131 (puthash (car entity)
2132 (char-to-string (make-char 'latin-iso8859-1 (cdr 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)
2149 (puthash (car entity)
2150 (char-to-string (make-char 'greek-iso8859-7 (cdr entity)))
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
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)
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)))
2172 (greek '((39 . (("thetasym" . 81) ("upsih" . 82) ("piv" . 86)))))
2175 (("weierp" . 88) ("image" . 81) ("real" . 92)
2176 ("trade" . 98) ("alefsym" . 117)))))
2179 (("larr" . 112) ("uarr" . 113) ("rarr" . 114) ("darr" . 115)
2182 (("crarr" . 53) ("lArr" . 80) ("uArr" . 81) ("rArr" . 81)
2183 ("dArr" . 83) ("hArr" . 84)))))
2184 (mathematical-operators
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)
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)
2198 (122 . (("sdot" . 37)))))
2199 (miscellaneous-technical
2200 '((122 . (("lceil" . 104) ("rceil" . 105) ("lfloor" . 106)
2202 (123 . (("lang" . 41) ("rang" . 42)))))
2204 '(("loz" . (34 . 42)) ("spades" . (35 . 96)) ("clubs" . (35 . 99))
2205 ("hearts" . (35 . 101)) ("diams" . (35 . 102)))))
2206 (dolist (entities `(,@latin-extended-a
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)
2216 (make-char 'mule-unicode-0100-24ff
2217 code1 (cdr entity)))
2219 (dolist (entity suit)
2220 (puthash (car entity)
2222 (make-char 'mule-unicode-2500-33ff
2223 (car (cdr entity)) (cdr (cdr entity))))
2226 "Table of html character entities and values.")
2228 (defvar w3m-extra-numeric-character-reference
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.")
2242 (defconst w3m-entity-reverse-table
2243 (let ((table (make-hash-table :test 'equal)))
2244 (maphash (lambda (key val) (puthash val key table))
2247 "Revision table of html character entities and values.")
2249 (defconst w3m-entity-regexp
2251 (maphash (lambda (key val) (push key buf))
2254 (let ((max-specpdl-size (* 1024 1024))) ;; For old Emacsen.
2256 "\\|#\\(?:[xX][0-9a-fA-F]+\\|[0-9]+\\)\\)\\(\\'\\|[^0-9a-zA-Z]\\)"))
2257 "Regexp matching html character entities.")
2259 (defconst w3m-encoding-alist
2262 (mapcar (lambda (elem)
2263 (mapcar (lambda (x) (cons x (car 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).")
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.")
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."
2304 :type '(choice (string :tag "Format") function))
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
2313 :type '(radio (const :format "Accept any image\n" nil)
2314 (regexp :format "URL regexp: %v\n" :size 0)))
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."
2320 :type '(integer :size 0))
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.")
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.")
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.")
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.")
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.")
2342 (defvar w3m-modeline-separator " / "
2343 "String used to separate a status and a title in the modeline.")
2345 (defvar w3m-modeline-favicon nil
2346 "Modeline control for displaying a favicon.
2347 This variable will be made buffer-local.")
2349 (defvar w3m-favicon-image nil
2350 "Favicon image of the page.
2351 This variable will be made buffer-local")
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)
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)
2364 (defvar w3m-mail-user-agents '(gnus-user-agent
2369 "List of mail user agents that `w3m-mail' supports.
2370 See also w3m-mail.el.")
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.")
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)
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
2424 w3m-previous-url nil
2426 w3m-contents-url nil
2427 w3m-max-anchor-sequence nil
2428 w3m-current-refresh nil
2430 w3m-name-anchor-from-hist nil))
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
2442 prev w3m-previous-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
2455 w3m-previous-url prev
2457 w3m-contents-url toc
2458 w3m-max-anchor-sequence hseq
2459 w3m-current-refresh refresh
2460 w3m-current-ssl ssl)))
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.")
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.
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'.")
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)
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.")
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.")
2500 (defconst w3m-image-type-alist
2501 '(("image/jpeg" . jpeg)
2504 ("image/x-xbm" . xbm)
2505 ("image/x-xpm" . xpm))
2506 "Alist of content types and image types defined as the Emacs' features.")
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.")
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
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
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.")
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
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...")
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")
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)]
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]
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))]
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)]
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]
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...")
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")
2638 [,(w3m-make-menu-item "
\e$B%j%9%H$GMzNr$rI=<(
\e(B" "Show an Arrived URLs List")
2641 [,(w3m-make-menu-item "
\e$B%$%s%?!<%M%C%H$G$N8!:w
\e(B..."
2642 "Search the Internet...")
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")
2649 [,(w3m-make-menu-item (concat a "
\e$B%s%F%J$G<hF@
\e(B")
2650 "Investigate with Antenna")
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")
2657 [,(w3m-make-menu-item "
\e$B%X%C%@!<$r8+$k
\e(B" "View Header")
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)]
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]
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")
2671 [,(w3m-make-menu-item "w3m
\e$B$r=*N;$9$k
\e(B" "Quit w3m")
2674 "Menubar definition for emacs-w3m.")
2676 (defvar w3m-rmouse-menubar
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")
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)]
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.")
2696 (defvar w3m-cid-retrieve-function-alist nil)
2697 (defvar w3m-force-redisplay t)
2699 (defvar w3m-work-buffer-list nil)
2700 (defconst w3m-work-buffer-name " *w3m-work*")
2701 (defconst w3m-select-buffer-name " *w3m buffers*")
2703 (defconst w3m-dump-head-source-command-arguments
2704 (cond ((eq w3m-type 'w3mmee)
2705 (list "-dump=extra,head,source"))
2708 '(if w3m-accept-languages
2710 (concat "accept_language="
2711 (mapconcat 'identity w3m-accept-languages ","))))
2713 "Arguments passed to the w3m command to run \"dump_extra\".")
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.")
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)
2728 (list "-I" 'charset)))
2729 "-o" "concurrent=0"))
2730 ((eq w3m-type 'w3m-m17n)
2732 "-o" "ext_halfdump=1"
2733 "-o" "strict_iso2022=0"
2734 "-o" "fix_width_conv=1"
2735 "-o" "use_jisx0201=0"
2737 '(if (eq w3m-input-coding-system 'binary)
2738 (if charset (list "-I" 'charset))
2740 ((eq w3m-input-coding-system 'utf-8)
2742 ((eq w3m-input-coding-system 'iso-8859-1)
2748 ((eq w3m-output-coding-system 'utf-8)
2750 ((eq w3m-output-coding-system 'iso-8859-1)
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\".")
2759 (defconst w3m-halfdump-command-common-arguments
2760 (list "-T" "text/html" "-t" tab-width "-cols" '(w3m-display-width)
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\".")
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.")
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.")
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.")
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'.")
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.")
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
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)) "\\)/")
2821 ;; Strip the localhost name.
2822 (setq url (substring url (match-end 1))))
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))
2828 (substring url (match-end 1)))))))
2829 ;; Process abs_path part in Windows.
2830 (when (and w3m-treat-drive-letter
2832 "\\`/\\(?:\\([a-zA-Z]\\)[|:]?\\|cygdrive/\\([a-zA-Z]\\)\\)/"
2834 (setq url (concat (or (match-string 1 url) (match-string 2 url))
2836 (substring url (match-end 0)))))
2837 (if (string-match "\\`/[^/:]\\{2,\\}:/" url)
2838 ;; Don't check for a Tramp url.
2840 (if (file-exists-p 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)
2847 (dolist (pair w3m-url-local-directory-alist)
2848 (and (string-match (concat "\\`"
2850 (file-name-as-directory (car pair))))
2852 (let ((file (expand-file-name (substring url (match-end 0))
2854 (when (or (file-exists-p file)
2856 (setq file (w3m-url-decode-string
2857 file w3m-file-name-coding-system))))
2858 (throw 'found-file file)))))))))
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
2865 (setq file (expand-file-name file directory))
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)))
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)
2882 (if (and (not (zerop len))
2883 (eq (aref url (1- len)) ?/))
2884 (substring url 0 -1)
2886 `(if (let ((len (length ,url)))
2887 (and (not (zerop len))
2888 (eq (aref ,url (1- len)) ?/)))
2889 (substring ,url 0 -1)
2891 `(,fn ,str w3m-arrived-db)))
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)
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))
2911 (put ident 'content-type content-type)))
2912 (set ident arrival-time))))
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)))
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))
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))))
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))))
2940 (defsetf w3m-arrived-get w3m-arrived-put)
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))
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))
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,
2955 `(w3m-arrived-get ,url 'content-charset))
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,
2961 `(w3m-arrived-get ,url 'content-type))
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)))
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))
2985 (when (file-exists-p w3m-arrived-file)
2986 (delete-file w3m-arrived-file)))
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)))
2997 ;; Ignore an element that lacks an arrival time information.
2999 (w3m-arrived-add (if (string-match "\\`/" (car elem))
3000 (w3m-expand-file-name-as-url (car elem))
3005 (when (stringp (nth 4 elem)) (nth 4 elem))
3007 (unless w3m-input-url-history
3008 (setq w3m-input-url-history (mapcar (function car) list))))
3009 (run-hooks 'w3m-arrived-setup-functions)))
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))
3026 (when (stringp (nth 4 elem)) (nth 4 elem))
3028 ;; Convert current database to a list.
3034 (symbol-value sym) ; Ignore an entry lacks an arrival time.
3035 (push (list (symbol-name sym)
3037 (get sym 'last-modified)
3039 (get sym 'content-charset)
3040 (get sym 'content-type))
3043 (w3m-save-list w3m-arrived-file
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)
3052 (setq w3m-arrived-db nil)
3053 (run-hooks 'w3m-arrived-shutdown-functions)))
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)
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:
3067 0. Type of contents.
3068 1. Charset of contents.
3070 3. Encoding of contents.
3071 4. Last modification time.
3074 If the optional argument NO-CACHE is non-nil, cache is not used."
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))
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))))
3087 (attrs (w3m-attributes src no-cache handler))
3089 (or (w3m-arrived-content-charset (w3m-url-strip-authinfo src))
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))
3110 (w3m-w3m-attributes url no-cache handler)))))
3112 (defmacro w3m-content-type (url &optional no-cache handler)
3114 `(let ((handler ,handler))
3116 (attrs (w3m-attributes ,url ,no-cache handler))
3118 `(car (w3m-attributes ,url ,no-cache))))
3119 (defmacro w3m-content-charset (url &optional no-cache handler)
3121 `(let ((handler ,handler))
3123 (attrs (w3m-attributes ,url ,no-cache handler))
3125 `(nth 1 (w3m-attributes ,url ,no-cache))))
3126 (defmacro w3m-content-length (url &optional no-cache handler)
3128 `(let ((handler ,handler))
3130 (attrs (w3m-attributes ,url ,no-cache handler))
3132 `(nth 2 (w3m-attributes ,url ,no-cache))))
3133 (defmacro w3m-content-encoding (url &optional no-cache handler)
3135 `(let ((handler ,handler))
3137 (attrs (w3m-attributes ,url ,no-cache handler))
3139 `(nth 3 (w3m-attributes ,url ,no-cache))))
3140 (defmacro w3m-last-modified (url &optional no-cache handler)
3142 `(let ((handler ,handler))
3144 (attrs (w3m-attributes ,url ,no-cache handler))
3146 `(nth 4 (w3m-attributes ,url ,no-cache))))
3147 (defmacro w3m-real-url (url &optional no-cache handler)
3149 `(let ((handler ,handler))
3151 (attrs (w3m-attributes ,url ,no-cache handler))
3153 `(nth 5 (w3m-attributes ,url ,no-cache))))
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)
3165 (if (and w3m-track-mouse
3166 (eq (extent-object extent) (current-buffer)))
3167 (w3m-url-readable-string ,str))))
3168 `(lambda (window object pos)
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))))))))
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
3183 (when (featurep 'xemacs)
3184 (let ((str `(get-text-property (extent-start-position extent)
3186 `(let ((fn (intern (format "w3m-balloon-help-for-%s"
3190 (unless (fboundp fn)
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)))))))
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.")
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)))
3219 (unless w3m-message-silent
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)
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))))))))
3234 (defun w3m-time-parse-string (string)
3235 "Parse the time-string STRING into a time in the Emacs style."
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)
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")
3246 (require 'parse-time))
3247 (defun w3m-time-parse-string (string)
3248 "Parse the time-string STRING and return its time as Emacs style."
3250 (let ((fn (when (fboundp 'parse-time-string)
3251 'parse-time-string)))
3253 (apply (function encode-time) (funcall fn string)))))))
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."
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)))
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)))
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))
3285 (message "Error while loading %s" file)
3287 ;; point is not always moved to the beginning of the buffer
3288 ;; after `insert-file-contents' is done.
3289 (goto-char (point-min))
3291 (read (current-buffer))
3293 (message "Error while reading %s; %s"
3294 file (error-message-string err))
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))
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
3309 element print-length print-level)
3311 ;;; %s -*- mode: emacs-lisp%s -*-
3312 ;; This file is generated automatically by emacs-w3m v%s.
3315 (file-name-nondirectory file)
3316 (if coding-system-for-write
3317 (format "; coding: %s" coding-system-for-write)
3322 (setq element (car list)
3327 (funcall print-fn (car element))
3329 (while (setq element (cdr element))
3331 (funcall print-fn (car element))
3333 (backward-delete-char 1)
3335 (funcall print-fn element)
3337 (skip-chars-backward "\n ")
3338 (delete-region (point) (point-max))
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)))))))
3345 (defun w3m-url-encode-string (str &optional coding encode-space)
3346 (apply (function concat)
3350 ((eq ch ?\n) ; newline
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
3358 (format "%%%02X" ch)))) ; escape
3359 ;; Coerce a string into a list of chars.
3360 (append (encode-coding-string (or str "")
3362 w3m-default-coding-system
3367 (defun w3m-url-decode-string (str &optional coding)
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))
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)))
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."
3386 (setq url (w3m-puny-decode-url url))
3388 (cond ((string-match "[^\000-\177]" url)
3389 ;; It looks not to have been encoded.
3391 ((and (listp w3m-show-decoded-url)
3392 (consp (car w3m-show-decoded-url)))
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)
3401 (throw 'found-rule (cdr elem)))))))
3402 (t w3m-show-decoded-url))))
3404 (w3m-url-decode-string url
3406 w3m-coding-system-priority-list
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.
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))
3422 (while (string-match "[^\x21-\x7e]+" url start)
3424 (cons (apply 'concat
3426 (lambda (c) (format "%%%02X" c))
3427 (append (encode-coding-string
3428 (match-string 0 url)
3430 w3m-current-coding-system)))))
3431 (cons (substring url start (match-beginning 0))
3433 start (match-end 0)))
3435 (nreverse (cons (substring url start) buf)))))
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)))))))
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)))))
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)))))
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)))))
3481 (defun w3m-fontify-strike-through ()
3482 "Fontify strike-through text in the buffer containing halfdump."
3483 (goto-char (point-min))
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>\\)")
3499 (w3m-add-face-property (match-beginning 0) (match-end 0)
3500 'w3m-strike-through)))))
3502 (defun w3m-fontify-insert ()
3503 "Fontify insert text in the buffer containing halfdump."
3504 (goto-char (point-min))
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>\\)"
3517 (w3m-add-face-property (match-beginning 0) (match-end 0) 'w3m-insert)))))
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:
3524 ;; [emacs-w3m:00150] <URL:http://emacs-w3m.namazu.org/ml/msg00149.html>
3526 ;; Takaaki MORIYAMA wrote in the article that the string "&" 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 "\\(&\\)\\|\\([\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)))))
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)))
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)
3545 (eval w3m-imitate-widget-button)
3547 (and w3m-imitate-widget-button t)))
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))
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
3564 (w3m-decode-entities-string
3565 (w3m-url-transfer-encode-string
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))
3577 (setq rel (split-string rel))
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))
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))
3599 (w3m-url-transfer-encode-string
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)
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
3613 'balloon-help balloon
3614 'keymap w3m-link-map))
3615 (when (w3m-imitate-widget-button)
3617 (let ((widget-button-face (if (w3m-arrived-p href)
3620 (widget-mouse-face 'highlight)
3622 (setq w (widget-convert-button 'default start end
3625 (w3m-static-unless (featurep 'xemacs)
3626 (overlay-put (widget-get w :button-overlay) 'evaporate t))))
3628 (w3m-add-text-properties start (point-max)
3629 (list 'w3m-name-anchor2
3631 (w3m-decode-entities-string
3632 (w3m-url-transfer-encode-string
3636 (w3m-add-text-properties start (point-max)
3637 (list 'w3m-name-anchor2
3639 (w3m-decode-entities-string
3640 (w3m-url-transfer-encode-string
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))
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)))
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)))))
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))
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)))
3677 "w3m rmouse menu item" w3m-rmouse-menubar))))))
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)
3689 (goto-char (match-end 1))
3690 (w3m-parse-attributes (src
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)
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))
3709 (setq help (format "%s\nalt: %s\nimg: %s" help title src)))
3711 (setq help (format "%s\nimg: %s" help src)))
3713 (setq help (format "alt: %s\nimg: %s" title src)))
3715 (setq help (format "img: %s" src))))
3716 (w3m-add-text-properties start end
3717 (list 'w3m-image src
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)
3733 (unless (w3m-anchor start)
3734 (add-text-properties start end (list 'mouse-face 'highlight
3736 'balloon-help balloon)))))))))
3738 (defvar w3m-idle-images-show-timer nil)
3739 (defvar w3m-idle-images-show-list nil)
3740 (defvar w3m-idle-images-show-interval 1)
3742 (defun w3m-idle-images-show ()
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)))))
3757 (if (< prev-diff next-diff) prev next)
3758 'w3m-idle-image-item))
3760 (get-text-property prev
3761 'w3m-idle-image-item))
3763 (get-text-property next
3764 'w3m-idle-image-item))
3766 (car (last w3m-idle-images-show-list))))
3767 (start (nth 0 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)
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)
3788 (image (let ((w3m-current-buffer (current-buffer))
3789 (w3m-message-silent t))
3794 (when (buffer-live-p (marker-buffer start))
3795 (with-current-buffer (marker-buffer start)
3799 (when (equal url w3m-current-url)
3800 (let ((inhibit-read-only t))
3801 (w3m-insert-image start end image iurl))
3803 (when w3m-force-redisplay
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
3821 'w3m-idle-images-show)))
3822 (cancel-timer w3m-idle-images-show-timer)
3823 (setq w3m-idle-images-show-timer nil))))
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
3832 (and (not (eq buffer (marker-buffer (nth 0 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
3839 'w3m-idle-images-show)))))
3841 (defvar w3m-image-no-idle-timer nil)
3842 (defun w3m-toggle-inline-images-internal (status
3843 &optional no-cache url
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)))
3857 (if (equal status 'off)
3858 (while (< (setq start
3861 (next-single-property-change end 'w3m-image
3864 (setq end (or (next-single-property-change start 'w3m-image)
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)
3871 w3m-ignored-image-url-regexp
3873 ;; URL is specified and is same as the image URL.
3875 (not (eq (get-text-property start 'w3m-image-status)
3877 (w3m-add-text-properties start end '(w3m-image-status on))
3878 (if (get-text-property start 'w3m-image-redundant)
3880 ;; Insert a dummy string instead of a redundant image.
3881 (setq image (make-string
3882 (string-width (buffer-substring start end))
3884 (w3m-add-text-properties start end '(invisible t))
3886 (w3m-add-text-properties
3887 end (progn (insert image) (point))
3888 '(w3m-image-dummy t w3m-image "dummy"))
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
3901 You are retrieving non-secure image(s). Continue? ")
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))
3913 (url w3m-current-url))
3915 (image (let ((w3m-current-buffer (current-buffer)))
3920 (when (buffer-live-p (marker-buffer start))
3921 (with-current-buffer (marker-buffer start)
3923 (when (equal url w3m-current-url)
3924 (let ((inhibit-read-only t))
3925 (w3m-insert-image start end image iurl))
3927 (when w3m-force-redisplay
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)
3941 (setq w3m-idle-images-show-list
3942 (cons item w3m-idle-images-show-list))
3943 (w3m-add-text-properties
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
3950 'w3m-idle-images-show)))))))))
3952 (while (< (setq start (if (w3m-image end)
3954 (next-single-property-change end 'w3m-image
3957 (setq end (or (next-single-property-change start 'w3m-image)
3959 iurl (w3m-image start))
3960 ;; IMAGE-ALT-STRING DUMMY-STRING
3961 ;; <--------w3m-image---------->
3962 ;; <---redundant--><---dummy--->
3964 (when (and (or (not url)
3965 ;; URL is specified and is not same as the image URL.
3967 (not (eq (get-text-property start 'w3m-image-status)
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)
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)))))
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."
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))
3994 (setq begin (region-beginning)
3996 (w3m-deactivate-region)
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))))))
4006 (dolist (x toggle-list)
4007 (let* ((url (car x))
4009 (status (get-text-property pos 'w3m-image-status))
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)
4017 (if force (setq status 'off))
4018 (w3m-toggle-inline-images-internal
4020 (or begin (point-min))
4021 (or end (point-max))))
4023 (get-text-property (point) 'w3m-safe-url-regexp))
4026 (string-match safe-regexp url))
4027 (w3m-toggle-inline-images-internal
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"))))))))
4035 (w3m-message "No images in region")
4036 (w3m-message "No image at point")))))
4038 (defun w3m-turnoff-inline-images ()
4039 "Turn off to display all images in the buffer or in the region."
4041 (w3m-toggle-inline-images 'turnoff))
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.
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)."
4053 (unless (w3m-display-graphic-p)
4054 (error "Can't display images in this environment"))
4055 (let ((status (cond ((eq force 'turnoff) t)
4057 (t w3m-display-inline-images)))
4059 beg end safe-regexp pos url)
4060 (if (w3m-region-active-p)
4062 (setq beg (region-beginning)
4064 (w3m-deactivate-region))
4065 (setq beg (point-min)
4068 (when (setq safe-regexp (get-text-property (point) 'w3m-safe-url-regexp))
4069 ;; Scan the buffer for searching for an insecure image url.
4074 (when (setq url (get-text-property pos 'w3m-image))
4075 (unless (string-match safe-regexp url)
4077 (setq pos (next-single-property-change pos 'w3m-image)))
4080 (setq pos (next-single-property-change pos 'w3m-image
4082 (setq url (get-text-property pos 'w3m-image)))
4083 (unless (string-match safe-regexp url)
4085 (setq pos (next-single-property-change pos 'w3m-image
4094 (w3m-toggle-inline-images-internal (if status 'on 'off)
4095 no-cache nil beg end
4096 (unless (interactive-p)
4098 (setq w3m-display-inline-images (not 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"))))
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
4110 (let* ((inhibit-read-only t)
4112 (end (or (next-single-property-change start 'w3m-image)
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))
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)
4124 ;; Insert a dummy string instead of a redundant image.
4125 (setq image (make-string
4126 (string-width (buffer-substring start end))
4128 (w3m-add-text-properties start end '(invisible t))
4129 (w3m-add-text-properties (point)
4130 (progn (insert image) (point))
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
4139 You are retrieving non-secure image(s). Continue? ")
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))
4147 (url w3m-current-url))
4149 (image (let ((w3m-current-buffer (current-buffer)))
4150 (w3m-create-resized-image
4155 (when (buffer-live-p (marker-buffer start))
4156 (with-current-buffer (marker-buffer start)
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))
4164 (when w3m-force-redisplay
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)))))))))
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."
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)))
4185 (w3m-resize-inline-image-internal
4187 (+ 100 (or rate w3m-resize-image-scale)))
4188 (w3m-message "No image at point"))))
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."
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)))
4202 (w3m-resize-inline-image-internal
4204 (- 100 (or rate w3m-resize-image-scale)))
4205 (w3m-message "No image at point"))))
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."
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))
4220 (string-match "/type=\\(?:text\\|select\\)/name=[^/]+/"
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))
4233 (w3m-add-text-properties start (point) prop)))))))
4235 (defun w3m-decode-entities-string (str)
4236 "Decode entities in the string STR."
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))
4246 pos (if (eq (aref str (match-end 1)) ?\;)
4250 (apply 'concat (nreverse (cons (substring str pos) buf)))
4253 (defun w3m-encode-specials-string (str)
4254 "Encode special characters in the string STR."
4257 (while (string-match "[<>&]" str pos)
4260 (cons (gethash (match-string 0 str) w3m-entity-reverse-table)
4262 (cons (substring str pos (match-beginning 0))
4266 (apply 'concat (nreverse (cons (substring str pos) buf)))
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.
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))))
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)
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)
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)))))
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))
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)))
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))
4343 (when (and (eq major-mode 'w3m-mode)
4344 (get-text-property (point) 'w3m-anchor-sequence)
4345 (setq prop (get-text-property (point) 'face))
4347 (member 'w3m-anchor prop))
4349 (end (next-single-property-change (point) 'w3m-anchor-sequence))
4350 (inhibit-read-only t))
4352 (setq start (previous-single-property-change
4353 end 'w3m-anchor-sequence))
4354 (w3m-arrived-p (get-text-property (point)
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))))))
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))
4369 ((string-match "\\`file:[^/]" url)
4371 ((string-match "/\\(~\\)" url)
4372 (substring url (match-beginning 1)))
4373 (t (w3m-url-to-file-name url)))))
4375 (let ((dir (file-name-directory partial)))
4378 (list (w3m-expand-file-name-as-url f dir)))
4379 (file-name-all-completions (file-name-nondirectory partial)
4382 (if (string-match "/\\.\\'" url)
4383 (concat (file-name-as-directory
4384 (w3m-expand-file-name-as-url partial))
4386 (w3m-expand-file-name-as-url partial)))
4389 (try-completion partial collection predicate))
4391 (all-completions partial collection predicate)))))
4394 (try-completion url w3m-arrived-db))
4396 (all-completions url w3m-arrived-db))
4398 (if (w3m-arrived-p url) t nil)))))
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.
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.
4412 That it returns an invalid url for the article of the group which is
4413 not being archived in Gmane cannot be helped."
4415 (let ((fmt "http://news.gmane.org/group/thread=%s/force_load=t")
4417 (inhibit-point-motion-hooks t)
4419 (goto-char (point-min))
4420 (re-search-forward (concat "^\\(?:"
4421 (regexp-quote mail-header-separator)
4424 (when (< start (point))
4425 (setq case-fold-search t)
4427 (narrow-to-region (point-min) (point))
4430 (while (and (memq (char-after) '(?\t ? ))
4431 (zerop (forward-line -1))))
4433 "\\(?:Message-ID\\|References\\):[\t\n ]*<\\([^\t\n <>]+\\)>")
4436 (w3m-url-encode-string (match-string-no-properties 1)
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)
4444 (or (memq 'w3m-header-line-location-title faces)
4445 (memq 'w3m-header-line-location-content faces))
4450 (autoload 'ffap-url-at-point "ffap")
4451 (defalias 'w3m-url-at-point
4452 (cond ((and (featurep 'xemacs) (featurep 'mule))
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)
4460 (right (buffer-substring-no-properties (point)
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))
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)))
4474 (goto-char (point-min))
4476 (ffap-url-at-point))))))
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))
4486 (ffap-url-at-point)))))
4489 (or (w3m-gmane-url-at-point)
4490 (w3m-header-line-url)
4491 (ffap-url-at-point)))))))
4493 (eval-after-load "ffap"
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\\)\\(\\\\|\\|\\\\)\\)"
4500 (setq ffap-url-regexp (replace-match "\\1\\2s?\\3"
4501 nil nil ffap-url-regexp)))
4503 (if (and ffap-url-regexp
4504 (not (string-match ffap-url-regexp "nntp://bar"))
4505 (string-match "\\(\\\\(news\\\\(post\\\\)\\?:\\)\\(\\\\|\\)"
4507 (setq ffap-url-regexp (replace-match "\\1\\\\|nntp:\\2"
4508 nil nil ffap-url-regexp)))))
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)
4516 (let ((string (buffer-substring-no-properties
4517 (region-beginning) (region-end))))
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)))
4529 (w3m-deactivate-region))
4530 (or (w3m-url-at-point)
4532 (unless w3m-display-inline-images
4534 (and default=current
4535 (stringp w3m-current-url)
4536 (if (string-match "\\`about://\\(?:header\\|source\\)/"
4538 (substring w3m-current-url (match-end 0))
4539 w3m-current-url)))))
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)
4546 ((match-beginning 1)
4548 ((and (file-name-absolute-p url) (file-exists-p url))
4549 (concat "file://" url))
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)))
4558 (concat "http://" url))))
4560 (defun w3m-input-url (&optional prompt initial default quick-start
4562 "Read a url from the minibuffer, prompting with string PROMPT."
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)))
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
4582 (unless w3m-enable-google-feeling-lucky
4583 (setq feeling-lucky nil))
4584 (setq url (let ((minibuffer-setup-hook
4585 (append minibuffer-setup-hook
4588 (if (looking-at "[a-z]+:\\(?:/+\\)?")
4589 (goto-char (match-end 0)))))))
4590 (ofunc (lookup-key minibuffer-local-completion-map " ")))
4592 (define-key minibuffer-local-completion-map " "
4593 'self-insert-command))
4599 (when (string-match " *: *\\'" prompt)
4602 (match-beginning 0))))
4603 (concat prompt " (default "
4604 (if (equal default w3m-home-page)
4610 (format "URL %s(default %s): "
4611 (if feeling-lucky "or Keyword " "")
4612 (if (stringp default)
4613 (if (eq default w3m-home-page)
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))))
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'.
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)))))
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))
4648 (defun w3m-cache-header-delete-variable-part (header)
4650 (dolist (line (split-string header "\n+"))
4651 (if (string-match "\\`\\(?:Date\\|Server\\|W3m-[^:]+\\):" line)
4653 (unless (and flag (string-match "\\`[ \t]" line))
4656 (mapconcat (function identity) (nreverse buf) "\n")))
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."
4663 (let ((ident (intern url w3m-cache-hashtb)))
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)
4673 (set ident header))))
4675 (defun w3m-cache-request-header (url)
4676 "Return the header string of URL when it is stored in the cache."
4678 (let ((ident (intern url w3m-cache-hashtb)))
4680 (symbol-value ident))))
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.
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)))))))
4696 (defun w3m-cache-remove (url)
4697 "Remove the data coresponding to URL from the cache."
4699 (let ((ident (intern url w3m-cache-hashtb))
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))))))
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."
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))
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))
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."
4741 (let ((ident (intern url w3m-cache-hashtb)))
4742 (when (memq ident w3m-cache-articles)
4743 ;; It was in the cache.
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))))
4755 (with-current-buffer (or buffer (current-buffer))
4756 (let ((inhibit-read-only t))
4757 (insert-buffer-substring w3m-cache-buffer beg end))
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."
4765 (let ((ident (intern url w3m-cache-hashtb)))
4767 (memq ident w3m-cache-articles)
4771 (let ((case-fold-search t)
4772 (head (and (boundp ident) (symbol-value ident)))
4775 ((and (string-match "^\\(?:date\\|etag\\):[ \t]" head)
4776 (or (string-match "^pragma:[ \t]+no-cache\n" head)
4778 "^cache-control:\\(?:[^\n]+\\)?[ \t,]\\(?:no-cache\\|max-age=0\\)[,\n]"
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]*\\)"
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)))
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)))
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))))))
4807 (defun w3m-read-file-name (&optional prompt dir default existing)
4809 (setq default (file-name-nondirectory (w3m-url-strip-query default))))
4811 (setq prompt (if (and default (not (string-equal default "")))
4812 (format "Save to (%s): " default)
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)
4822 (setq file (expand-file-name default file))))
4823 (expand-file-name file)))
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))))
4835 (defun w3m-coding-system-to-charset (coding-system)
4836 "Return the MIME charset corresponding to CODING-SYSTEM."
4838 (w3m-static-if (featurep 'xemacs)
4839 (when (or (fboundp 'coding-system-to-mime-charset)
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)))))
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
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))
4863 (if (string= "" charset)
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))))))))
4884 (defmacro w3m-correct-charset (charset)
4885 `(or (and ,charset (stringp ,charset)
4886 (cdr (assoc (downcase ,charset) w3m-correct-charset-alist)))
4889 (defun w3m-detect-meta-charset ()
4890 (let ((case-fold-search t))
4891 (goto-char (point-min))
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")
4898 (string-match ";[ \t\n]*charset=\\([^\";]+\\)" content))
4899 (throw 'found (match-string 1 content))))))))
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))
4910 (defvar w3m-compatible-encoding-alist
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.")
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'.")
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))
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))))
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)))
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)
4948 (setq cs (w3m-detect-coding-region
4949 (point-min) (point-max) (if (w3m-url-local-p url)
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]\\)\;\\)"
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\\| \\| " nil t)
4974 (replace-match " "))))
4977 (decode-coding-string (buffer-string) w3m-current-coding-system)
4979 (set-buffer-multibyte t))))))
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))
4987 (if (w3m-find-coding-system 'utf-8)
4988 (setq args (append args '("-o" "-cs" "utf-8"))
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))
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)))
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)
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))))
5026 (defmacro w3m-local-content-type (url)
5027 `(car (w3m-local-file-type ,url)))
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:
5034 0. Type of contents.
5035 1. Charset of contents.
5037 3. Encoding of contents.
5038 4. Last modification time.
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))
5050 (w3m-expand-file-name-as-url (file-truename file)))))
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))
5062 (let (jka-compr-compression-info-list
5064 (insert-file-contents file))
5065 (insert-file-contents file))))
5066 (or (w3m-arrived-content-type url)
5067 (w3m-local-content-type file)))))
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))
5084 (write-region (point-min) (point-max) cfile 'nomsg))
5085 (w3m-process-with-environment
5088 (cons "LOCAL_COOKIE" lcookie)
5089 (cons "LOCAL_COOKIE_FILE" cfile)
5090 (cons "QUERY_STRING"
5093 (encode-coding-string (w3m-url-to-file-name url)
5094 w3m-file-name-coding-system)
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=\"\\([^\"]+\\)\"\\(?:>\\| \\)"
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
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))
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)
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)))
5145 ;;; Retrieving data via HTTP:
5146 (defun w3m-remove-redundant-spaces (str)
5147 "Remove leading and trailing whitespace from STR."
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))
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:
5160 1. Type of contents.
5161 2. Charset of contents.
5163 4. Encoding of contents.
5164 5. Last modification time.
5167 (let ((case-fold-search t)
5170 (dolist (line (split-string header "[ \f\t\r]*\n"))
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
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"
5184 ;; MEMO: See [emacs-w3m:02341].
5185 "content-transfer-encoding"
5190 "w3m-document-charset"
5191 "w3m-ssl-certificate"
5192 "x-w3m-content-encoding"
5196 (push (cons (downcase (match-string 1 line))
5197 (substring line (match-end 0)))
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))
5222 (when (and (setq xmoe (cdr (assoc "w3m-document-charset" headers)))
5223 (string= xmoe "x-moe-internal"))
5224 (setq charset xmoe))
5226 (if (string-match "\\`ftps?:.*/\\'" url)
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")
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)))
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
5245 (and v (w3m-expand-url v url)))
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
5255 (setq w3m-current-url url
5256 url (w3m-url-strip-authinfo url))
5257 (w3m-process-start handler
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")
5265 (buffer-string))))))
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)
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:
5282 0. Type of contents.
5283 1. Charset of contents.
5285 3. Encoding of contents.
5286 4. Last modification time.
5289 If the optional argument NO-CACHE is non-nil, cache is not used."
5290 (w3m-w3m-attributes-1 (w3m-w3m-canonicalize-url url)
5292 (or w3m-follow-redirection 0)
5295 (defun w3m-w3m-attributes-1 (url no-cache counter handler)
5296 "A subroutine for `w3m-w3m-attributes'."
5297 (lexical-let ((url url)
5301 (header (or (unless no-cache
5302 (w3m-cache-request-header url))
5303 (w3m-w3m-dump-head url handler)))
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))
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))
5316 (defun w3m-w3m-expand-arguments (arguments)
5321 ((stringp x) (list x))
5326 (w3m-w3m-expand-arguments x))
5328 (let (print-level print-length)
5329 (list (prin1-to-string x))))))))
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)")
5346 (w3m-process-start handler
5348 (append w3m-command-arguments
5349 (w3m-w3m-expand-arguments
5350 w3m-dump-head-source-command-arguments)
5352 (let ((w3m-message-silent silent))
5353 (w3m-message "Reading %s...done" (w3m-url-readable-string url))
5355 (goto-char (point-min))
5356 (let ((case-fold-search t))
5357 (when (and (re-search-forward "^w3m-current-url:" nil t)
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)))))))))
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)
5378 (setq def (car 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)
5392 (throw 'domain-match t)))))
5393 (push "-no-proxy" args))
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)
5401 ((eq w3m-add-referer 'lambda)
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))))
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."
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))
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
5440 (mapconcat 'identity w3m-accept-languages
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"))
5449 (insert "Cookie: " cookie "\n"))
5451 (insert "Content-Type: " content-type "\n"))
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))))))
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)))
5474 (when w3m-add-user-agent
5475 (setq args (nconc args
5476 (list "-o" (concat "user_agent=" w3m-user-agent)))))
5478 (setq args (nconc args
5479 (list "-header" (concat "Cookie: " cookie)))))
5480 (when (and (string= method "post") temp-file)
5482 (set-buffer-multibyte nil)
5483 (when body (insert body))
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
5491 (list "-header" (concat "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)))))
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
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))
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))
5526 (w3m-message "Can't decode encoded contents: %s" url)
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))
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"))))
5545 (when (or (eq w3m-type 'w3mmee) post-data)
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")
5556 (if (consp post-data)
5560 (if (consp post-data) (car post-data))))))
5561 (lexical-let ((url url)
5562 (post-data post-data)
5566 (temp-file temp-file))
5568 (attr (or (unless no-cache
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)))
5575 (file-exists-p temp-file)
5576 (delete-file temp-file))
5577 (if (memq (car attr) '(301 302 303 304 305 306 307))
5579 ;; Redirect counter exceeds `w3m-follow-redirection'.
5580 'redirection-exceeded
5581 ;; Follow redirection.
5583 (unless (and post-data
5585 ((memq (car attr) '(301 302))
5586 (if w3m-redirect-with-get
5587 (setq post-data nil)
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
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.
5603 (w3m-w3m-retrieve-1 (nth 6 attr) post-data referer no-cache
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."
5613 ((string= "about://emacs-w3m.gif" url)
5614 (let ((icon (base64-decode-string w3m-emacs-w3m-icon)))
5615 (if (featurep 'xemacs)
5617 (set-buffer-multibyte (multibyte-string-p icon))
5619 (set-buffer-multibyte nil)))
5621 ((string-match "\\`about://source/" url)
5622 (lexical-let ((url (substring url (match-end 0))))
5624 (type (w3m-retrieve url
5625 no-uncompress no-cache post-data referer handler))
5628 ((w3m-cache-request-contents url)
5629 (w3m-decode-encoded-contents (w3m-content-encoding url))
5632 ((string-match "\\`about:/*blank/?\\'" url)
5635 (lexical-let ((output-buffer (current-buffer)))
5636 (w3m-process-do-with-temp-buffer
5638 (setq w3m-current-url url)
5639 (set-buffer-multibyte t)
5640 (if (and (string-match "\\`about://\\([^/]+\\)/" url)
5642 (intern-soft (concat "w3m-about-"
5643 (match-string 1 url))))
5645 (funcall func url no-uncompress no-cache
5646 post-data referer handler)
5647 (w3m-about url no-uncompress no-cache))))
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))))
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
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.
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.
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))))
5680 (defun w3m-data-retrieve (url &optional no-uncompress no-cache)
5681 "Retrieve contents pointed to by URL prefixed with the data: scheme.
5683 (let ((case-fold-search t) (mime-type "text/plain")
5684 (coding nil) (encode nil) (param "")
5687 "data:\\(\\([^/;,]+\\(/[^;,]+\\)?\\)\\(;[^;,]+\\)*\\)?,\\(.*\\)"
5689 (setq mime-type (or (match-string-no-properties 2 url)
5691 param (or (match-string-no-properties 4 url)
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))))
5702 (let (decode-string)
5705 ((eq encode 'base64)
5706 (base64-decode-string data-string))
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)))))
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.
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.
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
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."
5742 (w3m-process-with-wait-handler
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)
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))
5761 (w3m-w3m-retrieve url
5762 no-uncompress no-cache post-data referer handler))))))
5764 (defvar w3m-touch-file-available-p 'undecided)
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)))
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)))
5784 (setq w3m-touch-file-available-p
5785 (when (w3m-which-command w3m-touch-command)
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
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
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
5814 (format-time-string "%Y%m%d%H%M.%S" time)
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."
5823 (let* ((url (w3m-input-url "Download URL: "))
5824 (basename (file-name-nondirectory (w3m-url-strip-query url))))
5825 (if (string-match "^[\t ]*$" basename)
5827 (w3m-read-file-name (format "Download %s to: " url)
5828 w3m-default-save-directory "index.html")
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
5840 (w3m-clear-local-variables)
5841 (setq w3m-current-url url)
5842 (w3m-retrieve url t no-cache post-data nil handler)))
5844 (let ((buffer-file-coding-system 'binary)
5845 (coding-system-for-write 'binary)
5846 jka-compr-compression-info-list
5848 (when (or (not (file-exists-p filename))
5850 (format "File(%s) already exists. Overwrite? "
5853 (write-region (point-min) (point-max) filename)
5854 (w3m-touch-file filename (w3m-last-modified url))
5857 (message "Cannot retrieve URL: %s%s"
5859 (if w3m-process-exit-status
5860 (format " (exit status: %s)" w3m-process-exit-status)
5865 (w3m-make-ccl-coding-system
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)
5872 (w3m-make-ccl-coding-system
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)
5879 (defun w3m-remove-comments ()
5880 "Remove HTML comments in the current buffer."
5881 (goto-char (point-min))
5883 (while (search-forward "<!--" nil t)
5884 (setq beg (match-beginning 0))
5885 (if (search-forward "-->" nil t)
5886 (delete-region beg (point))))))
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)
5895 (while (and (re-search-forward "\\(<img\\)[\t\n\f\r ]+" nil t)
5897 (setq start (match-end 1))
5898 (search-forward ">" nil t))
5900 (setq end (match-beginning 0))
5902 (re-search-forward "[\t\n\f\r ]+alt=\"[\t\n\f\r ]*\""
5904 (delete-region (match-beginning 0) (match-end 0)))))
5906 (defun w3m-check-header-tags ()
5907 "Process header tags (<LINK>,<BASE>) in the current buffer."
5908 (let ((case-fold-search t)
5910 (goto-char (point-min))
5911 (when (re-search-forward "</head\\(?:[ \t\r\f\n][^>]*\\)?>" nil t)
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)))
5918 ((string= tag "link")
5919 (w3m-parse-attributes ((rel :case-ignore) href type)
5921 (setq rel (split-string rel))
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))))))))))
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)
5941 (goto-char (point-min))
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")
5947 ((string-match "\\`[0-9]+\\'" content)
5948 (setq sec (match-string-no-properties 0 content)))
5950 "\\([^;]+\\);[ \t\n]*url=[\"']?\\([^\"']+\\)"
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)))
5962 (setq w3m-current-refresh
5963 (cons (string-to-number sec)
5964 (w3m-expand-url refurl))))))))))))
5966 (defun w3m-remove-meta-charset-tags ()
5967 (let ((case-fold-search t))
5968 (goto-char (point-min))
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")
5976 (string-match ";[ \t\n]*charset=" content))
5977 (delete-region start (point))
5978 (throw 'found nil))))))))
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=\"\\([^\"]+\\)\">"
5985 (prog1 (w3m-decode-entities-string
5986 (mapconcat 'identity
5987 (save-match-data (split-string (match-string 1)))
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))
5995 (defun w3m-set-display-ins-del ()
5996 (when (eq w3m-display-ins-del 'auto)
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))
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))
6014 ((string= type "number")
6015 (setq w3m-display-ins-del 'fontify))
6016 ((string= type "bool")
6017 (setq w3m-display-ins-del 'tag)))))))))
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
6033 (or w3m-halfdump-command w3m-command)
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
6050 (face-font 'default))
6051 (frame-char-height))))
6052 "-ppc" (number-to-string
6053 (or w3m-pixels-per-character
6057 (face-font 'default))
6058 (frame-char-width)))))
6059 (list "-o" "display_image=off")))))))))
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))
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."
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].
6098 (or (memq this-command
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)
6106 (y-or-n-p "You are leaving secure page. Continue? ")
6108 (lexical-let ((url (w3m-url-strip-fragment url))
6110 (page-buffer (current-buffer))
6111 (arrival-time (current-time))
6112 (silent w3m-message-silent))
6113 (w3m-process-do-with-temp-buffer
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))
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"
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))
6137 (prog1 (w3m-create-page url
6138 (or (w3m-arrived-content-type url)
6141 (w3m-arrived-content-charset url)
6142 (w3m-content-charset url))
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))))))
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"
6157 (if w3m-process-exit-status
6158 (format " (exit status: %s)"
6159 w3m-process-exit-status)
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))
6178 (setq charset "us-ascii")
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)
6201 (defun w3m-show-redirection-error-information (url page-buffer)
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))
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))))
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.
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\"."
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 ]*>\\)"
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)
6247 (if (string= "text/html" type)
6248 (let ((title (w3m-rendering-buffer charset)))
6249 (setf (w3m-arrived-title url) 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)
6256 (let ((result-buffer (current-buffer)))
6257 (with-current-buffer page-buffer
6258 (let ((inhibit-read-only t))
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))
6268 (defsubst w3m-image-page-displayed-p ()
6269 (and (fboundp 'image-mode-setup-winprops)
6271 (string-match "\\`image/" (w3m-content-type w3m-current-url))
6272 (eq (get-text-property (point-min) 'w3m-image-status) 'on)))
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))
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))
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)
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)
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)
6321 (with-current-buffer page-buffer
6322 (w3m-external-view url)
6325 (defun w3m-relationship-estimate (url)
6326 "Estimate relationships between a page and others."
6330 (dolist (rule w3m-relationship-estimate-rules)
6331 (when (apply (car rule) url (cdr rule))
6332 (throw 'estimated t)))))))
6334 (defun w3m-relationship-simple-estimate (url regexp &optional next previous
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)))
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>"
6347 (goto-char (point-min))
6348 (w3m-relationship-search-patterns
6351 (concat "<A HREF=" w3m-html-string-regexp ">\\[next>\\]</A>"))
6353 (concat "<A HREF=" w3m-html-string-regexp ">\\[<prev\\]</A>"))
6355 (concat "<A HREF=" w3m-html-string-regexp ">\\[<<start\\]</A>"))
6357 (concat "<A HREF=" w3m-html-string-regexp ">\\[index\\]</A>")))))
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)))))
6367 (defun w3m-relationship-slashdot-estimate (url)
6368 (goto-char (point-min))
6369 (when (and (string-match
6370 "slashdot\\.org/\\(article\\|comments\\)\\.pl\\?"
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)
6383 (match-string 1))))))
6384 (when (re-search-forward re max t)
6386 (w3m-expand-url (w3m-decode-anchor-string
6387 (or (match-string 2)
6389 (match-string 1)))))))))))
6391 (defun w3m-relationship-alc-estimate (url)
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>")
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>")
6405 (w3m-expand-url (match-string 1) url)))
6406 (unless (or w3m-previous-url w3m-next-url)
6408 (goto-char (point-min))
6409 (when (re-search-forward
6410 "<a href='javascript:goPage(\"\\([0-9+]\\)\")'>
\e$BA0$X
\e(B</a>"
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>"
6418 (w3m-expand-url (format "?pg=%s" (match-string 1)) url))))))
6420 (defun w3m-relationship-search-patterns (url next previous
6421 &optional start contents)
6422 "Search relationships with given patterns."
6423 (goto-char (point-min))
6425 (re-search-forward next nil t)
6427 (w3m-expand-url (w3m-decode-anchor-string (or (match-string 2)
6431 (goto-char (point-min)))
6433 (re-search-forward previous nil t)
6434 (setq w3m-previous-url
6435 (w3m-expand-url (w3m-decode-anchor-string (or (match-string 2)
6439 (goto-char (point-min)))
6441 (re-search-forward start nil t)
6443 (w3m-expand-url (w3m-decode-anchor-string (or (match-string 2)
6447 (goto-char (point-min)))
6449 (re-search-forward contents nil t)
6450 (setq w3m-contents-url
6451 (w3m-expand-url (w3m-decode-anchor-string (or (match-string 2)
6456 (defun w3m-search-name-anchor (name &optional quiet no-record)
6457 (interactive "sName: ")
6458 (let ((pos (point-min))
6462 (while (setq pos (next-single-property-change pos 'w3m-name-anchor))
6463 (when (member name (get-text-property pos 'w3m-name-anchor))
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))
6472 (when (eolp) (forward-line))
6473 (w3m-horizontal-on-screen)
6474 (throw 'found (setq found t))))
6476 (message "No such anchor: %s" name)))
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)))))
6490 (defun w3m-parent-page-available-p ()
6491 (if (null w3m-current-url)
6494 (string-match "\\`[a-z]+://?[^/]+/." w3m-current-url))))
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."
6503 (unless (integerp count)
6505 (setq count (abs count))
6507 ((and w3m-current-url
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))
6514 (let ((parent-url w3m-current-url))
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) "/"))))
6528 ((string-match "\\`[a-z]+:///?[^/]+/\\'" parent-url)
6531 (string-match "\\`[a-z]+:/+\\'" parent-url))
6532 (setq parent-url nil)
6533 (throw 'loop nil)))))
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"))))
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."
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)
6552 (let ((index (car w3m-name-anchor-from-hist))
6554 (if (and (integerp count)
6556 (< 0 (setq index (+ index count)))
6557 (setq pos (nth index w3m-name-anchor-from-hist)))
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))
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)
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"))))))
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."
6594 (w3m-view-previous-page (if (integerp count) (- count) -1)))
6596 (defun w3m-expand-path-name (file base)
6597 (let ((input (if (eq (elt file 0) ?/)
6599 (concat base file)))
6602 (while (string-match "^\\(?:\\.\\.?/\\)+" input)
6603 (setq input (substring input (match-end 0))))
6604 (while (not (zerop (length input)))
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)
6615 (let ((end (and (string-match "^/[^/]*" input)
6618 (concat output (substring input 0 end)))
6620 (substring input end))))))
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.")
6629 (defun w3m-expand-url (url &optional base)
6630 "Convert URL to the absolute address, and canonicalize it."
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)
6639 (substring base 0 (match-end 1))
6641 (substring base (match-beginning 5)))))
6642 (error "BASE must have a scheme part: %s" base))
6643 (setq base (or w3m-current-base-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)
6656 (setq url (concat (substring url 0 (match-beginning 6))
6657 (if (match-beginning 8)
6658 (substring url (match-beginning 8))
6660 base (progn (w3m-string-match-url-components base)
6661 (substring base 0 (match-beginning 6))))
6662 (w3m-string-match-url-components url))
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.
6672 (let ((scheme (match-string 2 url)))
6673 (if (and (member scheme w3m-url-hierarchical-schemes)
6675 (w3m-string-match-url-components base)
6676 (equal scheme (match-string 2 base))))
6677 (w3m-expand-url (substring url (match-end 1)) base)
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))
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)
6693 (w3m-expand-path-name
6694 (substring url 0 path-end)
6695 (or (file-name-directory (match-string 5 base))
6698 (substring base 0 (match-beginning 5))
6699 (if (member (match-string 2 base) w3m-url-hierarchical-schemes)
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))
6708 ;; URL has only a fragment part.
6709 (w3m-string-match-url-components base)
6710 (concat (substring base 0 (match-beginning 8))
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))
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)
6725 (defun w3m-view-this-url-1 (url reload new-session)
6726 (lexical-let ((cur w3m-current-url)
6728 (obuffer (current-buffer))
6729 (wconfig (current-window-configuration))
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.
6737 (w3m-string-match-url-components url)
6738 (match-beginning 8))
6739 (string-equal w3m-current-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))
6748 (w3m-display-progress-message url)))
6749 (setq buffer (current-buffer)))
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.
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)
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)
6779 (set-window-configuration wconfig)
6780 (unless (eq cur w3m-current-url)
6781 (w3m-recenter)))))))
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
6790 (interactive (if (member current-prefix-arg '(2 (16)))
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/"
6802 ((setq act (w3m-action))
6803 (let ((w3m-form-new-session new-session)
6804 (w3m-form-download nil))
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)
6812 ((setq url (w3m-active-region-or-url-at-point t))
6813 (unless (eq 'quit (setq url (w3m-input-url nil url 'quit nil
6815 (w3m-view-this-url-1 url arg new-session)))
6816 (t (w3m-message "No URL at point")))))
6819 (autoload 'mouse-set-point "mouse"))
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))
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))
6838 (url (w3m-url-valid (w3m-anchor start)))
6841 (setq urls (list url)))
6844 (setq all (not (and (bolp)
6846 (string-match "\\`http://\\(?:[^/]+\\.\\)*google\\."
6850 (and (> (point) prev)
6853 (when (and (setq url (w3m-url-valid (w3m-anchor)))
6854 (string-match "\\`https?:" url)
6858 (setq urls (nreverse urls))
6860 (setq url (car urls)
6863 (w3m-view-this-url-1 url arg t))))
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'
6870 (if (w3m-region-active-p)
6871 (call-interactively 'w3m-open-all-links-in-new-session)
6872 (w3m-view-this-url nil t)))
6874 (defun w3m-mouse-view-this-url-new-session (event)
6875 "Follow the link under the mouse pointer in a new session."
6877 (mouse-set-point event)
6878 (w3m-view-this-url nil t))
6880 (defun w3m-submit-form (&optional new-session)
6881 "Submit the form at point."
6883 (let ((submit (w3m-submit)))
6886 (w3m-url-valid w3m-current-url)
6887 (if w3m-submit-form-safety-check
6888 (prog1 (y-or-n-p "Submit? ") (message nil))
6890 (let ((w3m-form-new-session new-session)
6891 (w3m-form-download nil))
6893 (w3m-message "Can't submit form at this point"))))
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))
6900 (type (w3m-content-type url no-cache handler))
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)))))
6908 (if (w3m-url-local-p url)
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)))
6914 (funcall method url))
6917 ((command (w3m-which-command (car method)))
6918 (arguments (cdr method))
6919 (file (make-temp-name
6920 (expand-file-name "w3mel" w3m-profile-directory)))
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))))
6928 ((and command (memq 'file arguments))
6929 (let ((w3m-current-buffer (current-buffer)))
6931 (success (w3m-download url file no-cache handler))
6933 (w3m-external-view-file command file url arguments)))))
6935 (w3m-external-view-file command nil url arguments))
6937 (w3m-download url nil no-cache handler))))))))))))
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))
6946 (with-current-buffer
6947 (generate-new-buffer " *w3m-external-view*")
6949 (apply 'start-process
6953 (mapcar (function eval) arguments)))
6954 (w3m-message "Start %s..." (file-name-nondirectory command))
6955 (set-process-sentinel
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
6963 (file-exists-p file)
6964 (delete-file file)))
6965 (kill-buffer buffer))))))
6967 (file-exists-p file)
6968 (unless (and (processp proc)
6969 (memq (process-status proc) '(run stop)))
6970 (delete-file file)))))))
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
6977 (let ((url (w3m-url-valid (w3m-image))))
6979 (w3m-external-view url)
6980 (w3m-message "No image at point"))))
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."
6986 (let ((url (w3m-url-valid (w3m-image))))
6989 (w3m-message "No image at point"))))
6991 (defun w3m-external-view-this-url ()
6992 "Launch the external browser and display the link an point."
6994 (let ((url (w3m-url-valid (or (w3m-anchor) (w3m-image)))))
6996 (w3m-external-view url)
6997 (w3m-message "No URL at point"))))
6999 (defun w3m-external-view-current-url ()
7000 "Launch the external browser and display the current URL."
7003 (w3m-external-view w3m-current-url)
7004 (w3m-message "No URL at this page")))
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."
7015 (unless w3m-display-inline-images
7017 (when (y-or-n-p (format "Browse <%s> ? " w3m-current-url))
7019 (if (w3m-url-valid url)
7021 (message "Browsing <%s>..." url)
7022 (w3m-external-view url))
7023 (w3m-message "No URL at point")))
7025 (defun w3m-download-this-url ()
7026 "Download the file or the page pointed to by the link under point."
7028 (let ((url (or (w3m-anchor) (w3m-image))) act)
7030 ((w3m-url-valid url)
7031 (lexical-let ((pos (point-marker))
7032 (curl w3m-current-url))
7033 (w3m-process-with-null-handler
7035 (success (w3m-download url nil nil handler))
7037 (buffer-name (marker-buffer pos))
7038 (with-current-buffer (marker-buffer pos)
7039 (when (equal curl w3m-current-url)
7041 (w3m-refontify-anchor))))))))
7042 ((setq act (w3m-action))
7043 (let ((w3m-form-download t))
7046 (w3m-message "No URL at point")))))
7048 (defun w3m-download-this-image ()
7049 "Download the image under point."
7051 (let ((url (w3m-image)) act)
7053 ((w3m-url-valid url)
7054 (lexical-let ((pos (point-marker))
7055 (curl w3m-current-url))
7056 (w3m-process-with-null-handler
7058 (success (w3m-download url nil nil handler))
7060 (buffer-name (marker-buffer pos))
7061 (with-current-buffer (marker-buffer pos)
7062 (when (equal curl w3m-current-url)
7064 (w3m-refontify-anchor))))))))
7065 ((setq act (w3m-action))
7066 (let ((w3m-form-download t))
7069 (w3m-message "No image at point")))))
7071 (defun w3m-print-current-url ()
7072 "Display the current url in the echo area and put it into `kill-ring'."
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)))))
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
7088 (w3m-image-alt (point)))))
7089 (when (or url interactive-p)
7090 (and url interactive-p (kill-new url))
7092 (if (zerop (length alt))
7095 (or (w3m-url-readable-string url)
7096 (and (w3m-action) "There is a form")
7097 "There is no url")))))
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
7105 (w3m-image (point))))
7106 (alt (if interactive-p
7108 (w3m-image-alt (point)))))
7109 (when (or url interactive-p)
7110 (and url interactive-p (kill-new url))
7112 (if (zerop (length alt))
7115 (or (w3m-url-readable-string url)
7116 (and (w3m-action) "There is a form")
7117 "There is no image url")))))
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))))
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))
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))
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)
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.
7151 (null (progn (while ovs
7152 (if (overlay-get (car ovs) 'w3m-momentary-overlay)
7155 (setq ovs (cdr ovs)))
7157 (w3m-delete-all-overlays)
7159 (let ((seq (w3m-anchor-sequence))
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))))
7167 (while (and (zerop (forward-line -1))
7168 (w3m-highlight-current-anchor-1 seq))))))))
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))))
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)))))
7184 (defun w3m-edit-current-url ()
7185 "Edit this viewing page."
7188 (w3m-edit-url w3m-current-url)
7189 (w3m-message "No URL")))
7191 (defun w3m-edit-this-url ()
7192 "Edit the page linked from the anchor under the cursor."
7194 (let ((url (w3m-url-valid (w3m-anchor))))
7197 (w3m-message "No URL at point"))))
7199 (defvar w3m-goto-anchor-hist nil)
7200 (make-variable-buffer-local 'w3m-goto-anchor-hist)
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))
7208 ;; hseq is not sequence in form.
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)))))
7218 (defun w3m-next-anchor (&optional arg)
7219 "Move the point to the next anchor."
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)))
7229 (w3m-previous-anchor (- arg))
7232 (unless (w3m-goto-next-anchor)
7233 (setq w3m-goto-anchor-hist nil)
7234 (if (w3m-imitate-widget-button)
7236 (when (setq pos (text-property-any
7237 (point-min) (point-max) 'w3m-anchor-sequence 1))
7240 (if (member (w3m-anchor-sequence) w3m-goto-anchor-hist)
7242 (push (w3m-anchor-sequence) w3m-goto-anchor-hist))))
7243 (w3m-horizontal-on-screen)
7244 (w3m-print-this-url)))
7246 (defun w3m-goto-previous-anchor ()
7247 (let ((hseq (w3m-anchor-sequence))
7248 (pos (previous-single-property-change (point) 'w3m-anchor-sequence)))
7250 ((and (not hseq) pos)
7251 (if (w3m-anchor-sequence 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)
7258 ;; hseq is not sequence in form.
7260 (setq hseq (1- hseq))
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))))))
7268 (defun w3m-previous-anchor (&optional arg)
7269 "Move the point to the previous anchor."
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)))
7279 (w3m-next-anchor (- arg))
7282 (unless (w3m-goto-previous-anchor)
7283 (setq w3m-goto-anchor-hist nil)
7284 (if (w3m-imitate-widget-button)
7286 (when (setq pos (and w3m-max-anchor-sequence
7288 (point-min) (point-max)
7289 'w3m-anchor-sequence
7290 w3m-max-anchor-sequence)))
7293 (if (member (w3m-anchor-sequence) w3m-goto-anchor-hist)
7295 (push (w3m-anchor-sequence) w3m-goto-anchor-hist))))
7296 (w3m-horizontal-on-screen)
7297 (w3m-print-this-url)))
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)))
7310 (defun w3m-next-form (&optional arg)
7311 "Move the point to the next form."
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)))
7321 (w3m-previous-form (- arg))
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))
7329 (if (member (w3m-action (point)) w3m-goto-anchor-hist)
7331 (push (w3m-action (point)) w3m-goto-anchor-hist)))
7332 (w3m-horizontal-on-screen)
7333 (w3m-print-this-url)))
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))
7340 ;; Find the previous form.
7341 (let ((pos (previous-single-property-change (point) 'w3m-action)))
7344 (if (w3m-action pos)
7346 (previous-single-property-change pos 'w3m-action))))))
7348 (defun w3m-previous-form (&optional arg)
7349 "Move the point to the previous form."
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)))
7359 (w3m-next-form (- arg))
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))
7367 (if (member (w3m-action (point)) w3m-goto-anchor-hist)
7369 (push (w3m-action (point)) w3m-goto-anchor-hist)))
7370 (w3m-horizontal-on-screen)
7371 (w3m-print-this-url)))
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)))
7384 (defun w3m-next-image (&optional arg)
7385 "Move the point to the next image."
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)))
7397 (w3m-previous-image (- arg))
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))
7405 (if (member (w3m-image (point)) w3m-goto-anchor-hist)
7407 (push (w3m-image (point)) w3m-goto-anchor-hist)))
7408 (w3m-horizontal-on-screen)
7409 (w3m-print-this-url)))
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))
7416 ;; Find the previous form or image.
7417 (let ((pos (previous-single-property-change (point) 'w3m-image)))
7420 (if (w3m-image pos) pos
7421 (previous-single-property-change pos 'w3m-image))))))
7423 (defun w3m-previous-image (&optional arg)
7424 "Move the point to the previous image."
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)))
7435 (w3m-next-image (- arg))
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))
7443 (if (member (w3m-image (point)) w3m-goto-anchor-hist)
7445 (push (w3m-image (point)) w3m-goto-anchor-hist)))
7446 (w3m-horizontal-on-screen)
7447 (w3m-print-this-url)))
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.
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.
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: "))
7469 (setq buffer (current-buffer)))
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
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)))
7486 (set-buffer (setq new (w3m-generate-new-buffer newname)))
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
7495 w3m-default-display-inline-images)))
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))
7501 ;; When empty and just-copy, stay origianl buffer.
7504 ;; Need to change to the `new' buffer in which `w3m-goto-url' runs.
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
7518 (not (get-buffer-window buffer)))
7519 (set-window-buffer (selected-window) buffer))))
7522 (defun w3m-next-buffer (arg)
7523 "Turn ARG pages of emacs-w3m buffers ahead."
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)))
7531 (nth (mod (+ arg (- len (length (memq (current-buffer) buffers))))
7534 (w3m-history-restore-position)
7535 (run-hooks 'w3m-select-buffer-hook)
7536 (w3m-select-buffer-update)))
7538 (defun w3m-previous-buffer (arg)
7539 "Turn ARG pages of emacs-w3m buffers behind."
7541 (w3m-next-buffer (- arg)))
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)."
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))
7558 (setq cur (current-buffer))
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)
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)
7578 ;; Look for the buffer which is not shown in the current frame.
7581 (w3m-next-buffer -1)
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.
7592 (unless (get-buffer-window (setq buf (pop buffers)) t)
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)
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)
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)))
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
7628 (with-current-buffer buffer
7629 (unless (or w3m-current-process
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))))
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."
7643 (let ((count 1) number newname)
7644 (dolist (buffer (w3m-list-buffers))
7645 (setq number (w3m-buffer-number buffer))
7647 (unless (eq number count)
7648 (when (and (setq newname (w3m-buffer-set-number buffer count))
7650 (w3m-form-set-number buffer newname)))
7653 (defun w3m-delete-other-buffers (&optional buffer)
7654 "Delete emacs-w3m buffers except for BUFFER or the current 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)))
7662 (defun w3m-delete-left-tabs ()
7663 "Delete tabs on the left side of the current tab."
7665 (let ((cbuf (current-buffer))
7667 (setq bufs (catch 'done
7668 (dolist (buf (w3m-list-buffers))
7671 (setq bufs (cons buf bufs))))))
7673 (w3m-delete-buffers bufs))))
7675 (defun w3m-delete-right-tabs ()
7676 "Delete tabs on the right side of the current tab."
7678 (let ((bufs (w3m-righttab-exist-p)))
7680 (w3m-delete-buffers bufs))))
7682 (defun w3m-delete-buffers (buffers)
7683 "Delete emacs-w3m buffers."
7686 (w3m-session-deleted-save buffers))
7688 (setq buffer (pop buffers))
7689 (w3m-process-stop buffer)
7690 (w3m-idle-images-show-unqueue buffer)
7691 (kill-buffer buffer)
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))
7699 (defvar w3m-ctl-c-map nil
7700 "Sub-keymap used for the `C-c'-prefixed commands.
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)))
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)))
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)))
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.
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))
7800 (define-key map [mouse-3] 'w3m-mouse-major-mode-menu)))
7801 (if (featurep 'xemacs)
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)))
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)
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.
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))
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
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)))
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
7996 (let* ((buffers (w3m-list-buffers t))
7997 (buf (car buffers)))
8001 (while (and (not visible)
8003 (when (get-buffer-window (car buffers) t)
8004 (setq visible (car buffers)))
8005 (setq buffers (cdr buffers)))
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'."
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? ")
8022 (let ((w3m-fb-mode nil))
8024 (prog1 (y-or-n-p "Do you want to exit emacs-w3m? ")
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)
8033 (w3m-form-kill-buffer buffer)))
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))))
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'."
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))
8059 (w3m-delete-frames-and-windows)
8061 (setq buf (pop bufs))
8062 (w3m-cancel-refresh-timer buf)
8065 (setq buf (pop buffers)
8066 windows (get-buffer-window-list buf 'no-minibuf t))
8068 (setq window (pop windows))
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
8078 (set-buffer (window-buffer (selected-window)))
8079 (while (eq major-mode 'w3m-mode)
8082 (unless w3m-mode-map
8084 (if (eq w3m-key-binding 'info)
8086 w3m-lynx-like-map)))
8088 (defun w3m-mouse-major-mode-menu (event)
8089 "Pop up a W3M mode-specific menu of mouse commands."
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
8098 ,@w3m-bookmark-menu-items-pre)
8100 (w3m-static-if (featurep 'xemacs)
8102 (when current-menubar
8103 (run-hooks 'activate-menubar-hook))
8107 `(,@(cdr w3m-rmouse-menubar)
8110 ,(assoc "w3m" current-menubar)
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
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
8129 w3m-session-menu-items-pre)
8130 w3m-session-menu-items))))
8133 (defvar w3m-tab-button-menu-current-buffer nil
8134 "Internal variable used by `w3m-tab-button-menu'.")
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)
8150 ,(w3m-make-menu-item "
\e$B%?%V$rJ#@=
\e(B" "Copy Tab")
8151 ,currentp ,w3m-new-session-in-background)
8153 (w3m-reload-this-page
8154 ,(w3m-make-menu-item "
\e$B%?%V$r:FFI$_9~$_
\e(B" "Reload Tab")
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")
8161 ,(w3m-make-menu-item "
\e$B$3$N%?%V$rJD$8$k
\e(B" "Close This Tab")
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")
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")
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")
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)
8179 ,(w3m-make-menu-item "
\e$B$9$Y$F$N%?%V$rJ]B8$9$k
\e(B" "Save All Tabs...")
8182 ,(w3m-make-menu-item "
\e$B%?%V%j%9%H$rA*Br$9$k
\e(B" "Select List of Tabs...")
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..." )
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:
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.")
8201 (w3m-static-unless (featurep 'xemacs)
8203 w3m-tab-button-menu w3m-tab-map "w3m tab button menu."
8204 (cons nil (w3m-make-menu-commands w3m-tab-button-menu-commands)))
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))
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)))
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.
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))
8227 (define-key w3m-link-map [mouse-3] 'w3m-link-menu))))
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))]
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..."
8246 w3m-download-this-url (w3m-anchor (point))]
8247 [,(w3m-make-menu-item "
\e$BL>A0$rIU$1$F2hA|$rJ]B8
\e(B..."
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))]))
8257 (defun w3m-link-menu (event)
8258 "Pop up a link menu."
8260 (mouse-set-point event)
8261 (popup-menu w3m-link-menu))
8263 (defvar w3m-buffer-unseen nil)
8264 (make-variable-buffer-local 'w3m-buffer-unseen)
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))
8270 (defun w3m-set-buffer-seen ()
8271 (setq w3m-buffer-unseen nil)
8272 (w3m-remove-local-hook 'pre-command-hook 'w3m-set-buffer-seen))
8274 (defun w3m-move-unseen-buffer ()
8275 "Move to the next unseen buffer."
8277 (when (eq major-mode 'w3m-mode)
8278 (let* ((bufs (w3m-list-buffers))
8279 (right (memq (current-buffer) bufs))
8283 (dolist (buf (append right bufs))
8284 (when (w3m-unseen-buffer-p buf)
8285 (throw 'unseen buf)))))
8287 (message "No unseen buffer.")
8288 (switch-to-buffer unseen)
8289 (run-hooks 'w3m-select-buffer-hook)
8290 (w3m-select-buffer-update)))))
8293 "Major mode for browsing web.
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\
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.
8312 \\[w3m-submit-form] Submit the form at point.
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\
8319 \\[w3m-redisplay-with-charset] Redisplay the current page, specifying\
8321 \\[w3m-redisplay-and-reset] Redisplay the current page and reset\
8322 the user-specified charset and\n\tcontent type.
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.
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\
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\
8343 \\[w3m-download] Download the URL.
8344 \\[w3m-download-this-url] Download the URL under point.
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.
8353 \\[w3m-print-this-url] Display the url under point and put it into\
8355 \\[w3m-print-current-url] Display the url of the current page and put\
8356 it into `kill-ring'.
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\
8362 \\[w3m-edit-this-url] Edit the local file which is pointed to by URL under\
8365 \\[w3m-scroll-up-or-next-url] Scroll up the current window, or go to the\
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\
8379 \\[next-line] Next line.
8380 \\[previous-line] Previous line.
8381 \\[forward-char] Forward char.
8382 \\[backward-char] Backward char.
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.
8388 \\[w3m-history] Display the history of pages you have visited in the\
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.
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\
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\
8412 \\[w3m-bookmark-add-this-url] Add the url under point to the bookmark.
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\
8423 \\[w3m] Start browsing web with emacs-w3m.
8424 \\[w3m-close-window] Close all emacs-w3m windows, without deleteing\
8426 \\[w3m-quit] Exit browsing web. All emacs-w3m buffers will be deleted.
8428 \\[describe-mode] describe-mode.
8430 \\[report-emacs-w3m-bug] Send a bug report to the emacs-w3m team.
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)
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))
8453 (run-hooks 'w3m-mode-setup-functions)
8454 (w3m-run-mode-hooks 'w3m-mode-hook))
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
8463 (w3m-static-unless (featurep 'xemacs)
8464 (when (and (numberp arg)
8466 (numberp scroll-margin)
8467 (> scroll-margin 0))
8469 (max 0 (- (count-lines (window-start) (point-max))
8473 (defun w3m-scroll-up-or-next-url (arg)
8474 "Scroll the current window up ARG lines, or go to the next page."
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))
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))))
8486 (defun w3m-scroll-down-or-previous-url (arg)
8487 "Scroll the current window down ARG lines, or go to the previous page."
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))))
8499 (defvar w3m-current-longest-line nil
8500 "The length of the longest line in the window.")
8502 (defun w3m-set-current-longest-line ()
8503 "Set the value of `w3m-current-longest-line'."
8505 (goto-char (window-start))
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))))
8512 (skip-chars-backward " ")
8513 (setq w3m-current-longest-line
8514 (max w3m-current-longest-line (current-column)))
8516 (< (point) end))))))
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'."
8523 (when (if (memq last-command '(w3m-scroll-left w3m-shift-left))
8524 (or (< (window-hscroll) w3m-current-longest-line)
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))))
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'."
8537 (if (zerop (window-hscroll))
8538 (when (memq last-command '(w3m-scroll-right w3m-shift-right))
8540 (w3m-horizontal-scroll 'right (if arg
8541 (prefix-numeric-value arg)
8542 w3m-horizontal-scroll-columns))))
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'."
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)
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)))))
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'."
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))
8570 (w3m-horizontal-scroll 'right (if arg
8571 (prefix-numeric-value arg)
8572 w3m-horizontal-shift-columns)))))
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)
8579 (defun w3m-auto-show ()
8580 "Scroll horizontally so that the point is visible."
8581 (when (and truncate-lines
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))
8593 (marker-position (nth 1 w3m-current-position)))
8595 (marker-position (nth 2 w3m-current-position))))))
8596 (w3m-horizontal-on-screen))
8597 (setq w3m-horizontal-scroll-done nil))
8599 ;; Ailiases to meet XEmacs bugs?
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)))
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
8615 (setq w3m-horizontal-scroll-done t)
8616 (let ((inhibit-point-motion-hooks t))
8617 (w3m-set-window-hscroll (selected-window)
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))))))))
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
8633 (setq w3m-horizontal-scroll-done t)
8634 (let ((cc (w3m-current-column))
8635 (hs (w3m-window-hscroll))
8637 (inhibit-point-motion-hooks t))
8638 (unless (and (>= (- cc hs) 0)
8639 (< (+ (- cc hs) (if (eolp)
8641 (w3m-static-if (featurep 'xemacs)
8644 (w3m-set-window-hscroll
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))))))))))
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
8658 (cond ((< (w3m-current-column) (window-hscroll))
8659 (move-to-column (w3m-window-hscroll))
8661 ((>= (w3m-current-column) (+ (window-hscroll) (window-width)))
8662 (move-to-column (+ (w3m-window-hscroll) (window-width) -2))
8665 (setq arg (car arg))))
8666 (w3m-set-window-hscroll
8670 (max (- (current-column) arg) 0)
8671 (let* ((home (point))
8672 (inhibit-point-motion-hooks t)
8675 (1- (current-column))
8677 (max (min (- (current-column)
8683 (max (- (current-column) (/ (window-width) 2) -1)
8685 (set-window-hscroll (selected-window) 0)))
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
8695 (defun w3m-beginning-of-line (&optional arg)
8696 "Make the beginning of the line visible and move the point to there."
8698 (if (w3m-image-page-displayed-p)
8699 (image-bol (or arg 1))
8700 (w3m-keep-region-active)
8702 (setq arg (car arg)))
8703 (set-window-hscroll (selected-window) 0)
8704 (beginning-of-line arg)))
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'."
8711 (if (w3m-image-page-displayed-p)
8712 (image-eol (or arg 1))
8713 (w3m-keep-region-active)
8717 (setq arg (car arg)))
8718 (forward-line (1- (or arg 1)))
8719 (let ((inhibit-point-motion-hooks t)
8723 arg (current-column))
8724 (dolist (n '(-3 -2 -1 1 2 3))
8727 (setq arg (max (current-column) arg))
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))))
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))
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)
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))))))
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)
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)))
8781 (setq info (rfc2368-parse-mailto-url url))
8783 (append (mapcar (lambda (x)
8784 (cdr (assoc x info)))
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
8800 (setq buffer (car buffers)
8801 buffers (cdr buffers))
8802 (unless (memq buffer before)
8804 (when (setq function
8805 (cdr (assq major-mode
8806 w3m-mailto-url-popup-function-alist)))
8807 (setq buffers nil)))))
8809 (let (special-display-buffer-names
8810 special-display-regexps
8811 same-window-buffer-names
8812 same-window-regexps)
8813 (funcall function buffer)))))
8815 (defun w3m-convert-ftp-url-for-emacsen (url)
8816 (or (and (string-match "^ftp://?\\([^/@]+@\\)?\\([^/]+\\)\\(?:/~/\\)?" url)
8818 (if (match-beginning 1)
8819 (substring url (match-beginning 1) (match-end 1))
8821 (substring url (match-beginning 2) (match-end 2))
8823 (substring url (match-end 2))))
8824 (error "URL is strange")))
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)
8832 (setq dirp (car (file-attributes file)))
8834 (setq file (expand-file-name
8836 (file-name-directory (directory-file-name file)))
8838 (throw 'loop dirp)))))))
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))
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))
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)
8862 (format "File(%s) already exists. Overwrite? "
8866 (delete-file filename)
8868 (error "Permission denied, %s" filename)))
8869 (copy-file ftp filename)
8870 (message "Wrote %s" filename)))))
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))
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
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
8886 (setq buffer (pop buffers))
8887 (if (and (string-match regexp (buffer-name buffer))
8890 (eq major-mode 'doc-view-mode))
8891 (equal buffer-file-name url))
8893 (setq buffer nil))))
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)
8904 (set-buffer-modified-p nil)
8905 (setq buffer-file-name url)
8907 (use-local-map w3m-doc-view-map)
8908 (set-keymap-parent w3m-doc-view-map doc-view-mode-map)
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."
8915 (cond (w3m-pop-up-frames
8916 (when (prog1 (one-window-p t) (quit-window kill))
8917 (delete-frame (selected-frame))))
8919 (if (fboundp 'quit-window)
8923 (set-buffer-modified-p nil)
8924 (kill-buffer (current-buffer)))
8926 (unless (eq (next-window nil 'no-mini) (selected-window))
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.
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))))
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)))))
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))))
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)))
8975 (set-buffer (w3m-generate-new-buffer "*w3m*"))
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
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
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
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))))
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)
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)
9025 (unless (fboundp 'format-mode-line)
9026 (defalias 'format-mode-line 'ignore)))
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
9033 (when w3m-current-title
9034 (or (and w3m-modeline-title-timer w3m-modeline-title-string)
9036 (setq w3m-modeline-title-string w3m-current-title
9037 w3m-modeline-title-timer t)
9038 (let ((excess (- (string-width
9040 (format-mode-line mode-line-format 1)
9043 (tlen (string-width w3m-current-title)))
9044 (when (and (> excess 0)
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))
9052 w3m-modeline-title-string)
9053 (run-at-time 0.5 nil
9055 (when (buffer-live-p buffer)
9056 (with-current-buffer buffer
9057 (setq w3m-modeline-title-timer nil))))
9058 (current-buffer)))))))
9060 (defconst w3m-buffer-local-url "buffer://")
9061 (defun w3m-buffer-local-url-p (url)
9063 (string-match (concat "^" w3m-buffer-local-url) url)))
9066 (defun w3m-goto-url (url &optional reload charset post-data referer handler
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
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
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'.
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
9091 (list (w3m-input-url nil nil nil nil 'feeling-lucky)
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))
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))
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))
9135 (funcall (if (functionp w3m-local-find-file-function)
9136 w3m-local-find-file-function
9137 (eval w3m-local-find-file-function))
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))
9148 ((and (string= file-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.
9160 (w3m-popup-buffer (current-buffer)))
9161 (w3m-cancel-refresh-timer (current-buffer))
9162 (when w3m-current-process
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))
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
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
9187 (w3m-goto-url url))))))
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))
9195 (post-data post-data)
9198 (history-position (get-text-property (point)
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)))
9207 (if (and (equal referer "about://history/")
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)
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))))
9243 (if (and (not reload)
9245 (stringp w3m-current-url)
9246 (string= url w3m-current-url))
9248 (w3m-refontify-anchor)
9250 (when w3m-name-anchor-from-hist
9251 (w3m-history-plist-put
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)
9266 (w3m-history-push w3m-current-url
9267 (list :title (or w3m-current-title
9269 (goto-char (point-min)))
9272 ;; Redisplay to search an anchor sure.
9274 (w3m-search-name-anchor
9275 (w3m-url-transfer-encode-string
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
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
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))
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)
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)
9332 "\\`about://\\(?:header\\|source\\)/"
9334 (equal (w3m-content-type w3m-current-url)
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))))
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'."
9350 (if (string-match "\\`ftp://" url)
9352 (setq file (w3m-convert-ftp-url-for-emacsen url))
9353 (file-name-as-directory
9354 (if (string-match "/\\`" 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)
9362 (file-name-directory file)))))))
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))
9372 (file-directory-p directory)
9373 (expand-file-name directory))
9374 (and (functionp w3m-default-directory)
9375 (stringp (setq directory
9377 (funcall w3m-default-directory url)
9379 (file-directory-p directory)
9380 (expand-file-name directory))
9381 w3m-profile-directory)))))
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)
9390 'w3m-goto-url-with-timer
9391 (cdr w3m-current-refresh)
9392 (current-buffer))))))
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))
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)))
9419 (with-current-buffer buffer
9420 (w3m-cancel-refresh-timer buffer))))))
9422 (defun w3m-goto-new-session-url (&optional reload)
9423 "Open `w3m-new-session-url' in a new session."
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)))
9430 (defun w3m-goto-url-new-session (url &optional reload charset post-data
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."
9437 (list (w3m-input-url nil nil nil nil 'feeling-lucky)
9439 (w3m-static-if (fboundp 'universal-coding-system-argument)
9440 coding-system-for-read)
9444 (if (or (eq 'w3m-mode major-mode)
9445 (and (setq buffer (w3m-alive-p))
9447 (w3m-popup-buffer buffer)
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
9456 (w3m-display-progress-message url)
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.
9463 (w3m-string-match-url-components url)
9464 (match-beginning 8))
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))))
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))))
9480 (defun w3m-gohome ()
9481 "Go to the Home page."
9483 (unless w3m-home-page
9484 (error "You have to specify the value of `w3m-home-page'"))
9485 (w3m-goto-url w3m-home-page))
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."
9492 (let ((w3m-history-reuse-history-elements
9493 ;; Don't move the history position.
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)
9507 (w3m-history-element (cadar w3m-history) t)
9509 (w3m-history-restore-position))
9510 (w3m-message "Can't reload this page")))
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."
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)))))
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."
9530 (if (null w3m-current-url)
9531 (w3m-message "Can't redisplay this page")
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.
9538 (w3m-history-store-position)
9539 (w3m-goto-url w3m-current-url 'redisplay)
9540 (w3m-history-restore-position))))
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)."
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))
9557 (w3m-redisplay-this-page arg)))
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)."
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))
9571 (w3m-read-content-charset
9572 (format "Content-charset (current %s, default reset): "
9573 w3m-current-coding-system)))
9574 (w3m-redisplay-this-page arg)))
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)."
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)))
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"))
9603 (if (and url (not (string-match "\\`-" url)))
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)
9614 (when (and (equal (cadr args) "w3m")
9615 (member (car args) directives))
9616 (setq url (or w3m-home-page "about:"))))
9618 (and command-line-args-left
9620 (setq args (reverse command-line-args-left))
9622 (not (and (setq args (cdr (member "w3m" args)))
9623 (member (car args) directives)))))
9625 (defalias 'w3m-examine-command-line-args (lambda nil)))
9626 ;; Inhibit the startup screen.
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)))
9637 (not (symbol-value var)))
9639 (setq fn (make-symbol "w3m-inhibit-startup-screen"))
9640 (fset fn `(lambda nil
9642 (remove-hook 'window-setup-hook ',fn)
9643 (fmakunbound ',fn)))
9644 (add-hook 'window-setup-hook fn))))
9648 (defun w3m (&optional url new-session interactive-p)
9649 "Visit World Wide Web pages using the external w3m command.
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.
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
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).
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.
9670 You can also run this command in the batch mode as follows:
9672 emacs -f w3m http://emacs-w3m.namazu.org/ &
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
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.
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."
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))
9698 (let ((default (if (w3m-alive-p) 'popup w3m-home-page)))
9699 (setq new (if current-prefix-arg
9701 (w3m-input-url nil nil default w3m-quick-start
9704 (and w3m-make-new-session
9706 (not (eq new 'popup)))
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)
9718 ;; This command was possibly be called non-interactively or as
9720 (setq url (or (w3m-examine-command-line-args)
9721 ;; Unlikely but this function was called with no url.
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*"))
9729 (w3m-popup-buffer buffer)
9731 ;; `unwind-protect' is needed since a process may be terminated by C-g.
9733 (let* ((crash (and (not alived)
9734 (w3m-session-last-crashed-session)))
9735 (last (and (not alived)
9737 (w3m-session-last-autosave-session))))
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)))))
9745 (autoload 'browse-url-interactive-arg "browse-url"))
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'."
9755 (require 'browse-url)
9756 (browse-url-interactive-arg "Emacs-w3m URL: ")))
9758 (setq url (w3m-canonicalize-url url))
9760 (w3m-goto-url-new-session url)
9761 (w3m-goto-url url))))
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)
9770 (w3m-static-if (fboundp 'universal-coding-system-argument)
9771 coding-system-for-read)))
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)
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."
9788 (list (region-beginning)
9790 (w3m-expand-file-name-as-url
9791 (or (buffer-file-name) default-directory))))
9793 (w3m-process-stop (current-buffer))
9794 (narrow-to-region start end)
9795 (w3m-clear-local-variables)
9796 (let ((w3m-current-buffer (current-buffer)))
9798 (setq charset (w3m-correct-charset (w3m-detect-meta-charset))))
9800 w3m-buffer-local-url)
9802 w3m-current-base-url url
9803 w3m-current-coding-system
9805 (w3m-charset-to-coding-system charset)
9808 (let (w3m-use-refresh)
9809 (w3m-rendering-buffer charset)))
9811 (when (w3m-display-inline-images-p)
9812 (and w3m-force-redisplay (sit-for 0))
9813 (w3m-toggle-inline-images 'force)))))
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))
9824 (defun w3m-about (url &rest args)
9825 (insert "<!doctype html public \"-//W3C//DTD HTML 3.2//EN\">
9827 <head><title>About emacs-w3m</title></head>
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>,
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."
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)
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)))))
9863 (w3m-goto-url (concat "about://source/" w3m-current-url))))
9864 (w3m-history-restore-position))
9865 (w3m-message "Can't view page source")))
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) ?-)))
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))
9881 "\nDocument Type: " (or (w3m-content-type url) "")
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)))))
9888 (concat "\nCurrent Anchor: " anchor)
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)
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))
9911 (while (and (not (eobp)) (looking-at "^[ \t]"))
9913 (setq ssl (buffer-substring beg (point)))
9914 (delete-region beg (point))
9917 (goto-char (point-max))
9918 (insert separator "\n\nSSL Information\n\n")
9922 (while (re-search-forward "^\t" nil t)
9924 (when (looking-at "Certificate:")
9928 (defun w3m-view-header ()
9929 "Display the header of the current page."
9932 (let ((w3m-prefer-cache t)
9933 (w3m-history-reuse-history-elements t)
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)
9944 (concat "about://header/" w3m-current-url)))))
9947 (w3m-history-store-position)
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")))
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
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.")
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)))
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))
9982 ;; Don't use `caddr' here, since it won't
9983 ;; be substituted by the compiler macro.
9985 (car (cdr (cdr e))))
9987 (cur (current-buffer))
9988 (margin (if (> w3m-about-history-indent-level 1)
9991 (max-indent (condition-case nil
9992 ;; Force the value to be a number or nil.
9993 (+ 0 (eval w3m-about-history-max-indentation))
9997 element url about title position bol indent)
9999 (setq element (pop history)
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))
10007 (insert (format "h%s %d %d <a href=\"%s\">%s%s%s %s</a>\n"
10008 (mapconcat (lambda (d) (format form d))
10011 (/ (1- (length position)) 2)
10012 (if (equal current position) 1 0)
10014 (if about "<" "")
10015 (if (or (not title)
10016 (string-equal "<no-title>" title)
10017 (string-match "^[\t
\e$B!!
\e(B]*$" title))
10019 (w3m-encode-specials-string title))
10020 (if about ">" "")
10022 (sort-fields 0 start (point-max))
10024 (while (not (eobp))
10026 (skip-chars-forward "^ ")
10027 (setq indent (read cur)
10028 sub-indent (if (= indent last-indent)
10032 indent (+ (* w3m-about-history-indent-level indent)
10036 (delete-region bol (point))
10037 (insert-char ?\ (+ margin (if max-indent
10038 (min max-indent indent)
10040 (beginning-of-line)
10043 (forward-line 1))))
10044 (insert "</pre></body>")
10047 (defun w3m-about-db-history (url &rest args)
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
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)))
10067 (setq alist (sort alist
10069 (w3m-time-newer-p (cdr a) (cdr b))))))
10070 (setq total (length alist))
10071 (setq alist (nthcdr start alist))
10075 (format "about://db-history/?start=%d&size=%d"
10076 (max 0 (- start size)) size)))
10077 (when (> (length alist) size)
10079 (format "about://db-history/?start=%d&size=%d"
10080 (+ start size) size)))
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) "")
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) "")))
10095 "<p align=\"left\">"
10097 (format "[<a href=\"%s\">Prev History</a>]" prev)
10100 (format "[<a href=\"%s\">Next History</a>]" next)
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")
10110 (>= (decf size) 0)))
10111 (setq url (car (car alist))
10112 time (cdr (car 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>"
10122 (w3m-encode-specials-string title)))
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))
10130 (insert "</tr>\n"))
10132 (if next "\n<br>\n<hr>\n" "")
10134 (insert "</body></html>\n"))
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))
10144 ;; Make history position data invisible.
10145 (goto-char (point-min))
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))
10156 (skip-chars-forward "\t "))
10157 ;; Highlight the current url.
10158 (goto-char (point-min))
10159 (when (search-forward "\n>" nil t)
10161 (setq start (point))
10163 (w3m-add-face-property start (point) 'w3m-history-current-url)
10164 (goto-char start)))
10165 (set-buffer-modified-p nil)))
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."
10171 :type '(radio (const :tag "All entries are displayed in single page." nil)
10172 (integer :format "%t: %v\n" :size 0)))
10174 (defun w3m-db-history (&optional start size)
10175 "Display arrived URLs."
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) ""))))
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."
10187 (w3m-goto-url "about://history/")
10188 (w3m-db-history nil w3m-db-history-display-size)))
10190 (defun w3m-w32-browser-with-fiber (url)
10191 (let ((proc (start-process "w3m-w32-browser-with-fiber"
10194 (if (w3m-url-local-p url)
10195 (w3m-url-to-file-name url)
10197 (set-process-filter proc 'ignore)
10198 (set-process-sentinel proc 'ignore)))
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."
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
10211 (y-or-n-p (format "Pipe <%s> ? " w3m-current-url))
10215 (if (and (w3m-url-valid url)
10217 (setq command (read-string "Command: "))
10218 (not (string-match "\\`[\000-\040]*\\'" command))))
10220 (list 'none nil))))
10221 (cond ((eq url 'none) nil)
10222 ((and (stringp url)
10223 (w3m-url-valid url)
10225 (not (string-match "\\`[\000-\040]*\\'" command)))
10226 (w3m-message "Pipe <%s> to \"| %s\"..." url command)
10228 (set-buffer-multibyte nil)
10229 (w3m-process-with-wait-handler
10230 (w3m-retrieve (cond ((string-match "\\`about://source/" url)
10232 ((string-match "\\`about://header/" url)
10233 (concat "about://source/"
10234 (substring url (match-end 0))))
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*")))
10241 (not (zerop (buffer-size buffer))))
10242 (display-buffer buffer)))))
10243 (t (error "Can't pipe page source"))))
10245 ;;; Interactive select buffer.
10246 (defcustom w3m-select-buffer-horizontal-window t
10247 "*Non-nil means split windows horizontally to open the selection window."
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."
10256 :type '(cons (integer :format "H: %v[%%] " :size 0)
10257 (integer :format "V: %v[%%]\n" :size 0)))
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.")
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)
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.
10274 (or w3m-fill-column -1))))
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:
10281 \\{w3m-select-buffer-mode-map}"
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)))
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))
10305 (w3m-select-buffer-generate-contents current-buffer))
10306 (w3m-select-buffer-mode)
10307 (or nomsg (w3m-message w3m-select-buffer-message)))
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)))
10314 (w3m-force-window-update)))
10316 (defun w3m-select-buffer-generate-contents (current-buffer)
10318 (inhibit-read-only t))
10319 (delete-region (point-min) (point-max))
10320 (dolist (buffer (w3m-list-buffers))
10321 (put-text-property (point)
10323 (insert (format "%d:%s %s\n" (incf i)
10324 (if (w3m-unseen-buffer-p buffer)
10326 (w3m-buffer-title buffer)))
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)
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)))
10380 (defun w3m-select-buffer-mode ()
10381 "Major mode for switching emacs-w3m buffers using the buffer list.
10383 \\<w3m-select-buffer-mode-map>\
10384 \\[w3m-select-buffer-next-line]\
10386 \\[w3m-select-buffer-previous-line]\
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.
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.
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.
10412 (setq major-mode 'w3m-select-buffer-mode
10413 mode-name "w3m buffers"
10415 buffer-read-only t)
10416 (use-local-map w3m-select-buffer-mode-map)
10417 (w3m-run-mode-hooks 'w3m-select-buffer-mode-hook))
10419 (defun w3m-select-buffer-recheck ()
10420 "Do the roll call to all emacs-w3m buffers and regenerate the menu."
10422 (let ((inhibit-read-only t))
10424 (w3m-select-buffer-generate-contents
10425 (window-buffer w3m-select-buffer-window))
10426 (w3m-select-buffer-show-this-line))
10428 (defmacro w3m-select-buffer-current-buffer ()
10429 '(get-text-property (point-at-bol) 'w3m-select-buffer))
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))
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)))
10439 (error "No buffer at point"))
10441 ((get-buffer-window buffer)
10442 (setq w3m-select-buffer-window (get-buffer-window buffer)))
10443 ((window-live-p w3m-select-buffer-window)
10446 (setq w3m-select-buffer-window (selected-window))
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)
10461 (defun w3m-select-buffer-show-this-line-and-down ()
10462 "Show the buffer on the current menu line or scroll it down."
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)))))
10472 (defun w3m-select-buffer-next-line (&optional n)
10473 "Move cursor vertically down N lines and show the buffer on the menu."
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)))))
10483 (defun w3m-select-buffer-previous-line (&optional n)
10484 "Move cursor vertically up N lines and show the buffer on the menu."
10486 (w3m-select-buffer-next-line (- n)))
10488 (defun w3m-select-buffer-copy-buffer ()
10489 "Create a copy of the buffer on the current menu line, and show it."
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
10498 (select-window window)))
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)."
10506 (w3m-select-buffer-show-this-line)
10507 (if (= 1 (count-lines (point-min) (point-max)))
10509 (let ((buffer (w3m-select-buffer-current-buffer)))
10511 (w3m-process-stop buffer)
10512 (w3m-idle-images-show-unqueue buffer)
10513 (kill-buffer buffer)
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))))
10520 (defun w3m-select-buffer-delete-other-buffers ()
10521 "Delete emacs-w3m buffers except for the buffer on the current menu."
10523 (w3m-select-buffer-show-this-line)
10524 (w3m-delete-other-buffers (w3m-select-buffer-current-buffer)))
10526 (defun w3m-select-buffer-quit ()
10527 "Quit the buffers selection."
10529 (if (one-window-p t)
10530 (set-window-buffer (selected-window)
10531 (or (w3m-select-buffer-current-buffer)
10533 (let ((buf (or (w3m-select-buffer-current-buffer)
10536 (pop-to-buffer buf)
10537 (and (get-buffer-window w3m-select-buffer-name)
10538 (delete-windows-on w3m-select-buffer-name)))))
10540 (defun w3m-select-buffer-show-this-line-and-switch ()
10541 "Show the buffer on the menu and switch to the buffer."
10543 (pop-to-buffer (w3m-select-buffer-show-this-line))
10546 (defun w3m-select-buffer-show-this-line-and-quit ()
10547 "Show the buffer on the menu and quit the buffers selection."
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)))
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)))
10557 (if (one-window-p t)
10558 (set-window-buffer window (other-buffer))
10559 (delete-window window)))))
10561 (defun w3m-select-buffer-toggle-style()
10562 "Toggle the style of the selection between horizontal and vertical."
10564 (w3m-select-buffer t))
10566 (defun w3m-select-buffer-window-size ()
10567 (if w3m-select-buffer-horizontal-window
10569 (/ (* (frame-width) (car w3m-select-buffer-window-ratio)) 100))
10571 (/ (* (frame-height) (cdr w3m-select-buffer-window-ratio)) 100))))
10575 (defcustom w3m-use-header-line t
10576 "*Non-nil means display the header line."
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."
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."
10593 ;; backward-compatibility alias
10594 (put 'w3m-header-line-location-title-face
10595 'face-alias 'w3m-header-line-location-title)
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."
10604 ;; backward-compatibility alias
10605 (put 'w3m-header-line-location-content-face
10606 'face-alias 'w3m-header-line-location-content)
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)))
10617 (defun w3m-header-line-insert ()
10618 "Put the header line into the current buffer."
10619 (when (and (or (featurep 'xemacs)
10621 w3m-use-header-line
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]")
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)
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)
10643 "button2 prompts to input URL"
10645 "button2 prompts to input URL")
10647 "mouse-2 prompts to input URL"))))
10648 (setq start (point))
10649 (insert-char ?\ (max
10651 (- (if (and w3m-select-buffer-horizontal-window
10652 (get-buffer-window w3m-select-buffer-name))
10655 (current-column) 1)))
10656 (w3m-add-face-property start (point) 'w3m-header-line-location-content)
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."
10670 :type '(radio (const :tag "Use emacs-w3m" nil)
10671 (function :value browse-url)))
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.
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."
10687 (let ((w3m-pop-up-windows nil)
10688 (url (w3m-url-valid (w3m-anchor)))
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)
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)
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))
10713 (t (w3m-message "No URL at point")))))
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.
10720 (mouse-set-point event)
10721 (let ((url (w3m-url-valid (or (w3m-anchor) (w3m-image)))))
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)
10729 This link is considered to be unsafe; continue? "))
10730 (w3m-safe-view-this-url t)))
10731 (w3m-message "No URL at point"))))
10733 (defconst w3m-minor-mode-command-alist
10734 '((w3m-next-anchor)
10735 (w3m-previous-anchor)
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
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))
10763 (defvar w3m-minor-mode-map (w3m-make-minor-mode-keymap)
10764 "*Keymap used when `w3m-minor-mode' is active.")
10766 (defcustom w3m-minor-mode-hook nil
10767 "*Hook run after `w3m-minor-mode' initialization."
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))
10778 (defun w3m-minor-mode (&optional arg)
10779 "Minor mode to view text/html parts in articles."
10781 (when (setq w3m-minor-mode
10783 (> (prefix-numeric-value arg) 0)
10784 (not w3m-minor-mode)))
10785 (run-hooks 'w3m-minor-mode-hook)))
10787 (defcustom w3m-do-cleanup-temp-files nil
10788 "*Whether to clean up temporary files when emacs-w3m shutdown."
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))))))
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))
10807 ;;; w3m.el ends here