1253 lines
40 KiB
EmacsLisp
1253 lines
40 KiB
EmacsLisp
;;; -*- 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.
|