aboutsummaryrefslogtreecommitdiffstats
path: root/lisp/w3m.el
diff options
context:
space:
mode:
Diffstat (limited to 'lisp/w3m.el')
-rw-r--r--lisp/w3m.el1252
1 files changed, 0 insertions, 1252 deletions
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.
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-21 22:53:25 +0000