diff options
Diffstat (limited to '')
| -rw-r--r-- | lisp/ChangeLog | 179 | ||||
| -rw-r--r-- | lisp/w3m.el | 1252 |
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. |