diff options
Diffstat (limited to 'lisp')
| -rw-r--r-- | lisp/ChangeLog | 179 | ||||
| -rw-r--r-- | lisp/w3m.el | 1252 |
2 files changed, 0 insertions, 1431 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog deleted file mode 100644 index 59e89f8..0000000 --- a/lisp/ChangeLog +++ /dev/null @@ -1,179 +0,0 @@ -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 deleted file mode 100644 index e096746..0000000 --- a/lisp/w3m.el +++ /dev/null @@ -1,1252 +0,0 @@ -;;; -*- 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. |