aboutsummaryrefslogtreecommitdiffstats
path: root/lisp
diff options
context:
space:
mode:
authorTatsuya Kinoshita <tats@vega.ocn.ne.jp>2011-05-03 16:36:52 +0000
committerTatsuya Kinoshita <tats@vega.ocn.ne.jp>2011-05-03 16:36:52 +0000
commit4fceec3f98453774565dd17990319b20dc910fe5 (patch)
treeac369fd71615f7d7136a06d2661e7d2cb164e4bc /lisp
downloadw3m-4fceec3f98453774565dd17990319b20dc910fe5.tar.gz
w3m-4fceec3f98453774565dd17990319b20dc910fe5.zip
Adding upstream version 0.1.10+0.1.11pre+kokb23upstream/0.1.10+0.1.11pre+kokb23
Diffstat (limited to 'lisp')
-rw-r--r--lisp/ChangeLog179
-rw-r--r--lisp/w3m.el1252
2 files changed, 1431 insertions, 0 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
new file mode 100644
index 0000000..59e89f8
--- /dev/null
+++ b/lisp/ChangeLog
@@ -0,0 +1,179 @@
+2000-10-20 Hideyuki SHIRAI <shirai@meadowy.org>
+
+ * w3m.el (w3m-process-type): Change default valule to 'start-process.
+ (w3m-process-user-counter): New buffer local variable.
+ (w3m-exec-get-user): New funciton, get user and passwd from
+ w3m-arrived-user-list.
+ (w3m-exec-filter): Use w3m-exec-get-user().
+
+2000-10-18 Hideyuki SHIRAI <shirai@meadowy.org>
+
+ * w3m.el (w3m-view-previous-point): New function.
+ (w3m-expand-url): If BASE is nil, it set "".
+ (w3m-download-this-url): w3m-refontify-anchor() exec when finished
+ download.
+
+2000-10-16 Hideyuki SHIRAI <shirai@meadowy.org>
+
+ * w3m.el (w3m-arrived-ct-file, w3m-arrived-file-cs,
+ w3m-always-html-url-regex): New variables.
+ (w3m-process-type): Change name from w3m-exec-process-type.
+ (w3m-refontify-anchor): New funcition.
+ (w3m-exec): Pre-check content-type.
+ (w3m-exec-w3m-ctcheck): New funcition, check context-type for URL.
+ (w3m-exec-w3m): New funcion, execute w3m.
+ (w3m-exec-ftp): New function, execute dired-other-window() or
+ copy-file(), if URL is 'ftp://'.
+ (w3m-convert-ftp-to-emacsen): Change 'ftp://' to '/user@host:/' from
+ elisp ML.
+ (w3m-download-this-url, w3m-save-image, w3-view-image): Use w3
+ features.
+
+2000-10-12 Hideyuki SHIRAI <shirai@meadowy.org>
+
+ * w3m.el (top-level): Add authors.
+ (w3m-expand-url): Check relative URL first.
+ (w3m-fontify): Add original text properties when replace 'escaped
+ character'.
+
+2000-10-11 Hideyuki SHIRAI <shirai@meadowy.org>
+
+ * w3m.el (w3m-mailto-url-function, w3m-use-cygdrive,
+ w3m-default-save-dir, w3m-arrived-list-file, w3m-arrived-list-keep,
+ w3m-arrived-anchor-face, w3m-exec-process-type,
+ w3m-process-connection-type, w3m-arrived-anchor-list):
+ New user custumize variables.
+ (w3m-mode): Change doc-string for key binding.
+ (w3m-arrived-list-add, w3m-arrived-list-load, w3m-arrived-list-save):
+ New functions for handling arrived anchor.
+ (w3m-fontify): Add arrived anchor face.
+ (w3m-exec-process, w3m-exec-filter, w3m-exec-sentinel): New functions
+ for asynchronous w3m execution.
+ (w3m-find-file, w3m-read-file-name, w3m-read-passwd):
+ New miscellaneous functions.
+ (w3m-expand-file-name): Support old cygwin.
+ (w3m-view-current-url-with-external-browser): If w3m-browser-command
+ is function, funcall it.
+ (w3m-mailto-url): If w3m-mailto-url-function is function, funcall it.
+ (w3m-mode-map): If running xemacs, use (button2) instead of (mouse-2).
+
+2000-09-21 Shun-ichi GOTO <gotoh@taiyo.co.jp>
+
+ * w3m.el (w3m): Cancel last change, use switch-to-buffer again.
+
+2000-09-20 Shun-ichi GOTO <gotoh@taiyo.co.jp>
+
+ * w3m.el (w3m): Do not switch buffer if w3m window already exists.
+
+2000-09-20 TSUCHIYA Masatoshi <tsuchiya@pine.kuee.kyoto-u.ac.jp>
+
+ * w3m.el: Add declaration of dependency on APEL.
+ (w3m-quit): When other w3m buffers exist, don't destruct cache.
+ (w3m-browse-url): New function.
+
+2000-09-20 Shun-ichi GOTO <gotoh@taiyo.co.jp>
+
+ * w3m.el (w3m-command-arguments): Remove option -m, that's not good
+ for bookmark / local file handling.
+
+2000-09-19 Shun-ichi GOTO <gotoh@taiyo.co.jp>
+
+ * w3m.el (w3m-command-arguments): Add -m option explicitly.
+ (w3m-exec): Ad-hoc change to view .txt object. It's temporary
+ fix. Should we consider type? w3m option -dump_head may help us.
+ (w3m-exec): Get title and remove both format <title_alt> and
+ <title>.
+ (w3m-view-this-url): Force reloading by prefix.
+ (w3m-view-current-url-with-external-browser): Works correctly.
+ (w3m-print-current-url): Push url to kill king to paste later.
+ (w3m-print-this-url): ditto.
+ (w3m-mailto-url): Use rfc2368.el instead of mailto.el.
+ (w3m-goto-url): Add 2nd argument RELOAD to withdraw data cached on
+ emacs.
+ (w3m-reload-this-page): Simplified by using new w3m-goto-url.
+ (w3m): Set mode-line-buffer-identification after changing major
+ mode because it overwrite that variable.
+
+2000-09-19 TSUCHIYA Masatoshi <tsuchiya@pine.kuee.kyoto-u.ac.jp>
+
+ * w3m.el (w3m-fontify): Add code to handle irregular ordered
+ elements of anchor tags.
+ (w3m-mailto-url): Adopt for Emacs-19.
+ (w3m-input-url): Call `w3m-backlog-setup' to initialize
+ `w3m-backlog-hashtb'.
+
+2000-09-19 Shun-ichi GOTO <gotoh@taiyo.co.jp>
+
+ * w3m.el (w3m): Sorry, over paren.
+
+2000-09-18 Shun-ichi GOTO <gotoh@taiyo.co.jp>
+
+ * w3m.el (w3m-exec): Get title correctly within -halfdump format
+ of w3m.
+ (w3m-mouse-view-this-url): New function to view page by clicking
+ mouse middle button.
+ (w3m-mode-map): Assign mouse middle button to view page.
+ (w3m): Change mode-line spec to show title of current page.
+
+2000-09-18 TSUCHIYA Masatoshi <tsuchiya@pine.kuee.kyoto-u.ac.jp>
+
+ * w3m.el: Add authors.
+
+2000-09-18 Shun-ichi GOTO <gotoh@taiyo.co.jp>
+
+ * w3m.el (w3m-input-url): Enter url with completion. Candidates
+ are visited url kept in w3m-backlog-hashtb.
+ (w3m-backlog-setup): Change hash size as prime number and
+ initialized with value 0 for obarray.
+ (w3m-backlog-remove): Remove unused 2nd arg NUMBER and remove when
+ block to check NUMBER.
+ (w3m-exec): Show message "Loading..." while loading.
+ (w3m-save-position): New function to keep display position in
+ Emacs window into hash symbol, but I think this is not best way.
+ (w3m-restore-position): New function to restore display position.
+ (w3m-view-previous-page): Restore display position.
+ (w3m-expand-url): Canonicalize url, ex. "http://www.host.org" to
+ "http://www.host.org/". Change regexp to allow "mailto:"
+ protocol. Remove drive letter as side-effect using
+ expand-file-name to expand url for Win32 emacen.
+ (w3m-expand-file-name): New function to alternates
+ expand-file-name function with convert drive letter prefixed path
+ to cygwin path. i.e. c:/users/home to /cygdrive/c/users/home
+ (w3m-view-bookmark): Expand bookmark filename as cygwin path
+ format to pass to w3m.
+ (w3m-mode-map): Add new key binding 'B' to back to previous page.
+ Add new key binding 'R' to force reloading current page.
+ (w3m-mailto-url): New function to support mailto: protocol. It
+ use rfc2368.el if available.
+ (w3m-goto-url): Ad-hoc support mailto: protocol. We should
+ consider more...
+ (w3m-reload-this-page): New function to reload current page.
+
+2000-09-18 Shun-ichi GOTO <gotoh@taiyo.co.jp>
+
+ * w3m.el (w3m): Add 2nd arguemnt to use with browse url. This is
+ patch from Satoru Takabayashi <satoru-t@is.aist-nara.ac.jp> in
+ ELF-ML, Seq# 875.
+ (w3m-fontify): Change regexp for <a ...> tag to allow newline in
+ between attributes. This is patch from Satoru Takabayashi
+ <satoru-t@is.aist-nara.ac.jp> in ELF-ML, Seq# 876.
+ (w3m-fontify): Allow un-ended tag for name attribute, is it w3m
+ bug?). This is Patch from Satoru Takabayashi
+ <satoru-t@is.aist-nara.ac.jp> in ELF-ML, Seq# 876.
+
+2000-07-13 TSUCHIYA Masatoshi <tsuchiya@pine.kuee.kyoto-u.ac.jp>
+
+ * w3m.el: Added handling of name anchors. Add comments.
+
+2000-07-12 TSUCHIYA Masatoshi <tsuchiya@pine.kuee.kyoto-u.ac.jp>
+
+ * w3m.el: Improved to handle multi buffer. Fix broken cache and
+ order of fontify.
+
+2000-07-01 TSUCHIYA Masatoshi <tsuchiya@pine.kuee.kyoto-u.ac.jp>
+
+ * w3m.el: Handle &-sequence. Add history and cache.
+
+2000-06-25 TSUCHIYA Masatoshi <tsuchiya@pine.kuee.kyoto-u.ac.jp>
+
+ * w3m.el: New file.
diff --git a/lisp/w3m.el b/lisp/w3m.el
new file mode 100644
index 0000000..e096746
--- /dev/null
+++ b/lisp/w3m.el
@@ -0,0 +1,1252 @@
+;;; -*- mode: Emacs-Lisp; coding: euc-japan -*-
+
+;; Copyright (C) 2000 TSUCHIYA Masatoshi <tsuchiya@pine.kuee.kyoto-u.ac.jp>
+
+;; Authors: TSUCHIYA Masatoshi <tsuchiya@pine.kuee.kyoto-u.ac.jp>,
+;; Shun-ichi GOTO <gotoh@taiyo.co.jp>,
+;; Satoru Takabayashi <satoru-t@is.aist-nara.ac.jp>
+;; Hideyuki SHIRAI <shirai@meadowy.org>
+;; Keywords: w3m, WWW, hypermedia
+
+;; w3m.el is free software; you can redistribute it and/or modify it
+;; under the terms of the GNU General Public License as published by
+;; the Free Software Foundation; either version 2 of the License, or
+;; (at your option) any later version.
+
+;; w3m.el is distributed in the hope that it will be useful, but
+;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with w3m.el; if not, write to the Free Software Foundation,
+;; Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA
+
+
+;;; Commentary:
+
+;; w3m.el is the interface program of w3m on Emacs. For more detail
+;; about w3m, see:
+;;
+;; http://ei5nazha.yz.yamagata-u.ac.jp/~aito/w3m/
+;;
+
+;;; How to install:
+
+;; Please put this file to appropriate directory, and if you want
+;; byte-compile it. And add following lisp expressions to your
+;; ~/.emacs.
+;;
+;; (autoload 'w3m "w3m" "Interface for w3m on Emacs." t)
+
+
+;;; Code:
+
+(or (and (boundp 'emacs-major-version)
+ (>= emacs-major-version 20))
+ (progn
+ (require 'poe)
+ (require 'pcustom)))
+
+(defgroup w3m nil
+ "w3m - the web browser of choice."
+ :group 'hypermedia)
+
+(defgroup w3m-face nil
+ "Faces for w3m."
+ :group 'w3m
+ :prefix "w3m-")
+
+(defcustom w3m-command "w3m"
+ "*Name of the executable file of w3m."
+ :group 'w3m
+ :type 'string)
+
+(defcustom w3m-command-arguments '("-e" "-halfdump" "-cols" col url)
+ "*Arguments of w3m."
+ :group 'w3m
+ :type '(repeat (restricted-sexp :match-alternatives (stringp 'col 'url))))
+
+(defcustom w3m-viewer-command "xv"
+ "*Name of the viewer."
+ :group 'w3m
+ :type 'string)
+
+(defcustom w3m-viewer-command-arguments '(file)
+ "Arguments of viewer."
+ :group 'w3m
+ :type '(repeat (restricted-sexp :match-alternatives (stringp 'file))))
+
+(defcustom w3m-browser-command "netscape"
+ "*Command name or function name of the browser."
+ :group 'w3m
+ :type '(choice (string :tag "Name of command")
+ (function :tag "Name of function")))
+
+(defcustom w3m-browser-command-arguments '(url)
+ "*Arguments of browser."
+ :group 'w3m
+ :type '(repeat (restricted-sexp :match-alternatives (stringp 'url))))
+
+(defcustom w3m-mailto-url-function nil
+ "*Mailto handling Function."
+ :group 'w3m
+ :type 'function)
+
+(defcustom w3m-use-cygdrive t
+ "*If non-nil, use /cygdrive/ rule when expand-file-name."
+ :group 'w3m
+ :type 'boolean)
+
+(defcustom w3m-default-save-dir "~/.w3m"
+ "*Default directory for save file."
+ :group 'w3m
+ :type 'directory)
+
+(defcustom w3m-coding-system (if (boundp 'MULE) '*euc-japan* 'euc-japan)
+ "*Coding system for w3m."
+ :group 'w3m
+ :type 'symbol)
+
+(defcustom w3m-bookmark-file (expand-file-name "~/.w3m/bookmark.html")
+ "*Bookmark file of w3m."
+ :group 'w3m
+ :type 'file)
+
+(defcustom w3m-arrived-list-file (expand-file-name "~/.w3m/.arrived")
+ "*Arrived URL file of w3m."
+ :group 'w3m
+ :type 'file)
+
+(defcustom w3m-arrived-ct-file (expand-file-name "~/.w3m/.ctcheck")
+ "*Arrived URL's context-type file of w3m."
+ :group 'w3m
+ :type 'file)
+
+(defcustom w3m-arrived-file-cs
+ (if (boundp 'MULE) '*euc-japan*unix 'euc-japan-unix)
+ "*Coding system for arrived file."
+ :group 'w3m
+ :type 'symbol)
+
+(defcustom w3m-arrived-list-keep 500
+ "*Arrived keep count of w3m."
+ :group 'w3m
+ :type 'integer)
+
+(defcustom w3m-keep-backlog 300
+ "*Back log size of w3m."
+ :group 'w3m
+ :type 'integer)
+
+(defcustom w3m-fill-column (- (frame-width) 4)
+ "*Fill column of w3m."
+ :group 'w3m
+ :type 'integer)
+
+(defcustom w3m-always-html-url-regex nil
+ "*If URL is matched this regex, it handle always Text/Html."
+ :group 'w3m
+ :type 'string)
+
+(defface w3m-anchor-face
+ '((((class color) (background light)) (:foreground "red" :underline t))
+ (((class color) (background dark)) (:foreground "blue" :underline t))
+ (t (:underline t)))
+ "*Face to fontify anchors."
+ :group 'w3m-face)
+
+(defface w3m-arrived-anchor-face
+ '((((class color) (background light))
+ (:foreground "navy" :underline t :bold t))
+ (((class color) (background dark))
+ (:foreground "blue" :underline t :bold t))
+ (t (:underline t)))
+ "*Face to fontify anchors, if arrived."
+ :group 'w3m-face)
+
+(defface w3m-image-face
+ '((((class color) (background light)) (:foreground "ForestGreen"))
+ (((class color) (background dark)) (:foreground "PaleGreen"))
+ (t (:underline t)))
+ "*Face to fontify image alternate strings."
+ :group 'w3m-face)
+
+(defcustom w3m-hook nil
+ "*Hook run before w3m called."
+ :group 'w3m
+ :type 'hook)
+
+(defcustom w3m-mode-hook nil
+ "*Hook run before w3m-mode called."
+ :group 'w3m
+ :type 'hook)
+
+(defcustom w3m-fontify-before-hook nil
+ "*Hook run before w3m-fontify called."
+ :group 'w3m
+ :type 'hook)
+
+(defcustom w3m-fontify-after-hook nil
+ "*Hook run after w3m-fontify called."
+ :group 'w3m
+ :type 'hook)
+
+(defcustom w3m-process-type 'start-process
+ "*Function type for w3m execution."
+ :group 'w3m
+ :type '(choice (symbol :tag "call-process" call-process)
+ (symbol :tag "start-process" start-process)))
+
+(defcustom w3m-process-connection-type t
+ "*Process connection type for w3m execution."
+ :group 'w3m
+ :type 'boolean)
+
+(defvar w3m-current-url nil "URL of this buffer.")
+(defvar w3m-current-title nil "Title of this buffer.")
+(defvar w3m-url-history nil "History of URL.")
+
+(defvar w3m-backlog-buffer nil)
+(defvar w3m-backlog-articles nil)
+(defvar w3m-backlog-hashtb nil)
+(defvar w3m-input-url-history nil)
+
+(defvar w3m-arrived-anchor-list nil)
+(defvar w3m-arrived-url-ct nil)
+(defvar w3m-arrived-user-list nil)
+
+(defvar w3m-process nil)
+(defvar w3m-process-string nil)
+(defvar w3m-process-url nil)
+(defvar w3m-process-user nil)
+(defvar w3m-process-passwd nil)
+(defvar w3m-process-user-counter 0)
+
+(make-variable-buffer-local 'w3m-process)
+(make-variable-buffer-local 'w3m-process-string)
+(make-variable-buffer-local 'w3m-process-url)
+(make-variable-buffer-local 'w3m-process-user)
+(make-variable-buffer-local 'w3m-process-passwd)
+(make-variable-buffer-local 'w3m-process-user-counter)
+
+(defun w3m-arrived-list-load ()
+ "Load arrived url list from 'w3m-arrived-list-file'
+and 'w3m-arrived-ct-file'."
+ (when (file-readable-p w3m-arrived-ct-file)
+ (with-temp-buffer
+ (let ((file-coding-system-for-read w3m-arrived-file-cs)
+ (coding-system-for-read w3m-arrived-file-cs))
+ (insert-file-contents w3m-arrived-ct-file)
+ (setq w3m-arrived-url-ct
+ (condition-case nil
+ (read (current-buffer))
+ (error nil))))))
+ (when (file-readable-p w3m-arrived-list-file)
+ (with-temp-buffer
+ (let ((file-coding-system-for-read w3m-arrived-file-cs)
+ (coding-system-for-read w3m-arrived-file-cs))
+ (insert-file-contents w3m-arrived-list-file)
+ (setq w3m-arrived-anchor-list
+ (condition-case nil
+ (read (current-buffer))
+ (error nil)))))))
+
+(defun w3m-arrived-list-save ()
+ "Save arrived url list to 'w3m-arrived-list-file'
+and 'w3m-arrived-ct-file'."
+ (when (> (length w3m-arrived-url-ct) w3m-arrived-list-keep)
+ (setq w3m-arrived-url-ct
+ (nreverse (nthcdr (- (length w3m-arrived-url-ct)
+ w3m-arrived-list-keep)
+ (nreverse w3m-arrived-url-ct)))))
+ (when (and w3m-arrived-url-ct
+ (file-writable-p w3m-arrived-ct-file))
+ (with-temp-buffer
+ (let ((file-coding-system w3m-arrived-file-cs)
+ (coding-system-for-write w3m-arrived-file-cs))
+ (prin1 w3m-arrived-url-ct (current-buffer))
+ (princ "\n" (current-buffer))
+ (write-region (point-min) (point-max)
+ w3m-arrived-ct-file nil 'nomsg))))
+ (when (> (length w3m-arrived-anchor-list) w3m-arrived-list-keep)
+ (setq w3m-arrived-anchor-list
+ (nreverse (nthcdr (- (length w3m-arrived-anchor-list)
+ w3m-arrived-list-keep)
+ (nreverse w3m-arrived-anchor-list)))))
+ (when (and w3m-arrived-anchor-list
+ (file-writable-p w3m-arrived-list-file))
+ (with-temp-buffer
+ (let ((file-coding-system w3m-arrived-file-cs)
+ (coding-system-for-write w3m-arrived-file-cs))
+ (prin1 w3m-arrived-anchor-list (current-buffer))
+ (princ "\n" (current-buffer))
+ (write-region (point-min) (point-max)
+ w3m-arrived-list-file nil 'nomsg)
+ (setq w3m-arrived-anchor-list nil)))))
+
+(defun w3m-arrived-list-add (&optional url)
+ "Cons url to 'w3m-arrived-anchor-list'. CAR is newest."
+ (setq url (or url w3m-current-url))
+ (when (> (length url) 5) ;; ignore short
+ (set-text-properties 0 (length url) nil url)
+ (setq w3m-arrived-anchor-list
+ (cons url (delete url w3m-arrived-anchor-list)))))
+
+(defun w3m-fontify ()
+ "Fontify this buffer."
+ (let ((case-fold-search t))
+ (run-hooks 'w3m-fontify-before-hook)
+ ;; Delete extra title tag.
+ (let (start)
+ (and (search-forward "<title>" nil t)
+ (setq start (match-beginning 0))
+ (search-forward "</title>" nil t)
+ (delete-region start (match-end 0))))
+ ;; Fontify bold characters.
+ (goto-char (point-min))
+ (while (search-forward "<b>" nil t)
+ (let ((start (match-beginning 0)))
+ (delete-region start (match-end 0))
+ (when (search-forward "</b>" nil t)
+ (delete-region (match-beginning 0) (match-end 0))
+ (put-text-property start (match-beginning 0) 'face 'bold))))
+ ;; Delete excessive `hseq' elements of anchor tags.
+ (goto-char (point-min))
+ (while (re-search-forward "<a\\( hseq=\"[-0-9]+\"\\)" nil t)
+ (delete-region (match-beginning 1) (match-end 1)))
+ ;; Re-ordering anchor elements.
+ (goto-char (point-min))
+ (let (href)
+ (while (re-search-forward "<a\\([ \t\n]\\)[^>]+[ \t\n]href=\\(\"[^\"]*\"\\)" nil t)
+ (setq href (buffer-substring (match-beginning 2) (match-end 2)))
+ (delete-region (match-beginning 2) (match-end 2))
+ (goto-char (match-beginning 1))
+ (insert " href=" href)))
+ ;; Fontify anchor tags.
+ (goto-char (point-min))
+ (while (re-search-forward
+ "<a\\([ \t\n]+href=\"\\([^\"]*\\)\"\\)?\\([ \t\n]+name=\"\\([^\"]*\\)\"\\)?[^>]*>"
+ nil t)
+ (let ((url (match-string 2))
+ (tag (match-string 4))
+ (start (match-beginning 0))
+ (end))
+ (delete-region start (match-end 0))
+ (cond (url
+ (when (search-forward "</a>" nil t)
+ (delete-region (setq end (match-beginning 0)) (match-end 0))
+ (if (member (w3m-expand-url url w3m-current-url)
+ w3m-arrived-anchor-list)
+ (put-text-property start end 'face 'w3m-arrived-anchor-face)
+ (put-text-property start end 'face 'w3m-anchor-face))
+ (put-text-property start end 'w3m-href-anchor url))
+ (when tag
+ (put-text-property start end 'w3m-name-anchor tag)))
+ (tag
+ (when (re-search-forward "<\\|\n" nil t)
+ (setq end (match-beginning 0))
+ (put-text-property start end 'w3m-name-anchor tag))))))
+ ;; Fontify image alternate strings.
+ (goto-char (point-min))
+ (while (re-search-forward "<img_alt src=\"\\([^\"]*\\)\">" nil t)
+ (let ((src (match-string 1))
+ (start (match-beginning 0))
+ (end))
+ (delete-region start (match-end 0))
+ (when (search-forward "</img_alt>" nil t)
+ (delete-region (setq end (match-beginning 0)) (match-end 0))
+ (put-text-property start end 'face 'w3m-image-face)
+ (put-text-property start end 'w3m-image src))))
+ ;; Remove other markups.
+ (goto-char (point-min))
+ (while (re-search-forward "</?[A-z][^>]*>" nil t)
+ (delete-region (match-beginning 0) (match-end 0)))
+ ;; Decode escaped characters.
+ (goto-char (point-min))
+ (let (prop)
+ (while (re-search-forward
+ "&\\(\\(nbsp\\)\\|\\(gt\\)\\|\\(lt\\)\\|\\(amp\\)\\|\\(quot\\)\\|\\(apos\\)\\);"
+ nil t)
+ (setq prop (text-properties-at (match-beginning 0)))
+ (delete-region (match-beginning 0) (match-end 0))
+ (insert (if (match-beginning 2) " "
+ (if (match-beginning 3) ">"
+ (if (match-beginning 4) "<"
+ (if (match-beginning 5) "&"
+ (if (match-beginning 6) "\"" "'"))))))
+ (if prop (add-text-properties (1- (point)) (point) prop))))
+ (run-hooks 'w3m-fontify-after-hook)))
+
+
+(defun w3m-refontify-anchor (&optional buff)
+ "Change face 'w3m-anchor-face to 'w3m-arrived-anchor-face."
+ (save-excursion
+ (and buff (set-buffer buff))
+ (when (and (eq major-mode 'w3m-mode)
+ (eq (get-text-property (point) 'face) 'w3m-anchor-face))
+ (let* (start
+ (end (next-single-property-change (point) 'face))
+ (buffer-read-only nil))
+ (when(and end
+ (setq start (previous-single-property-change end 'face)))
+ (put-text-property start end 'face 'w3m-arrived-anchor-face))
+ (set-buffer-modified-p nil)))))
+
+
+(defun w3m-input-url (&optional prompt default)
+ "Read a URL from the minibuffer, prompting with string PROMPT."
+ (let (url candidates)
+ (w3m-backlog-setup)
+ (or w3m-input-url-history
+ (setq w3m-input-url-history (or w3m-arrived-anchor-list
+ (w3m-arrived-list-load))))
+ (mapatoms (lambda (x)
+ (setq candidates (cons (cons (symbol-name x) x) candidates)))
+ w3m-backlog-hashtb)
+ (setq url (completing-read (or prompt "URL: ")
+ candidates nil nil
+ default 'w3m-input-url-history default))
+ ;; remove duplication
+ (setq w3m-input-url-history (cons url (delete url w3m-input-url-history)))
+ ;; return value
+ url))
+
+
+(defun w3m-backlog-setup ()
+ "Initialize backlog variables."
+ (unless (and (bufferp w3m-backlog-buffer)
+ (buffer-live-p w3m-backlog-buffer))
+ (save-excursion
+ (set-buffer (get-buffer-create " *w3m backlog*"))
+ (buffer-disable-undo)
+ (setq buffer-read-only t
+ w3m-backlog-buffer (current-buffer))))
+ (unless w3m-backlog-hashtb
+ (setq w3m-backlog-hashtb (make-vector 1021 0))))
+
+(defun w3m-backlog-shutdown ()
+ "Clear all backlog variables and buffers."
+ (when (get-buffer w3m-backlog-buffer)
+ (kill-buffer w3m-backlog-buffer))
+ (setq w3m-backlog-hashtb nil
+ w3m-backlog-articles nil))
+
+(defun w3m-backlog-enter (url buffer)
+ (w3m-backlog-setup)
+ (let ((ident (intern url w3m-backlog-hashtb)))
+ (if (memq ident w3m-backlog-articles)
+ () ; It's already kept.
+ ;; Remove the oldest article, if necessary.
+ (and (numberp w3m-keep-backlog)
+ (>= (length w3m-backlog-articles) w3m-keep-backlog)
+ (w3m-backlog-remove-oldest))
+ ;; Insert the new article.
+ (save-excursion
+ (set-buffer w3m-backlog-buffer)
+ (let (buffer-read-only)
+ (goto-char (point-max))
+ (unless (bolp) (insert "\n"))
+ (let ((b (point)))
+ (insert-buffer-substring buffer)
+ ;; Tag the beginning of the article with the ident.
+ (when (> (point-max) b)
+ (put-text-property b (1+ b) 'w3m-backlog ident)
+ (setq w3m-backlog-articles (cons ident w3m-backlog-articles)))
+ ))))))
+
+(defun w3m-backlog-remove-oldest ()
+ (save-excursion
+ (set-buffer w3m-backlog-buffer)
+ (goto-char (point-min))
+ (if (zerop (buffer-size))
+ () ; The buffer is empty.
+ (let ((ident (get-text-property (point) 'w3m-backlog))
+ buffer-read-only)
+ ;; Remove the ident from the list of articles.
+ (when ident
+ (setq w3m-backlog-articles (delq ident w3m-backlog-articles)))
+ ;; Delete the article itself.
+ (delete-region (point)
+ (next-single-property-change
+ (1+ (point)) 'w3m-backlog nil (point-max)))))))
+
+(defun w3m-backlog-remove (url)
+ "Remove data of URL from the backlog."
+ (w3m-backlog-setup)
+ (let ((ident (intern url w3m-backlog-hashtb))
+ beg end)
+ (when (memq ident w3m-backlog-articles)
+ ;; It was in the backlog.
+ (save-excursion
+ (set-buffer w3m-backlog-buffer)
+ (let (buffer-read-only)
+ (when (setq beg (text-property-any
+ (point-min) (point-max) 'w3m-backlog ident))
+ ;; Find the end (i. e., the beginning of the next article).
+ (setq end (next-single-property-change
+ (1+ beg) 'w3m-backlog (current-buffer) (point-max)))
+ (delete-region beg end)))
+ (setq w3m-backlog-articles (delq ident w3m-backlog-articles))))))
+
+(defun w3m-backlog-request (url &optional buffer)
+ (w3m-backlog-setup)
+ (let ((ident (intern url w3m-backlog-hashtb)))
+ (when (memq ident w3m-backlog-articles)
+ ;; It was in the backlog.
+ (let (beg end)
+ (save-excursion
+ (set-buffer w3m-backlog-buffer)
+ (if (not (setq beg (text-property-any
+ (point-min) (point-max) 'w3m-backlog ident)))
+ ;; It wasn't in the backlog after all.
+ (setq w3m-backlog-articles (delq ident w3m-backlog-articles))
+ ;; Find the end (i. e., the beginning of the next article).
+ (setq end
+ (next-single-property-change
+ (1+ beg) 'w3m-backlog (current-buffer) (point-max)))))
+ (and beg
+ end
+ (save-excursion
+ (and buffer (set-buffer buffer))
+ (let (buffer-read-only)
+ (insert-buffer-substring w3m-backlog-buffer beg end))
+ t))))))
+
+(defun w3m-exec (url &optional buffer ct)
+ "Download URL with w3m to the BUFFER.
+If BUFFER is nil, all data is placed to the current buffer.
+CT denotes content-type."
+ (let ((cbuf (current-buffer)))
+ (when (let ((args (copy-sequence w3m-command-arguments)))
+ (cond
+ ;; backlog exist.
+ ((w3m-backlog-request url)
+ (w3m-exec-w3m url args buffer) nil)
+ ;; ange|efs-ftp
+ ((and (string-match "^ftp://" url)
+ (not (string-match "\\.s?html?$" url)))
+ (w3m-exec-ftp url) t)
+ ;; text/html
+ ((or (string-match "\\.s?html?$\\|/$" url)
+ (and w3m-always-html-url-regex
+ (string-match w3m-always-html-url-regex url))
+ (eq ct 'text/html))
+ (w3m-exec-w3m url args buffer) nil)
+ ;; text/*
+ ((or (string-match "\\.\\(txt\\|el\\)$" url) (eq ct 'text))
+ (setq args (cons "-dump" (delete "-halfdump" args)))
+ (w3m-exec-w3m url args buffer) nil)
+ ;; image/*
+ ((eq ct 'image)
+ (require 'w3)
+ (w3-fetch url) t)
+ ;; application/*, audio/*, etc...
+ ((eq ct 'application)
+ (require 'w3)
+ (let ((mm-download-directory
+ (file-name-as-directory w3m-default-save-dir)))
+ (w3-download-url (w3m-expand-url url w3m-current-url))) t)
+ ;; get context-type and w3-exec() call recursion .
+ ((not ct)
+ (w3m-exec url buffer (w3m-exec-w3m-ctcheck url)))
+ ;; error
+ (t (error "context-type check error."))))
+ ;; if not exec w3m, return (current-buffer)
+ cbuf)))
+
+
+(defun w3m-exec-w3m-ctcheck (url)
+ (or (cdr (assoc url w3m-arrived-url-ct))
+ (save-excursion
+ (message "Dump header...")
+ (set-buffer (get-buffer-create " *w3m ctcheck*"))
+ (buffer-disable-undo)
+ (delete-region (point-min) (point-max))
+ (let ((args (copy-sequence w3m-command-arguments))
+ (case-fold-search t)
+ (ct 'error))
+ (setq args (cons "-dump_head" (delete "-halfdump" args)))
+ (w3m-exec-process url args)
+ (message "Dump header... done.")
+ (goto-char (point-min))
+ (when (re-search-forward "^content-type: " nil t)
+ (setq ct (if (looking-at "text/html") 'text/html
+ (if (looking-at "text") 'text
+ (if (looking-at "image") 'image
+ 'application))))
+ (setq w3m-arrived-url-ct (cons (cons url ct) w3m-arrived-url-ct))
+ ct)))))
+
+(defun w3m-exec-w3m (url args buffer)
+ (save-excursion
+ (setq buffer-read-only nil)
+ (if buffer (set-buffer buffer))
+ (delete-region (point-min) (point-max))
+ (unless (w3m-backlog-request url)
+ (message "Loading page...")
+ (w3m-exec-process url args)
+ (message "Loading page... done."))
+ (w3m-backlog-enter url (current-buffer))
+ ;; Setting buffer local variables.
+ (set (make-local-variable 'w3m-current-url) url)
+ (goto-char (point-min))
+ (let (title)
+ (mapcar (lambda (regexp)
+ (goto-char 1)
+ (when (re-search-forward regexp nil t)
+ (setq title (match-string 1))
+ (delete-region (match-beginning 0) (match-end 0))))
+ '("<title_alt[ \t\n]+title=\"\\([^\"]+\\)\">"
+ "<title>\\([^<]\\)</title>"))
+ (if (and (null title)
+ (< 0 (length (file-name-nondirectory url))))
+ (setq title (file-name-nondirectory url)))
+ (set (make-local-variable 'w3m-current-title) (or title "<no-title>")))
+ (set (make-local-variable 'w3m-url-history)
+ (cons url w3m-url-history))
+ (setq-default w3m-url-history
+ (cons url (default-value 'w3m-url-history)))))
+
+
+(defun w3m-exec-ftp (url)
+ (let ((ftp (w3m-convert-ftp-to-emacsen url))
+ (file (file-name-nondirectory url)))
+ (if (string-match "\\(\\.gz\\|\\.bz2\\|\\.zip\\|\\.lzh\\)$" file)
+ (copy-file ftp (w3m-read-file-name nil nil file))
+ (dired-other-window ftp))))
+
+
+(defun w3m-convert-ftp-to-emacsen (url)
+ (or (and (string-match "^ftp://?\\([^/@]+@\\)?\\([^/]+\\)\\(/~/\\)?" url)
+ (concat "/"
+ (if (match-beginning 1)
+ (substring url (match-beginning 1) (match-end 1))
+ "anonymous@")
+ (substring url (match-beginning 2) (match-end 2))
+ ":"
+ (substring url (match-end 2))))
+ (error "URL is strange.")))
+
+(defun w3m-exec-process (url args)
+ (save-excursion
+ (let ((coding-system-for-read w3m-coding-system)
+ (coding-system-for-write w3m-coding-system)
+ (default-process-coding-system
+ (cons w3m-coding-system w3m-coding-system))
+ (process-connection-type w3m-process-connection-type))
+ (if (eq w3m-process-type 'start-process)
+ ;; start-process
+ (unwind-protect nil
+ (let ()
+ ;; (pop-to-buffer (current-buffer))
+ (setq w3m-process-url url)
+ (setq w3m-process-string nil)
+ (setq w3m-process-user nil)
+ (setq w3m-process-passwd nil)
+ (setq w3m-process-user-counter 2)
+ (setq buffer-read-only t)
+ (setq w3m-process
+ (apply 'start-process w3m-command (current-buffer) w3m-command
+ (mapcar (lambda (arg)
+ (if (eq arg 'col)
+ (format "%d" w3m-fill-column)
+ (eval arg)))
+ args)))
+ (set-process-coding-system w3m-process w3m-coding-system)
+ (set-process-filter w3m-process 'w3m-exec-filter)
+ (set-process-sentinel w3m-process 'w3m-exec-sentinel)
+ (process-kill-without-query w3m-process)
+ (while w3m-process
+ (sit-for 0.5)
+ (discard-input)))
+ (setq w3m-process nil)
+ (setq w3m-process-url url)
+ (setq w3m-process-string nil)
+ (setq w3m-process-user nil)
+ (setq w3m-process-passwd nil)
+ (setq w3m-process-user-counter 0)
+ (setq buffer-read-only nil))
+ ;; call-process
+ (apply 'call-process w3m-command nil t nil
+ (mapcar (lambda (arg)
+ (if (eq arg 'col)
+ (format "%d" w3m-fill-column)
+ (eval arg)))
+ args))))))
+
+(defun w3m-exec-filter (process string)
+ (if (bufferp (process-buffer process))
+ (let ((obuf (buffer-name)))
+ (unwind-protect
+ (progn
+ (set-buffer (process-buffer process))
+ (let ((buffer-read-only nil)
+ (case-fold-search nil)
+ file input prompt)
+ (goto-char (point-max))
+ (setq w3m-process-string
+ (concat w3m-process-string string))
+ (while (string-match "\n" w3m-process-string)
+ (insert (concat
+ (substring w3m-process-string 0 (match-beginning 0))
+ "\n"))
+ (setq w3m-process-string
+ (substring w3m-process-string (match-end 0))))
+ (cond
+ ;; username
+ ((string-match "^Username: " w3m-process-string)
+ (setq prompt (match-string 0 w3m-process-string))
+ (setq w3m-process-string "")
+ (setq w3m-process-user
+ (or (nth 0 (w3m-exec-get-user w3m-process-url))
+ (read-from-minibuffer prompt)))
+ (process-send-string process (concat w3m-process-user "\n")))
+ ;; passwd
+ ((string-match "^Password: " w3m-process-string)
+ (setq prompt (match-string 0 w3m-process-string))
+ (setq w3m-process-string "")
+ (setq w3m-process-passwd
+ (or (nth 1 (w3m-exec-get-user w3m-process-url))
+ (w3m-read-passwd prompt)))
+ (process-send-string process (concat w3m-process-passwd "\n")))
+ ;; save file
+ ((string-match "Save file to:" w3m-process-string)
+ (setq w3m-process-string "")
+ (setq input (w3m-read-file-name nil nil w3m-process-url))
+ (process-send-string process (concat input "\n"))
+ (insert (format "Save to %s.\n" input)))
+ ;; overwrite
+ ((string-match "File exists. Overwrite? (y or n)" w3m-process-string)
+ (setq w3m-process-string "")
+ (condition-case nil
+ (process-send-string process "y\n")
+ (error nil)))
+ ;; quit
+ ((string-match " *Hit any key to quit w3m:" w3m-process-string)
+ (condition-case nil
+ (quit-process process)
+ (error nil))))))
+ (if (get-buffer obuf)
+ (set-buffer obuf))))))
+
+(defun w3m-exec-get-user (url)
+ (if (= w3m-process-user-counter 0)
+ nil
+ (let ((urllist w3m-arrived-user-list))
+ (catch 'get
+ (while urllist
+ (when (string-match (concat "^"
+ (regexp-quote (car (car urllist))))
+ url)
+ (setq w3m-process-user-counter (1- w3m-process-user-counter))
+ (throw 'get (cdr (car urllist))))
+ (setq urllist (cdr urllist)))))))
+
+(defun w3m-exec-sentinel (process event)
+ (if (bufferp (process-buffer process))
+ (let ((obuf (buffer-name)))
+ (unwind-protect
+ (progn
+ (set-buffer (process-buffer process))
+ (if (and w3m-process-url w3m-process-user)
+ (setq w3m-arrived-user-list
+ (cons
+ (cons w3m-process-url
+ (list w3m-process-user w3m-process-passwd))
+ (delete (assoc w3m-process-url w3m-arrived-user-list)
+ w3m-arrived-user-list))))
+ (setq w3m-process-string nil)
+ (setq w3m-process nil)
+ (setq w3m-process-url nil)
+ (setq w3m-process-user nil)
+ (setq w3m-process-passwd nil))
+ (if (get-buffer obuf)
+ (set-buffer obuf))))))
+
+(defun w3m-read-file-name (&optional prompt dir default existing initial)
+ (let* ((default (and default (file-name-nondirectory default)))
+ (prompt (or prompt
+ (if default (format "Save to (%s): " default) "Save to: ")))
+ (initial (or initial default))
+ (dir (file-name-as-directory (or dir w3m-default-save-dir)))
+ (default-directory dir)
+ (file (read-file-name prompt dir default existing initial)))
+ (if (not (file-directory-p file))
+ (setq w3m-default-save-dir
+ (or (file-name-directory file) w3m-default-save-dir))
+ (setq w3m-default-save-dir file)
+ (if default
+ (setq file (expand-file-name default file))))
+ (expand-file-name file)))
+
+(defun w3m-read-passwd (prompt)
+ (let ((inhibit-input-event-recording t))
+ (if (fboundp 'read-passwd)
+ (condition-case nil
+ (read-passwd prompt)
+ (error ""))
+ (let ((pass "")
+ (c 0)
+ (echo-keystrokes 0)
+ (ociea cursor-in-echo-area))
+ (condition-case nil
+ (progn
+ (setq cursor-in-echo-area 1)
+ (while (and (/= c ?\r) (/= c ?\n) (/= c ?\e) (/= c 7)) ;; ^G
+ (message "%s%s"
+ prompt
+ (make-string (length pass) ?.))
+ (setq c (read-char-exclusive))
+ (cond
+ ((char-equal c ?\C-u)
+ (setq pass ""))
+ ((or (char-equal c ?\b) (char-equal c ?\177)) ;; BS DELL
+ ;; delete one character in the end
+ (if (not (equal pass ""))
+ (setq pass (substring pass 0 -1))))
+ ((< c 32) ()) ;; control, just ignore
+ (t
+ (setq pass (concat pass (char-to-string c))))))
+ (setq cursor-in-echo-area -1))
+ (quit
+ (setq cursor-in-echo-area ociea)
+ (signal 'quit nil))
+ (error
+ ;; Probably not happen. Just align to the code above.
+ (setq pass "")))
+ (setq cursor-in-echo-area ociea)
+ (message "")
+ (sit-for 0)
+ pass))))
+
+(defun w3m-search-name-anchor (name &optional quiet)
+ (interactive "sName: ")
+ (let ((pos (point-min)))
+ (catch 'found
+ (while (setq pos (next-single-property-change pos 'w3m-name-anchor))
+ (when (equal name (get-text-property pos 'w3m-name-anchor))
+ (goto-char pos)
+ (throw 'found t))
+ (setq pos (next-single-property-change pos 'w3m-name-anchor)))
+ (unless quiet
+ (message "Not found such name anchor."))
+ nil)))
+
+
+(defun w3m-save-position (url)
+ (if url
+ (let ((ident (intern-soft url w3m-backlog-hashtb)))
+ (when ident
+ (set ident (cons (window-start) (point)))))))
+
+(defun w3m-restore-position (url)
+ (let ((ident (intern-soft url w3m-backlog-hashtb)))
+ (when (and ident (boundp ident))
+ (set-window-start nil (car (symbol-value ident)))
+ (goto-char (cdr (symbol-value ident))))))
+
+
+(defun w3m-view-previous-page (&optional arg)
+ (interactive "p")
+ (unless arg (setq arg 1))
+ (let ((url (nth arg w3m-url-history)))
+ (when url
+ (let (w3m-url-history) (w3m-goto-url url))
+ ;; restore last position
+ (w3m-restore-position url)
+ (setq w3m-url-history
+ (nthcdr arg w3m-url-history)))))
+
+(defun w3m-view-previous-point ()
+ (interactive)
+ (w3m-restore-position w3m-current-url))
+
+(defun w3m-expand-url (url base)
+ "Convert URL to absolute, and canonicalize it."
+ (if (not base) (setq base ""))
+ (if (string-match "^[^:]+://[^/]*$" base)
+ (setq base (concat base "/")))
+ (cond
+ ;; URL is relative on BASE.
+ ((string-match "^#" url)
+ (concat base url))
+ ;; URL has absolute spec.
+ ((string-match "^[^:]+:" url)
+ url)
+ ((string-match "^/" url)
+ (if (string-match "^\\([^:]+://[^/]*\\)/" base)
+ (concat (match-string 1 base) url)
+ url))
+ (t
+ (let ((server "") path)
+ (if (string-match "^\\([^:]+://[^/]*\\)/" base)
+ (setq server (match-string 1 base)
+ base (substring base (match-end 1))))
+ (setq path (expand-file-name url (file-name-directory base)))
+ ;; remove drive (for Win32 platform)
+ (if (string-match "^.:" path)
+ (setq path (substring path (match-end 0))))
+ (concat server path)))))
+
+
+(defun w3m-view-this-url (arg)
+ "*View the URL of the link under point."
+ (interactive "P")
+ (let ((url (get-text-property (point) 'w3m-href-anchor)))
+ (if url (w3m-goto-url (w3m-expand-url url w3m-current-url) arg))))
+
+(defun w3m-mouse-view-this-url (event)
+ (interactive "e")
+ (mouse-set-point event)
+ (call-interactively (function w3m-view-this-url)))
+
+(defun w3m-view-image ()
+ "*View the image under point."
+ (interactive)
+ (let ((file (get-text-property (point) 'w3m-image)))
+ (if (not file)
+ (message "No file at point.")
+ (require 'w3)
+ (w3-fetch (w3m-expand-url file w3m-current-url)))))
+
+
+(defun w3m-save-image ()
+ "*Save the image under point to a file."
+ (interactive)
+ (let ((file (get-text-property (point) 'w3m-image)))
+ (if (not file)
+ (message "No file at point.")
+ (require 'w3)
+ (let ((mm-download-directory
+ (file-name-as-directory w3m-default-save-dir)))
+ (w3-download-url (w3m-expand-url file w3m-current-url))))))
+
+
+(defun w3m-view-current-url-with-external-browser ()
+ "*View this URL."
+ (interactive)
+ (let ((buffer (get-buffer-create " *w3m-view*"))
+ (url (get-text-property (point) 'w3m-href-anchor)))
+ (if url
+ (setq url (w3m-expand-url url w3m-current-url))
+ (if (y-or-n-p (format "Browse <%s> ? " w3m-current-url))
+ (setq url w3m-current-url)))
+ (when url
+ (message "Browse <%s>" url)
+ (if (and (symbolp w3m-browser-command)
+ (fboundp w3m-browser-command))
+ (funcall w3m-browser-command url)
+ (apply 'start-process
+ "w3m-external-browser"
+ buffer
+ w3m-browser-command
+ (mapcar (function eval)
+ w3m-browser-command-arguments))))))
+
+
+(defun w3m-download-this-url ()
+ "*Download the URL of the link under point to a file."
+ (interactive)
+ (let ((url (get-text-property (point) 'w3m-href-anchor)))
+ (if (not url)
+ (message "No URL at point.")
+ (require 'w3)
+ (let ((mm-download-directory
+ (file-name-as-directory w3m-default-save-dir)))
+ (w3-download-url (w3m-expand-url url w3m-current-url)))
+ (w3m-refontify-anchor (current-buffer)))))
+
+
+(defun w3m-print-current-url ()
+ "*Print the URL of current page and push it into kill-ring."
+ (interactive)
+ (kill-new w3m-current-url)
+ (message "%s" w3m-current-url))
+
+(defun w3m-print-this-url ()
+ "*Print the URL of the link under point."
+ (interactive)
+ (let ((url (get-text-property (point) 'w3m-href-anchor)))
+ (if url
+ (kill-new (setq url (w3m-expand-url url w3m-current-url))))
+ (message "%s" (or url "Not found."))))
+
+
+(defun w3m-next-anchor (&optional arg)
+ "*Move cursor to the next anchor."
+ (interactive "p")
+ (unless arg (setq arg 1))
+ (if (< arg 0)
+ ;; If ARG is negative.
+ (w3m-previous-anchor (- arg))
+ (when (get-text-property (point) 'w3m-href-anchor)
+ (goto-char (next-single-property-change (point) 'w3m-href-anchor)))
+ (while (and
+ (> arg 0)
+ (setq pos (next-single-property-change (point) 'w3m-href-anchor)))
+ (goto-char pos)
+ (unless (zerop (setq arg (1- arg)))
+ (goto-char (next-single-property-change (point) 'w3m-href-anchor))))))
+
+
+(defun w3m-previous-anchor (&optional arg)
+ "Move cursor to the previous anchor."
+ (interactive "p")
+ (unless arg (setq arg 1))
+ (if (< arg 0)
+ ;; If ARG is negative.
+ (w3m-next-anchor (- arg))
+ (when (get-text-property (point) 'w3m-href-anchor)
+ (goto-char (previous-single-property-change (1+ (point)) 'w3m-href-anchor)))
+ (while (and
+ (> arg 0)
+ (setq pos (previous-single-property-change (point) 'w3m-href-anchor)))
+ (goto-char (previous-single-property-change pos 'w3m-href-anchor))
+ (setq arg (1- arg)))))
+
+
+(defun w3m-expand-file-name (file)
+ (setq file (expand-file-name file))
+ (if (string-match "^\\(.\\):\\(.*\\)" file)
+ (if w3m-use-cygdrive
+ (concat "/cygdrive/" (match-string 1 file) (match-string 2 file))
+ (concat "file://" (match-string 1 file) (match-string 2 file)))
+ file))
+
+
+(defun w3m-view-bookmark ()
+ (interactive)
+ (if (file-readable-p w3m-bookmark-file)
+ (w3m-goto-url (w3m-expand-file-name w3m-bookmark-file))))
+
+
+(defun w3m-copy-buffer (buf &optional newname and-pop) "\
+Create a twin copy of the current buffer.
+if NEWNAME is nil, it defaults to the current buffer's name.
+if AND-POP is non-nil, the new buffer is shown with `pop-to-buffer'."
+ (interactive (list (current-buffer)
+ (if current-prefix-arg (read-string "Name: "))
+ t))
+ (setq newname (or newname (buffer-name)))
+ (if (string-match "<[0-9]+>\\'" newname)
+ (setq newname (substring newname 0 (match-beginning 0))))
+ (with-current-buffer buf
+ (let ((ptmin (point-min))
+ (ptmax (point-max))
+ (content (save-restriction (widen) (buffer-string)))
+ (mode major-mode)
+ (lvars (buffer-local-variables))
+ (new (generate-new-buffer (or newname (buffer-name)))))
+ (with-current-buffer new
+ ;;(erase-buffer)
+ (insert content)
+ (narrow-to-region ptmin ptmax)
+ (funcall mode) ;still needed?? -sm
+ (mapcar (lambda (v)
+ (if (not (consp v)) (makunbound v)
+ (condition-case () ;in case var is read-only
+ (set (make-local-variable (car v)) (cdr v))
+ (error nil))))
+ lvars)
+ (when and-pop (pop-to-buffer new))
+ new))))
+
+
+(defvar w3m-mode-map nil)
+(unless w3m-mode-map
+ (setq w3m-mode-map (make-keymap))
+ (define-key w3m-mode-map " " 'scroll-up)
+ (define-key w3m-mode-map "b" 'scroll-down)
+ (define-key w3m-mode-map [backspace] 'scroll-down)
+ (define-key w3m-mode-map [delete] 'scroll-down)
+ (define-key w3m-mode-map "h" 'backward-char)
+ (define-key w3m-mode-map "j" 'next-line)
+ (define-key w3m-mode-map "k" 'previous-line)
+ (define-key w3m-mode-map "l" 'forward-char)
+ (define-key w3m-mode-map "J" (lambda () (interactive) (scroll-up 1)))
+ (define-key w3m-mode-map "K" (lambda () (interactive) (scroll-up -1)))
+ (define-key w3m-mode-map "G" 'goto-line)
+ (define-key w3m-mode-map "\C-?" 'scroll-down)
+ (define-key w3m-mode-map "\t" 'w3m-next-anchor)
+ (define-key w3m-mode-map [down] 'w3m-next-anchor)
+ (define-key w3m-mode-map "\M-\t" 'w3m-previous-anchor)
+ (define-key w3m-mode-map [up] 'w3m-previous-anchor)
+ (define-key w3m-mode-map "\C-m" 'w3m-view-this-url)
+ (define-key w3m-mode-map [right] 'w3m-view-this-url)
+ (if (featurep 'xemacs)
+ (define-key w3m-mode-map [(button2)] 'w3m-mouse-view-this-url)
+ (define-key w3m-mode-map [mouse-2] 'w3m-mouse-view-this-url))
+ (define-key w3m-mode-map "\C-c\C-b" 'w3m-view-previous-point)
+ (define-key w3m-mode-map [left] 'w3m-view-previous-page)
+ (define-key w3m-mode-map "B" 'w3m-view-previous-page)
+ (define-key w3m-mode-map "d" 'w3m-download-this-url)
+ (define-key w3m-mode-map "u" 'w3m-print-this-url)
+ (define-key w3m-mode-map "I" 'w3m-view-image)
+ (define-key w3m-mode-map "\M-I" 'w3m-save-image)
+ (define-key w3m-mode-map "c" 'w3m-print-current-url)
+ (define-key w3m-mode-map "M" 'w3m-view-current-url-with-external-browser)
+ (define-key w3m-mode-map "g" 'w3m)
+ (define-key w3m-mode-map "U" 'w3m)
+ (define-key w3m-mode-map "V" 'w3m)
+ (define-key w3m-mode-map "v" 'w3m-view-bookmark)
+ (define-key w3m-mode-map "q" 'w3m-quit)
+ (define-key w3m-mode-map "Q" (lambda () (interactive) (w3m-quit t)))
+ (define-key w3m-mode-map "\M-n" 'w3m-copy-buffer)
+ (define-key w3m-mode-map "R" 'w3m-reload-this-page)
+ (define-key w3m-mode-map "?" 'describe-mode)
+ )
+
+
+(defun w3m-quit (&optional force)
+ (interactive "P")
+ (when (or force
+ (y-or-n-p "Do you want to exit w3m? "))
+ (kill-buffer (current-buffer))
+ (w3m-arrived-list-save)
+ (or (save-excursion
+ ;; Check existing w3m buffers.
+ (delq nil (mapcar (lambda (b)
+ (set-buffer b)
+ (eq major-mode 'w3m-mode))
+ (buffer-list))))
+ ;; If no w3m buffer exists, then destruct all cache.
+ (w3m-backlog-shutdown))))
+
+
+(defun w3m-mode ()
+ "\\<w3m-mode-map>
+ Major mode to browsing w3m buffer.
+
+\\[w3m-view-this-url] View this url.
+\\[w3m-mouse-view-this-url] View this url.
+\\[w3m-reload-this-page] Reload this page.
+\\[w3m-next-anchor] Jump next anchor.
+\\[w3m-previous-anchor] Jump previous anchor.
+\\[w3m-view-previous-page] Back to previous page.
+
+\\[w3m-download-this-url] Download this url.
+\\[w3m-print-this-url] Print this url.
+\\[w3m-view-image] View image.
+\\[w3m-save-image] Save image.
+
+\\[w3m-print-current-url] Print current url.
+\\[w3m-view-current-url-with-external-browser] View current url with external browser.
+
+\\[scroll-up] Scroll up.
+\\[scroll-down] Scroll down.
+
+\\[next-line] Next line.
+\\[previous-line] Previous line.
+
+\\[forward-char] Forward char.
+\\[backward-char] Backward char.
+
+\\[goto-line] Jump to line.
+\\[w3m-view-previous-point] w3m-view-previous-point.
+
+\\[w3m] w3m.
+\\[w3m-view-bookmark] w3m-view-bookmark.
+\\[w3m-copy-buffer] w3m-copy-buffer.
+
+\\[w3m-quit] w3m-quit.
+\\[describe-mode] describe-mode.
+"
+ (kill-all-local-variables)
+ (buffer-disable-undo)
+ (setq major-mode 'w3m-mode
+ mode-name "w3m")
+ (use-local-map w3m-mode-map)
+ (run-hooks 'w3m-mode-hook))
+
+(defun w3m-mailto-url (url)
+ (if (and (symbolp w3m-mailto-url-function)
+ (fboundp w3m-mailto-url-function))
+ (funcall w3m-mailto-url-function url)
+ (let (comp)
+ ;; Require `mail-user-agent' setting
+ (if (not (and (boundp 'mail-user-agent)
+ mail-user-agent
+ (setq comp (intern-soft (concat (symbol-name mail-user-agent)
+ "-compose")))
+ (fboundp comp)))
+ (error "You must specify valid `mail-user-agent'."))
+ ;; Use rfc2368.el if exist.
+ ;; rfc2368.el is written by Sen Nagata.
+ ;; You can find it in "contrib" directory of Mew package
+ ;; or in "utils" directory of Wanderlust package.
+ (if (or (featurep 'rfc2368)
+ (condition-case nil (require 'rfc2368) (error nil)))
+ (let ((info (rfc2368-parse-mailto-url url)))
+ (apply comp (mapcar (lambda (x)
+ (cdr (assoc x info)))
+ '("To" "Subject"))))
+ ;; without rfc2368.el.
+ (funcall comp (match-string 1 url))))))
+
+
+(defun w3m-goto-url (url &optional reload)
+ "Retrieve URL and display it in this buffer."
+ (let (name buff)
+ (if reload
+ (w3m-backlog-remove url))
+ (cond
+ ;; process mailto: protocol
+ ((string-match "^mailto:\\(.*\\)" url)
+ (w3m-mailto-url url))
+ (t
+ (when (string-match "#\\([^#]+\\)$" url)
+ (setq name (match-string 1 url)
+ url (substring url 0 (match-beginning 0))))
+ (w3m-save-position w3m-current-url)
+ (or w3m-arrived-anchor-list (w3m-arrived-list-load))
+ (w3m-arrived-list-add url)
+ (if (setq buff (w3m-exec url))
+ ;; no w3m exec and return *w3m* buffer.
+ (w3m-refontify-anchor buff)
+ ;; w3m exec.
+ (w3m-fontify)
+ (setq buffer-read-only t)
+ (set-buffer-modified-p nil)
+ (or (and name (w3m-search-name-anchor name))
+ (goto-char (point-min))))))))
+
+
+(defun w3m-reload-this-page ()
+ "Reload current page without cache."
+ (interactive)
+ (setq w3m-url-history (cdr w3m-url-history))
+ (w3m-goto-url w3m-current-url 'reload))
+
+
+(defun w3m (url &optional args)
+ "Interface for w3m on Emacs."
+ (interactive (list (w3m-input-url)))
+ (set-buffer (get-buffer-create "*w3m*"))
+ (or (eq major-mode 'w3m-mode)
+ (w3m-mode))
+ (setq mode-line-buffer-identification
+ (list "%12b" " / " 'w3m-current-title))
+ (if (string= url "")
+ (w3m-view-bookmark)
+ (w3m-goto-url url))
+ (switch-to-buffer (current-buffer))
+ (run-hooks 'w3m-hook))
+
+
+(defun w3m-browse-url (url &optional new-window)
+ "w3m interface function for browse-url.el."
+ (interactive
+ (progn
+ (require 'browse-url)
+ (browse-url-interactive-arg "w3m URL: ")))
+ (if new-window (split-window))
+ (w3m url))
+
+(defun w3m-find-file (file)
+ "w3m Interface function for local file."
+ (interactive "fFilename: ")
+ (w3m (w3m-expand-file-name file)))
+
+(provide 'w3m)
+;;; w3m.el ends here.