w3m-el-snapshot-1.4.527+0.20140108.orig/0000755000000000000000000000000012271164033015320 5ustar rootrootw3m-el-snapshot-1.4.527+0.20140108.orig/README0000644000000000000000000002014011020433372016171 0ustar rootroot This package contains emacs-w3m, an Emacs interface to w3m 1. Introduction w3m is a pager with WWW capability, developed by Akinori ITO. Although it is a pager, it can be used as a text-mode WWW browser. Visit the official w3m page for details: http://w3m.sourceforge.net/ Emacs-w3m is a simple Emacs interface to w3m. Its official web page is available at: http://emacs-w3m.namazu.org/ You can find more detailed version of the following explanations in the form of HTML'ized info: http://emacs-w3m.namazu.org/info/ 2. Requirements Check whether your system meets the following requirements before installing emacs-w3m. Emacs-w3m requires the latest version of w3m (version 0.3.1 and later). Since this program is much sensitive to the version of w3m, you should confirm it if you already have w3m installed. And we recommend you visit the official w3m web page to check whether a newer version of w3m has been released: http://prdownloads.sourceforge.net/w3m/ If you want to use the shimbun library which is included in the emacs-w3m distribution, you have to install FLIM package. For more detail about the shimbun library, see "Shimbun Library" section in Info. a) Emacs 21.x No additional packages are required. b) XEmacs 21.x First of all, you should note that emacs-w3m supports only XEmacs 21.4.17 and later and XEmacs 21.5-b19 and later. In addition, you need to have installed the latest xemacs-base package including the timer-funcs.el module. APEL package is required. Use the latest one available in: http://kanji.zinbun.kyoto-u.ac.jp/~tomo/lemi/dist/apel/ Note: You must not use the APEL XEmacs package (which is contained in SUMO) of the versions older than 1.32. If you have already installed such a version, you should upgrade it or replace it with APEL which is linked above (you can also use the same directives in order to newly install APEL): % rm -fr /usr/local/lib/xemacs/xemacs-packages/lisp/apel % cd apel-10.7 % make install-package XEMACS=xemacs-21.4.x\ PACKAGEDIR=/usr/local/lib/xemacs/xemacs-packages If you are using XEmacs 21.x, you should install the "gifsicle" program. There is a known bug in all XEmacs 21.x series that it won't let it display optimized animated gifs correctly or may make it crash when some kind of an interlaced gif image is displayed. Emacs-w3m uses the "gifsicle" program to convert gif data in order to make it possible to be handled by XEmacs 21.x. It is available at: http://www.lcdf.org/gifsicle/ c) Emacs 20.x, Emacs 19.34 (including Mule 2.3) Emacs-w3m no longer supports those Emacs versions. 3. Installation 3.1. Installing emacs-w3m on UNIX-like systems At the first, run the `configure' script. % ./configure If you can't find the `configure' script, rus the `autoconf' command. It create this script. % autoconf Important notice to the Gnus users: =================================== If the various versions of Gnusae are installed in your system (it is likely that there are the released version and the development version of Gnusae), make sure that priority is given to the directory where the gnus.elc file which you use is installed in the load-path. To do that, use the --with-addpath option as follows: % ./configure --with-addpath=/usr/local/share/emacs/site-lisp/gnus If you've installed APEL, FLIM or something in non-standard directories other than the default `load-path', you must specify them using the --with-addpath option as follows (you may also include the Gnus directory being separated with `:' in it): % ./configure --with-addpath=/opt/share/apel:/opt/share/flim Next, execute the following commands to install emacs-w3m to an appropriate directory. % make % make install If you are using Emacs 21 or XEmacs, you had better install icon image files. To do this: % make install-icons or % make install-icons30 The latter will install the slightly larger icons with characters. You can also install emacs-w3m as an XEmacs package using `make install-package' instead of `make install'. % make % make install-package In this case, you don't have to execute `make install-icons' nor `make install-icons30'. The info files will also be installed by `make install' or `make install-package'. 3.2. Installing on non-UNIX-like systems If you cannot execute the `configure' script on your system, or if no `make' command is available, execute the following command: % emacs -batch -q -no-site-file -l w3mhack.el NONE -f w3mhack-nonunix-install If APEL, FLIM (or any other library) aren't installed in the ordinary places, the installer will leave them out. In such a case, it is necessary to tell those places to the installer as shown below: % emacs -batch -q -no-site-file -l w3mhack.el //c/share/apel://c/share/flim -f w3mhack-nonunix-install 4. Configuration We recommend using the ~/.emacs-w3m file (which is the default value of `w3m-init-file') when you twiddle some variables of emacs-w3m. This file is similar to ~/.emacs, but is read when emacs-w3m starts. However, note that there are options which shouldn't be put there, for example, `w3m-command'. 4.1. Essential Configuration Put this line into your ~/.emacs file: (require 'w3m-load) You have nothing to do if you have emacs-w3m installed as an XEmacs package. 4.2. mime-w3m.el In order to handle text/html part with emacs-w3m under SEMI MUAs such as T-gnus and Wanderlust, you have to put the following line in your ~/.emacs file: (require 'mime-w3m) 4.3. Proxy Gateway There are some ways to do this, one is to set the "http_proxy" environment variable globally in the shell something like: setenv http_proxy http://proxy.hogege.com:8000/ Another way is to customize the `w3m-command-arguments' variable to add the options "-o" and "http_proxy=http://PROXY_SERVER_NAME:PORT/". This can also be done in your ~/.emacs-w3m file as shown below: (setq w3m-command-arguments (nconc w3m-command-arguments '("-o" "http_proxy=http://proxy.hogege.com:8000/"))) To specify `no-proxy' hosts, which shouldn't be connected to with proxy gateways, you can set the "no_proxy" environment variable with the comma separated host names, or set the `w3m-no-proxy-domains' variable with a list of domain names (not host names) as follows: (setq w3m-no-proxy-domains '("local.com" "neighbor.com")) See also the documentation for the `w3m-command-arguments-alist' variable to use regexps to specify the `no-proxy' hosts. 5. Contact the emacs-w3m community To contact the emacs-w3m community for reporting bugs, contributing improvements, making a suggestion or asking us for help, send a mail to the open list . You can also send a bug report using the `report-emacs-w3m-bug' command or the `C-c C-b' key if you have set the `mail-user-agent' variable that will work properly. 6. Acknowledgments w3m, which is an essential part of this package, was written by Akinori ITO. We'd like to address our thanks to him for his nice work. 7. Related Information [1] APEL It can be downloaded from: http://kanji.zinbun.kyoto-u.ac.jp/~tomo/lemi/dist/apel/ [2] FLIM It can be downloaded from: http://kanji.zinbun.kyoto-u.ac.jp/~tomo/lemi/dist/flim/flim-1.14/ Before installing it, it is necessary to install APEL. [3] gifsicle It can be downloaded from: http://www.lcdf.org/gifsicle/ Local Variables: mode: indented-text mode: outline-minor outline-regexp: "[0-9]\\.[0-9]\\.[0-9]\\.\\|[0-9]\\.[0-9]\\.\\|[0-9]\\." coding: ascii fill-column: 72 End: w3m-el-snapshot-1.4.527+0.20140108.orig/attic/0000755000000000000000000000000012271164033016424 5ustar rootrootw3m-el-snapshot-1.4.527+0.20140108.orig/attic/addpath.el0000644000000000000000000001244510216576033020365 0ustar rootroot;; This file is used for the make rule `very-slow' which adds the user ;; specific additional directories and the current source directories ;; to `load-path'. ;; Add `configure-package-path' to `load-path' for XEmacs. Those paths ;; won't appear in `load-path' when XEmacs starts with the `-vanilla' ;; option or the `-no-autoloads' option because of a bug. :< (if (and (featurep 'xemacs) (boundp 'configure-package-path) (listp configure-package-path)) (let ((paths (apply 'nconc (mapcar (lambda (path) (if (and (stringp path) (not (string-equal path "")) (file-directory-p (setq path (expand-file-name "lisp" path)))) (directory-files path t))) configure-package-path))) path adds) (while paths (setq path (car paths) paths (cdr paths)) (if (and path (not (or (string-match "/\\.\\.?\\'" path) (member (file-name-as-directory path) load-path) (member path load-path))) (file-directory-p path)) (setq adds (cons (file-name-as-directory path) adds)))) (setq load-path (nconc (nreverse adds) load-path)))) (let ((addpath (prog1 (or (car command-line-args-left) "NONE") (setq command-line-args-left (cdr command-line-args-left)))) path paths) (while (string-match "\\([^\0-\37:]+\\)[\0-\37:]*" addpath) (setq path (expand-file-name (substring addpath (match-beginning 1) (match-end 1))) addpath (substring addpath (match-end 0))) (if (file-directory-p path) (setq paths (cons path paths)))) (or (null paths) (setq load-path (append (nreverse paths) load-path)))) (setq load-path (append (list default-directory (expand-file-name "shimbun")) load-path)) (if (and (boundp 'emacs-major-version) (>= emacs-major-version 21)) (defadvice load (before nomessage activate) "Shut up `Loading...' message." (ad-set-arg 2 t))) ;; Check whether the shell command can be used. (let ((test (lambda (shell) (let ((buffer (generate-new-buffer " *temp*")) (msg "Hello World")) (save-excursion (set-buffer buffer) (condition-case nil (call-process shell nil t nil "-c" (concat "MESSAGE=\"" msg "\"&&" "echo \"${MESSAGE}\"")) (error)) (prog2 (goto-char (point-min)) (search-forward msg nil t) (kill-buffer buffer))))))) (or (funcall test shell-file-name) (progn (require 'executable) (let ((executable-binary-suffixes (if (memq system-type '(OS/2 emx)) '(".exe" ".com" ".bat" ".cmd" ".btm" "") executable-binary-suffixes)) shell) (or (and (setq shell (executable-find "cmdproxy")) (funcall test shell) (setq shell-file-name shell)) (and (setq shell (executable-find "sh")) (funcall test shell) (setq shell-file-name shell)) (and (setq shell (executable-find "bash")) (funcall test shell) (setq shell-file-name shell)) (error "%s" "\n\ There seems to be no shell command which is equivalent to /bin/sh. Try ``make SHELL=foo [option...]'', where `foo' is the absolute path name for the proper shell command in your system.\n")))))) ;; Load custom and bind defcustom'ed variables for Emacs 19. (if (>= emacs-major-version 20) nil (require 'custom) (put 'custom-declare-variable 'byte-hunk-handler 'byte-compile-file-form-custom-declare-variable) (defun byte-compile-file-form-custom-declare-variable (form) (if (memq 'free-vars byte-compile-warnings) (setq byte-compile-bound-variables (cons (nth 1 (nth 1 form)) byte-compile-bound-variables))) (if (memq ':version (nthcdr 4 form)) ;; Make the variable uncustomizable. `(defvar ,(nth 1 (nth 1 form)) ,(nth 1 (nth 2 form)) ,(substring (nth 3 form) (if (string-match "^[\t *]+" (nth 3 form)) (match-end 0) 0))) ;; Ignore unsupported keyword(s). (if (memq ':set-after (nthcdr 4 form)) (let ((newform (list (car form) (nth 1 form) (nth 2 form) (nth 3 form))) (args (nthcdr 4 form))) (while args (or (eq (car args) ':set-after) (setq newform (nconc newform (list (car args) (car (cdr args)))))) (setq args (cdr (cdr args)))) newform) form))) ;; Make it run quietly. (defun locate-library (library &optional nosuffix) "Show the full path name of Emacs library LIBRARY. This command searches the directories in `load-path' like `M-x load-library' to find the file that `M-x load-library RET LIBRARY RET' would load. Optional second arg NOSUFFIX non-nil means don't add suffixes `.elc' or `.el' to the specified name LIBRARY (a la calling `load' instead of `load-library')." (interactive "sLocate library: ") (catch 'answer (mapcar '(lambda (dir) (mapcar '(lambda (suf) (let ((try (expand-file-name (concat library suf) dir))) (and (file-readable-p try) (null (file-directory-p try)) (progn (or noninteractive (message "Library is file %s" try)) (throw 'answer try))))) (if nosuffix '("") '(".elc" ".el" "")))) load-path) (or noninteractive (message "No library %s in search path" library)) nil)) (condition-case nil (char-after) (wrong-number-of-arguments (put 'char-after 'byte-optimizer (lambda (form) (if (cdr form) form '(char-after (point)))))))) w3m-el-snapshot-1.4.527+0.20140108.orig/attic/rfc2368.el0000644000000000000000000001072610444127745020062 0ustar rootroot;;; rfc2368.el --- support for rfc2368 ;; Author: Sen Nagata ;; Keywords: mail ;; Copyright (C) 1998, 2000, 2002, 2003, 2004, ;; 2005, 2006 Free Software Foundation, Inc. ;; This file is part of GNU Emacs. ;; GNU Emacs 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, or (at your option) ;; any later version. ;; GNU Emacs 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 GNU Emacs; see the file COPYING. If not, write to the ;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ;; Boston, MA 02110-1301, USA. ;;; Commentary: ;; ;; notes: ;; ;; -repeat after me: "the colon is not part of the header name..." ;; -if w3 becomes part of emacs, then it may make sense to have this ;; file depend on w3 -- the maintainer of w3 says merging w/ Emacs ;; is planned! ;; ;; historical note: ;; ;; this is intended as a replacement for mailto.el ;; ;; acknowledgements: ;; ;; the functions that deal w/ unhexifying in this file were basically ;; taken from w3 -- i hope to replace them w/ something else soon OR ;; perhaps if w3 becomes a part of emacs soon, use the functions from w3. ;;; History: ;; ;; modified rfc2368-unhexify-string to work with both Emacs and XEmacs ;; ;; 0.3: ;; ;; added the constant rfc2368-version ;; implemented first potential fix for a bug in rfc2368-mailto-regexp ;; implemented first potential fix for a bug in rfc2368-parse-mailto ;; (both bugs reported by Kenichi OKADA) ;; ;; 0.2: ;; ;; started to use checkdoc ;; ;; 0.1: ;; ;; initial implementation ;;; Code: ;; only an approximation? ;; see rfc 1738 (defconst rfc2368-mailto-regexp "^\\(mailto:\\)\\([^?]+\\)*\\(\\?\\(.*\\)\\)*" "Regular expression to match and aid in parsing a mailto url.") ;; describes 'mailto:' (defconst rfc2368-mailto-scheme-index 1 "Describes the 'mailto:' portion of the url.") ;; i'm going to call this part the 'prequery' (defconst rfc2368-mailto-prequery-index 2 "Describes the portion of the url between 'mailto:' and '?'.") ;; i'm going to call this part the 'query' (defconst rfc2368-mailto-query-index 4 "Describes the portion of the url after '?'.") (defun rfc2368-unhexify-string (string) "Unhexify STRING -- e.g. 'hello%20there' -> 'hello there'." (while (string-match "%\\([0-9A-Fa-f][0-9A-Fa-f]\\)" string) (setq string (replace-match (string (string-to-number (match-string 1 string) 16)) t t string))) string) (defun rfc2368-parse-mailto-url (mailto-url) "Parse MAILTO-URL, and return an alist of header-name, header-value pairs. MAILTO-URL should be a RFC 2368 (mailto) compliant url. A cons cell w/ a key of 'Body' is a special case and is considered a header for this purpose. The returned alist is intended for use w/ the `compose-mail' interface. Note: make sure MAILTO-URL has been 'unhtmlized' (e.g. & -> &), before calling this function." (let ((case-fold-search t) prequery query headers-alist) (if (string-match rfc2368-mailto-regexp mailto-url) (progn (setq prequery (match-string rfc2368-mailto-prequery-index mailto-url)) (setq query (match-string rfc2368-mailto-query-index mailto-url)) ;; build alist of header name-value pairs (if (not (null query)) (setq headers-alist (mapcar (lambda (x) (let* ((temp-list (split-string x "=")) (header-name (car temp-list)) (header-value (cadr temp-list))) ;; return ("Header-Name" . "header-value") (cons (capitalize (rfc2368-unhexify-string header-name)) (rfc2368-unhexify-string header-value)))) (split-string query "&")))) ;; deal w/ multiple 'To' recipients (if prequery (progn (setq prequery (rfc2368-unhexify-string prequery)) (if (assoc "To" headers-alist) (let* ((our-cons-cell (assoc "To" headers-alist)) (our-cdr (cdr our-cons-cell))) (setcdr our-cons-cell (concat prequery ", " our-cdr))) (setq headers-alist (cons (cons "To" prequery) headers-alist))))) headers-alist) (error "Failed to match a mailto: url")) )) (provide 'rfc2368) ;;; arch-tag: ea804934-ad96-4f69-957b-857a76e4fd95 ;;; rfc2368.el ends here w3m-el-snapshot-1.4.527+0.20140108.orig/w3m-proc.el0000644000000000000000000007365612212352551017331 0ustar rootroot;;; w3m-proc.el --- Functions and macros to control sub-processes ;; Copyright (C) 2001-2005, 2007-2010, 2012, 2013 ;; TSUCHIYA Masatoshi ;; Authors: TSUCHIYA Masatoshi , ;; Shun-ichi GOTO , ;; Satoru Takabayashi , ;; Hideyuki SHIRAI , ;; Keisuke Nishida , ;; Yuuichi Teranishi , ;; Akihiro Arisawa , ;; Katsumi Yamaoka ;; Keywords: w3m, WWW, hypermedia ;; This file is a part of emacs-w3m. ;; This program 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, or (at your option) ;; any later version. ;; This program 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 this program; see the file COPYING. If not, write to ;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ;; Boston, MA 02110-1301, USA. ;;; Commentary: ;; This module is a part of emacs-w3m which provides functions and ;; macros to control sub-processes. Visit ;; for more details of emacs-w3m. ;;; Code: (eval-when-compile (require 'cl)) (require 'w3m-util) (eval-when-compile ;; Variable(s) which are used in the following inline functions. ;; They should be defined in the other module at run-time. (defvar w3m-current-url) (defvar w3m-current-buffer) (defvar w3m-current-process) (defvar w3m-profile-directory) (defvar w3m-terminal-coding-system) (defvar w3m-command) (defvar w3m-command-arguments) (defvar w3m-command-environment) (defvar w3m-async-exec) (defvar w3m-process-connection-type) (defvar w3m-process-modeline-format) (defvar w3m-work-buffer-list) (autoload 'w3m-idle-images-show-unqueue "w3m")) (defvar w3m-process-inhibit-quit t "`w3m-process-sentinel' binds `inhibit-quit' according to this variable.") (defvar w3m-process-timeout 300 "Number of seconds idle time waiting for processes to terminate.") (defvar w3m-process-kill-surely (featurep 'meadow) "If non-nil, kill the process surely.") (defconst w3m-process-max 5 "The maximum limit of the working processes.") (defvar w3m-process-queue nil "Queue of processes.") (defvar w3m-process-exit-status nil "The last exit status of a process.") (defvar w3m-process-authinfo-alist nil) (defvar w3m-process-accept-alist nil) (defvar w3m-process-user nil) (defvar w3m-process-passwd nil) (defvar w3m-process-realm nil) (defvar w3m-process-object nil) (make-variable-buffer-local 'w3m-process-user) (make-variable-buffer-local 'w3m-process-passwd) (make-variable-buffer-local 'w3m-process-realm) (make-variable-buffer-local 'w3m-process-object) (defvar w3m-process-modeline-string nil "Modeline string to show status of retrieving process.") (make-variable-buffer-local 'w3m-process-modeline-string) (defvar w3m-process-proxy-user nil "User name of the proxy server.") (defvar w3m-process-proxy-passwd nil "Password of the proxy server.") (defvar w3m-process-ssl-passphrase nil "Passphrase for the client certificate.") (defmacro w3m-process-with-coding-system (&rest body) "Set coding systems for `w3m-command', and evaluate BODY." `(let ((coding-system-for-read 'binary) (coding-system-for-write w3m-terminal-coding-system) (default-process-coding-system (cons 'binary w3m-terminal-coding-system)) (process-connection-type w3m-process-connection-type)) ,@body)) (put 'w3m-process-with-coding-system 'lisp-indent-function 0) (put 'w3m-process-with-coding-system 'edebug-form-spec '(body)) (defmacro w3m-process-with-environment (alist &rest body) "Set the environment variables according to ALIST, and evaluate BODY." `(let ((process-environment (copy-sequence process-environment)) (temporary-file-directory (if (file-directory-p w3m-profile-directory) (file-name-as-directory w3m-profile-directory) ,(if (featurep 'xemacs) ;; Though `temporary-file-directory' exists even in XEmacs, ;; that's only an imitation provided by APEL. '(temp-directory) 'temporary-file-directory))) (default-directory (cond ((file-directory-p w3m-profile-directory) (file-name-as-directory w3m-profile-directory)) ((file-directory-p (expand-file-name "~/")) (expand-file-name "~/")) (t temporary-file-directory)))) ;; XEmacs obtains tmp-dir from the `temp-directory' function of which ;; return value can only be modified by the following env vars. ,@(if (featurep 'xemacs) '((setenv "TEMP" temporary-file-directory) ;; Windoze (setenv "TMPDIR" temporary-file-directory))) ;; Un|x (dolist (pair ,alist) (setenv (car pair) (cdr pair))) ,@body)) (put 'w3m-process-with-environment 'lisp-indent-function 1) (put 'w3m-process-with-environment 'edebug-form-spec '(form body)) (defun w3m-process-p (object) "Return t if OBJECT is a `w3m-process' object." (and (consp object) (vectorp (cdr object)) (eq 'w3m-process-object (aref (cdr object) 0)))) (put 'w3m-process-new 'edebug-form-spec '(form form form &optional form form)) (defmacro w3m-process-new (command arguments buffer &optional process handlers) "Return a new `w3m-process' object." `(cons (cons ,command ,arguments) (vector 'w3m-process-object ,buffer ,process ,handlers))) (defmacro w3m-process-command (object) `(car (car ,object))) (defmacro w3m-process-arguments (object) `(cdr (car ,object))) (defmacro w3m-process-buffer (object) `(aref (cdr ,object) 1)) (defmacro w3m-process-process (object) `(aref (cdr ,object) 2)) (defmacro w3m-process-handlers (object) `(aref (cdr ,object) 3)) (put 'w3m-process-handler-new 'edebug-form-spec '(form form form)) (defmacro w3m-process-handler-new (buffer parent-buffer functions) `(vector ,buffer ,parent-buffer ,functions nil)) (defmacro w3m-process-handler-buffer (handler) `(aref ,handler 0)) (defmacro w3m-process-handler-parent-buffer (handler) `(aref ,handler 1)) (defmacro w3m-process-handler-functions (handler) `(aref ,handler 2)) (defmacro w3m-process-handler-result (handler) `(aref ,handler 3)) (defun w3m-process-push (handler command arguments) "Generate a new `w3m-process' object which is provided by HANDLER, ARGUMENTS and this buffer, regist it to `w3m-process-queue', and return it." (let ((x (assoc (cons command arguments) w3m-process-queue))) (unless x (setq x (w3m-process-new command arguments (current-buffer))) (push x w3m-process-queue)) (push (w3m-process-handler-new (current-buffer) w3m-current-buffer handler) (w3m-process-handlers x)) (with-current-buffer (w3m-process-buffer x) (setq w3m-process-object x)))) (defun w3m-process-kill-process (process) "Kill process PROCESS safely." (when (processp process) (set-process-filter process 'ignore) (set-process-sentinel process 'ignore) (when (memq (process-status process) '(run stop)) (kill-process process) (when w3m-process-kill-surely (while (memq (process-status process) '(run stop)) (sit-for 0.1)))))) (defun w3m-process-start-process (object &optional no-sentinel) "Start a process specified by the OBJECT, return always nil. When NO-SENTINEL is not equal to nil, all status changes of the generated asynchronous process is ignored. Otherwise, `w3m-process-sentinel' is given to the process as the sentinel." (if (w3m-process-process object) (when no-sentinel (set-process-sentinel (w3m-process-process object) 'ignore)) (with-current-buffer (w3m-process-buffer object) (w3m-process-with-coding-system (w3m-process-with-environment w3m-command-environment (let* ((command (w3m-process-command object)) (proc (apply 'start-process command (current-buffer) command (w3m-process-arguments object))) (authinfo (when w3m-current-url (w3m-url-authinfo w3m-current-url))) (set-process-query-on-exit-flag (if (fboundp 'set-process-query-on-exit-flag) 'set-process-query-on-exit-flag 'process-kill-without-query))) (setq w3m-process-user (car authinfo) w3m-process-passwd (cdr authinfo) w3m-process-realm nil) (setf (w3m-process-process object) proc) (set-process-filter proc 'w3m-process-filter) (set-process-sentinel proc (if no-sentinel 'ignore 'w3m-process-sentinel)) (funcall set-process-query-on-exit-flag proc nil)))))) nil) ;; The return value of `w3m-process-start-process'. (defun w3m-process-kill-stray-processes () "Kill stray processes." (dolist (obj w3m-process-queue) (unless (buffer-name (w3m-process-buffer obj)) (setq w3m-process-queue (delq obj w3m-process-queue)) (when (w3m-process-process obj) (w3m-process-kill-process (w3m-process-process obj)))))) (defun w3m-process-start-queued-processes () "Start a process which is registerd in `w3m-process-queue' if the number of current working processes is less than `w3m-process-max'." (w3m-process-kill-stray-processes) (let ((num 0)) (catch 'last (dolist (obj (reverse w3m-process-queue)) (when (buffer-name (w3m-process-buffer obj)) (if (> (incf num) w3m-process-max) (throw 'last nil) (w3m-process-start-process obj))))))) (defun w3m-process-stop (buffer) "Remove handlers related to the buffer BUFFER, and stop processes which have no handler." (interactive (list (current-buffer))) (w3m-cancel-refresh-timer buffer) (setq w3m-process-queue (delq nil (mapcar (lambda (obj) (let ((handlers ;; List up handlers related to other buffer ;; than the buffer BUFFER. (delq nil (mapcar (lambda (handler) (unless (eq buffer (w3m-process-handler-parent-buffer handler)) handler)) (w3m-process-handlers obj))))) (if handlers (w3m-process-new (w3m-process-command obj) (w3m-process-arguments obj) (w3m-process-buffer obj) (w3m-process-process obj) (if (memq (w3m-process-buffer obj) (mapcar (lambda (x) (w3m-process-handler-buffer x)) handlers)) handlers (cons ;; Dummy handler to remove buffer. (w3m-process-handler-new (w3m-process-buffer obj) (w3m-process-handler-parent-buffer (car handlers)) (lambda (x) (w3m-kill-buffer (current-buffer)))) handlers))) (when (w3m-process-process obj) (w3m-process-kill-process (w3m-process-process obj))) (dolist (handler (w3m-process-handlers obj)) (w3m-kill-buffer (w3m-process-handler-buffer handler))) nil))) w3m-process-queue))) (when (buffer-name buffer) (with-current-buffer buffer (setq w3m-current-process nil))) (w3m-process-start-queued-processes) (w3m-force-window-update-later buffer)) (defun w3m-process-shutdown () (let ((list w3m-process-queue)) (setq w3m-process-queue nil w3m-process-authinfo-alist nil w3m-process-accept-alist nil) (dolist (obj list) (when (buffer-name (w3m-process-buffer obj)) (when (w3m-process-process obj) (w3m-process-kill-process (w3m-process-process obj)))) (w3m-kill-buffer (w3m-process-buffer obj))))) (defmacro w3m-process-with-null-handler (&rest body) "Generate the null handler, and evaluate BODY. When BODY is evaluated, the local variable `handler' keeps the null handler." (let ((var (gensym "--tempvar--"))) `(let ((,var (let (handler) ,@body))) (when (w3m-process-p ,var) (w3m-process-start-process ,var)) ,var))) (put 'w3m-process-with-null-handler 'lisp-indent-function 0) (put 'w3m-process-with-null-handler 'edebug-form-spec '(body)) ;; Error symbol: (put 'w3m-process-timeout 'error-conditions '(error w3m-process-timeout)) (put 'w3m-process-timeout 'error-message "Time out") (defun w3m-process-error-handler (error-data process) (setq w3m-process-queue (delq process w3m-process-queue)) (w3m-process-kill-process (w3m-process-process process)) (signal (car error-data) (cdr error-data))) (defvar w3m-process-waited nil "Non-nil means that `w3m-process-with-wait-handler' is being evaluated.") (defun w3m-process-wait-process (process seconds) "Wait for SECONDS seconds or until PROCESS will exit. Returns the exit status of the PROCESS when it exit normally, otherwise returns nil." (catch 'timeout (let ((start (current-time))) (while (or (and (prog2 (discard-input) (not (save-current-buffer (sit-for 0.1))) (discard-input)) ;; Some input is detected but it may be a key ;; press event which should be ignored when the ;; process is not running. (memq (process-status process) '(open run))) (memq (process-status process) '(open run stop))) (and seconds (< seconds (w3m-time-lapse-seconds start (current-time))) (throw 'timeout nil))) (process-exit-status process)))) (defmacro w3m-process-with-wait-handler (&rest body) "Generate the waiting handler, and evaluate BODY. When BODY is evaluated, the local variable `handler' keeps the handler which will wait for the end of the evaluation." (let ((result (gensym "--result--")) (wait-function (gensym "--wait-function--"))) `(let ((w3m-process-waited t) (,result) (,wait-function (make-symbol "wait-function"))) (fset ,wait-function 'identity) (setq ,result (let ((handler (list ,wait-function))) ,@body)) (while (w3m-process-p ,result) (condition-case error (let (w3m-process-inhibit-quit inhibit-quit) ;; No sentinel function is registered and the process ;; sentinel function is called from this macro, in ;; order to avoid the dead-locking which occurs when ;; this macro is called in the environment that ;; `w3m-process-sentinel' is evaluated. (w3m-process-start-process ,result t) (unless (w3m-process-wait-process (w3m-process-process ,result) w3m-process-timeout) (w3m-process-error-handler (cons 'w3m-process-timeout nil) ,result))) (quit (w3m-process-error-handler error ,result))) (w3m-process-sentinel (w3m-process-process ,result) "finished\n" t) (setq ,result (catch 'result (dolist (handler (w3m-process-handlers ,result)) (when (memq ,wait-function (w3m-process-handler-functions handler)) (throw 'result (w3m-process-handler-result handler)))) (w3m-process-error-handler (cons 'error "Can't find wait handler") ,result)))) ,result))) (put 'w3m-process-with-wait-handler 'lisp-indent-function 0) (put 'w3m-process-with-wait-handler 'edebug-form-spec '(body)) ;;; Explanation of w3m-process-do in Japanese: ;; ;; w3m-process-do $B$O!"HsF14|=hM}$r4JC1$K=q$/$?$a$N%^%/%m$G$"$k!#Nc$($P!"(B ;; ;; (w3m-process-do ;; (var (async-form...)) ;; post-body...) ;; ;; $B$H$$$&$h$&$K=q$/$H!"0J2<$N=g=x$G=hM}$,9T$o$l$k!#(B ;; ;; (1) async-form $B$rI>2A(B ;; --> async-form $BFb$GHsF14|%W%m%;%9$,@8@.$5$l$?>l9g$O!"$=$NHsF1(B ;; $B4|%W%m%;%9=*N;8e$K(B post-body $B$,I>2A$5$l$k$h$&$K!"%O%s%I%i(B ;; $B$KDI2C(B ;; --> $BHsF14|%W%m%;%9$,@8@.$5$l$J$+$C$?>l9g$O!"C1$K2A$9$k(B)$B!#(B ;; (2) post-body $B$rI>2A(B ;; ;; $B$J$*!"(Basync-form / post-body $B$,I>2A$5$l$k;~!"$=$NFbIt$GHsF14|%W%m%;(B ;; $B%9$,@8@.$5$l$?>l9g$K!"$=$NJV$jCM$r=hM}$9$k$?$a$N%O%s%I%i$,!"JQ?t(B ;; handler $B$K@_Dj$5$l$F$$$k!#HsF14|$J=hM}$r9T$&4X?t$r8F$S=P$9>l9g$K$O!"(B ;; $B$=$N4X?t$N0z?t$H$7$FI,$:(B handler $B$rEO$5$J$1$l$P$J$i$J$$!#(B ;; ;; $B$^$?!"(Bw3m-process-do $B$O!"8=:_$N%O%s%I%i$NFbMF$rD4$Y$k$?$a!"$=$N%^%/(B ;; $B%m$,8F$S=P$5$l$F$$$k4D6-$NJQ?t(B handler $B$r;2>H$9$k!#Nc$($P!"(B ;; ;; (let (handler) (w3m-process-do ...)) ;; ;; $B$HJQ?t(B handler $B$r(B nil $B$KB+G{$7$F$*$/$H!"!V8=;~E@$N%O%s%I%i$O6u$G$"(B ;; $B$k(B = $BHsF14|%W%m%;%9l9g$K$OC1$K(B nil $B$r(B ;; $BJV$7!"$=$l0J30$N>l9g$O(B post-body $B$NCM$rJV$9!#(B ;; (defmacro w3m-process-do (spec &rest body) "(w3m-process-do (VAR FORM) BODY...): Eval the body BODY asynchronously. If an asynchronous process is generated in the evaluation of the form FORM, this macro returns its object immdiately, and the body BODY will be evaluated after the end of the process with the variable VAR which is set to the result of the form FORM. Otherwise, the body BODY is evaluated at the same time, and this macro returns the result of the body BODY." (let ((var (or (car spec) (gensym "--tempvar--"))) (form (cdr spec)) (post-function (gensym "--post-function--"))) `(let ((,post-function (lambda (,var) ,@body))) (let ((,var (let ((handler (cons ,post-function handler))) ,@form))) (if (w3m-process-p ,var) (if handler ,var (w3m-process-start-process ,var)) (if (w3m-process-p (setq ,var (funcall ,post-function ,var))) (if handler ,var (w3m-process-start-process ,var)) ,var)))))) (put 'w3m-process-do 'lisp-indent-function 1) (put 'w3m-process-do 'edebug-form-spec '((symbolp form) def-body)) (defmacro w3m-process-do-with-temp-buffer (spec &rest body) "(w3m-process-do-with-temp-buffer (VAR FORM) BODY...): Like `w3m-process-do', but the form FORM and the body BODY are evaluated in a temporary buffer." (let ((var (or (car spec) (gensym "--tempvar--"))) (form (cdr spec)) (post-body (gensym "--post-body--")) (post-handler (gensym "--post-handler--")) (temp-buffer (gensym "--temp-buffer--")) (current-buffer (gensym "--current-buffer--"))) `(lexical-let ((,temp-buffer (w3m-get-buffer-create (generate-new-buffer-name w3m-work-buffer-name))) (,current-buffer (current-buffer))) (w3m-labels ((,post-body (,var) (when (buffer-name ,temp-buffer) (set-buffer ,temp-buffer)) ,@body) (,post-handler (,var) (w3m-kill-buffer ,temp-buffer) (when (buffer-name ,current-buffer) (set-buffer ,current-buffer)) ,var)) (let ((,var (let ((handler (cons #',post-body (cons #',post-handler handler)))) (with-current-buffer ,temp-buffer ,@form)))) (if (w3m-process-p ,var) (if handler ,var (w3m-process-start-process ,var)) (if (w3m-process-p (setq ,var (save-current-buffer (let ((handler (cons #',post-handler handler))) (,post-body ,var))))) (if handler ,var (w3m-process-start-process ,var)) (,post-handler ,var)))))))) (put 'w3m-process-do-with-temp-buffer 'lisp-indent-function 1) (put 'w3m-process-do-with-temp-buffer 'edebug-form-spec '((symbolp form) def-body)) (defun w3m-process-start (handler command arguments) "Run COMMAND with ARGUMENTS, and eval HANDLER asynchronously." (if w3m-async-exec (w3m-process-do (exit-status (w3m-process-push handler command arguments)) (w3m-process-start-after exit-status)) (w3m-process-start-after (w3m-process-with-coding-system (w3m-process-with-environment w3m-command-environment (apply 'call-process command nil t nil arguments)))))) (defun w3m-process-start-after (exit-status) (when w3m-current-buffer (with-current-buffer w3m-current-buffer (setq w3m-process-modeline-string nil))) (cond ((numberp exit-status) (zerop (setq w3m-process-exit-status exit-status))) ((not exit-status) (setq w3m-process-exit-status nil)) (t (setq w3m-process-exit-status (string-as-multibyte (format "%s" exit-status))) nil))) (defvar w3m-process-background nil "Non-nil means that an after handler is being evaluated.") (defun w3m-process-sentinel (process event &optional ignore-queue) ;; Ensure that this function will be never called repeatedly. (set-process-sentinel process 'ignore) (let ((inhibit-quit w3m-process-inhibit-quit) (w3m-process-background t)) (unwind-protect (if (buffer-name (process-buffer process)) (with-current-buffer (process-buffer process) (w3m-static-unless (featurep 'xemacs) (accept-process-output process 1)) (setq w3m-process-queue (delq w3m-process-object w3m-process-queue)) (let ((exit-status (process-exit-status process)) (buffer (current-buffer)) (realm w3m-process-realm) (user w3m-process-user) (passwd w3m-process-passwd) (obj w3m-process-object)) (setq w3m-process-object nil) (dolist (x (w3m-process-handlers obj)) (when (and (buffer-name (w3m-process-handler-buffer x)) (buffer-name (w3m-process-handler-parent-buffer x))) (set-buffer (w3m-process-handler-buffer x)) (unless (eq buffer (current-buffer)) (insert-buffer-substring buffer)))) (dolist (x (w3m-process-handlers obj)) (when (and (buffer-name (w3m-process-handler-buffer x)) (buffer-name (w3m-process-handler-parent-buffer x))) (set-buffer (w3m-process-handler-buffer x)) (let ((w3m-process-exit-status) (w3m-current-buffer (w3m-process-handler-parent-buffer x)) (handler (w3m-process-handler-functions x)) (exit-status exit-status)) (when realm (w3m-process-set-authinfo w3m-current-url realm user passwd)) (while (and handler (not (w3m-process-p (setq exit-status (funcall (pop handler) exit-status)))))) (setf (w3m-process-handler-result x) exit-status)))))) ;; Something wrong has been occured. (catch 'last (dolist (obj w3m-process-queue) (when (eq process (w3m-process-process obj)) (setq w3m-process-queue (delq obj w3m-process-queue)) (throw 'last nil))))) (delete-process process) (unless ignore-queue (w3m-process-start-queued-processes))))) (defun w3m-process-filter (process string) (when (buffer-name (process-buffer process)) (with-current-buffer (process-buffer process) (let ((inhibit-read-only t) (case-fold-search nil)) (goto-char (process-mark process)) (insert string) (set-marker (process-mark process) (point)) (unless (string= "" string) (goto-char (point-min)) (cond ((and (looking-at "\\(?:Accept [^\n]+\n\\)*\\([^\n]+: accept\\? \\)(y/n)") (= (match-end 0) (point-max))) ;; SSL certificate (message "") (let ((yn (w3m-process-y-or-n-p w3m-current-url (match-string 1)))) (ignore-errors (process-send-string process (if yn "y\n" "n\n")) (delete-region (point-min) (point-max))))) ((and (looking-at "\n?Accept unsecure SSL session:.*\n") (= (match-end 0) (point-max))) (delete-region (point-min) (point-max))) ((and (looking-at "\\(\n?Wrong username or password\n\\)?\ Proxy Username for \\(?:.*\\): Proxy Password: ") (= (match-end 0) (point-max))) (when (or (match-beginning 1) (not (stringp w3m-process-proxy-passwd))) (setq w3m-process-proxy-passwd (read-passwd "Proxy Password: "))) (ignore-errors (process-send-string process (concat w3m-process-proxy-passwd "\n")) (delete-region (point-min) (point-max)))) ((and (looking-at "\\(\n?Wrong username or password\n\\)?\ Proxy Username for \\(.*\\): ") (= (match-end 0) (point-max))) (when (or (match-beginning 1) (not (stringp w3m-process-proxy-user))) (setq w3m-process-proxy-user (read-from-minibuffer (concat "Proxy Username for " (match-string 2) ": ")))) (ignore-errors (process-send-string process (concat w3m-process-proxy-user "\n")))) ((and (looking-at "\\(\n?Wrong username or password\n\\)?\ Username for [^\n]*\n?: Password: ") (= (match-end 0) (point-max))) (when (or (match-beginning 1) (not (stringp w3m-process-passwd))) (setq w3m-process-passwd (w3m-process-read-passwd w3m-current-url w3m-process-realm w3m-process-user (match-beginning 1)))) (ignore-errors (process-send-string process (concat w3m-process-passwd "\n")) (delete-region (point-min) (point-max)))) ((and (looking-at "\\(\n?Wrong username or password\n\\)?\ Username for \\(.*\\)\n?: ") (= (match-end 0) (point-max))) (setq w3m-process-realm (w3m-decode-coding-string-with-priority (match-string 2) nil)) (when (or (match-beginning 1) (not (stringp w3m-process-user))) (setq w3m-process-user (w3m-process-read-user w3m-current-url w3m-process-realm (match-beginning 1)))) (ignore-errors (process-send-string process (concat w3m-process-user "\n")))) ((and (looking-at "Enter PEM pass phrase:") (= (match-end 0) (point-max))) (unless (stringp w3m-process-ssl-passphrase) (setq w3m-process-ssl-passphrase (read-passwd "PEM pass phrase: "))) (ignore-errors (process-send-string process (concat w3m-process-ssl-passphrase "\n")) (delete-region (point-min) (point-max)))) ((progn (or (search-forward "\nW3m-current-url:" nil t) (goto-char (process-mark process))) (re-search-backward "^W3m-\\(?:in-\\)?progress: \\([.0-9]+/[.0-9]+[a-zA-Z]?b\\)$" nil t)) (let ((str (w3m-process-modeline-format (match-string 1))) (buf)) (save-current-buffer (dolist (handler (w3m-process-handlers w3m-process-object)) (when (setq buf (w3m-process-handler-parent-buffer handler)) (if (buffer-name buf) (progn (set-buffer buf) (setq w3m-process-modeline-string str)) (w3m-process-kill-stray-processes))))))))))))) (defun w3m-process-modeline-format (str) (ignore-errors (cond ((stringp w3m-process-modeline-format) (format w3m-process-modeline-format (if (string-match "/0\\([a-zA-Z]?b\\)\\'" str) (replace-match "\\1" t nil str) str))) ((functionp w3m-process-modeline-format) (funcall w3m-process-modeline-format str))))) ;; w3m-process-authinfo-alist has an association list as below format. ;; (("root1" ("realm11" ("user11" . "pass11") ;; ("user12" . "pass12")) ;; ("realm12" ("user13" . "pass13"))) ;; ("root2" ("realm21" ("user21" . "pass21")))) (defun w3m-process-set-authinfo (url realm username password) (let (x y z (root (w3m-get-server-hostname url))) (if (setq x (assoc root w3m-process-authinfo-alist)) (if (setq y (assoc realm x)) (if (setq z (assoc username y)) ;; Change a password only. (setcdr z password) ;; Add a pair of a username and a password. (setcdr y (cons (cons username password) (cdr y)))) ;; Add a 3-tuple of a realm, a username and a password. (setcdr x (cons (cons realm (list (cons username password))) (cdr x)))) ;; Add a 4-tuple of a server root, a realm, a username and a password. (push (cons root (list (cons realm (list (cons username password))))) w3m-process-authinfo-alist)))) (defun w3m-process-read-user (url &optional realm ignore-history) "Read a user name for URL and REALM." (let* ((root (when (stringp url) (w3m-get-server-hostname url))) (ident (or realm root)) (alist)) (if (and (not ignore-history) (setq alist (cdr (assoc realm (cdr (assoc root w3m-process-authinfo-alist)))))) (if (= 1 (length alist)) (caar alist) (completing-read (if ident (format "Select username for %s: " ident) "Select username: ") (mapcar (lambda (x) (cons (car x) (car x))) alist) nil t)) (read-from-minibuffer (if ident (format "Username for %s: " ident) "Username: "))))) (defun w3m-process-read-passwd (url &optional realm username ignore-history) "Read a password for URL, REALM, and USERNAME." (let* ((root (when (stringp url) (w3m-get-server-hostname url))) (ident (or realm root)) (pass (cdr (assoc username (cdr (assoc realm (cdr (assoc root w3m-process-authinfo-alist)))))))) (if (and pass (not ignore-history)) pass (read-passwd (format (if ident (format "Password for %s%%s: " ident) "Password%s: ") (if (and (stringp pass) (> (length pass) 0) (not (featurep 'xemacs))) (concat " (default " (make-string (length pass) ?\*) ")") "")) nil pass)))) (defun w3m-process-y-or-n-p (url prompt) "Ask user a \"y or n\" question. Return t if answer is \"y\". NOTE: This function is designed to avoid annoying questions. So when the same questions is reasked, its previous answer is reused without prompt." (let ((root (w3m-get-server-hostname url)) (map (copy-keymap query-replace-map)) elem answer) ;; ignore [space] to avoid answering y without intention. (define-key map " " 'ignore) (let ((query-replace-map map)) (if (setq elem (assoc root w3m-process-accept-alist)) (if (member prompt (cdr elem)) ;; When the same question has been asked, the previous ;; answer is reused. (setq answer t) ;; When any question for the same server has been asked, ;; regist the pair of this question and its answer to ;; `w3m-process-accept-alist'. (when (setq answer (y-or-n-p prompt)) (setcdr elem (cons prompt (cdr elem))))) ;; When no question for the same server has been asked, regist ;; the 3-tuple of the server, the question and its answer to ;; `w3m-process-accept-alist'. (when (setq answer (y-or-n-p prompt)) (push (cons root (list prompt)) w3m-process-accept-alist))) answer))) ;; Silence the byte compiler complaining against `gensym' like: ;; "Warning: the function `gensym' might not be defined at runtime." (eval-when-compile (and (boundp 'byte-compile-unresolved-functions) (fboundp 'gensym) (symbol-file 'gensym) (string-match "/cl-macs\\.el[^/]*\\'" (symbol-file 'gensym)) (condition-case nil (setq byte-compile-unresolved-functions (delq (assq 'gensym byte-compile-unresolved-functions) byte-compile-unresolved-functions)) (error)))) (provide 'w3m-proc) ;;; w3m-proc.el ends here w3m-el-snapshot-1.4.527+0.20140108.orig/install-sh0000755000000000000000000001271107565100723017334 0ustar rootroot#!/bin/sh # # install - install a program, script, or datafile # This comes from X11R5 (mit/util/scripts/install.sh). # # Copyright 1991 by the Massachusetts Institute of Technology # # Permission to use, copy, modify, distribute, and sell this software and its # documentation for any purpose is hereby granted without fee, provided that # the above copyright notice appear in all copies and that both that # copyright notice and this permission notice appear in supporting # documentation, and that the name of M.I.T. not be used in advertising or # publicity pertaining to distribution of the software without specific, # written prior permission. M.I.T. makes no representations about the # suitability of this software for any purpose. It is provided "as is" # without express or implied warranty. # # Calling this script install-sh is preferred over install.sh, to prevent # `make' implicit rules from creating a file called install from it # when there is no Makefile. # # This script is compatible with the BSD install script, but was written # from scratch. It can only install one file at a time, a restriction # shared with many OS's install programs. # set DOITPROG to echo to test this script # Don't use :- since 4.3BSD and earlier shells don't like it. doit="${DOITPROG-}" # put in absolute paths if you don't have them in your path; or use env. vars. mvprog="${MVPROG-mv}" cpprog="${CPPROG-cp}" chmodprog="${CHMODPROG-chmod}" chownprog="${CHOWNPROG-chown}" chgrpprog="${CHGRPPROG-chgrp}" stripprog="${STRIPPROG-strip}" rmprog="${RMPROG-rm}" mkdirprog="${MKDIRPROG-mkdir}" transformbasename="" transform_arg="" instcmd="$mvprog" chmodcmd="$chmodprog 0755" chowncmd="" chgrpcmd="" stripcmd="" rmcmd="$rmprog -f" mvcmd="$mvprog" src="" dst="" dir_arg="" while [ x"$1" != x ]; do case $1 in -c) instcmd="$cpprog" shift continue;; -d) dir_arg=true shift continue;; -m) chmodcmd="$chmodprog $2" shift shift continue;; -o) chowncmd="$chownprog $2" shift shift continue;; -g) chgrpcmd="$chgrpprog $2" shift shift continue;; -s) stripcmd="$stripprog" shift continue;; -t=*) transformarg=`echo $1 | sed 's/-t=//'` shift continue;; -b=*) transformbasename=`echo $1 | sed 's/-b=//'` shift continue;; *) if [ x"$src" = x ] then src=$1 else # this colon is to work around a 386BSD /bin/sh bug : dst=$1 fi shift continue;; esac done if [ x"$src" = x ] then echo "install: no input file specified" exit 1 else true fi if [ x"$dir_arg" != x ]; then dst=$src src="" if [ -d $dst ]; then instcmd=: else instcmd=mkdir fi else # Waiting for this to be detected by the "$instcmd $src $dsttmp" command # might cause directories to be created, which would be especially bad # if $src (and thus $dsttmp) contains '*'. if [ -f $src -o -d $src ] then true else echo "install: $src does not exist" exit 1 fi if [ x"$dst" = x ] then echo "install: no destination specified" exit 1 else true fi # If destination is a directory, append the input filename; if your system # does not like double slashes in filenames, you may need to add some logic if [ -d $dst ] then dst="$dst"/`basename $src` else true fi fi ## this sed command emulates the dirname command dstdir=`echo $dst | sed -e 's,[^/]*$,,;s,/$,,;s,^$,.,'` # Make sure that the destination directory exists. # this part is taken from Noah Friedman's mkinstalldirs script # Skip lots of stat calls in the usual case. if [ ! -d "$dstdir" ]; then defaultIFS=' ' IFS="${IFS-${defaultIFS}}" oIFS="${IFS}" # Some sh's can't handle IFS=/ for some reason. IFS='%' set - `echo ${dstdir} | sed -e 's@/@%@g' -e 's@^%@/@'` IFS="${oIFS}" pathcomp='' while [ $# -ne 0 ] ; do pathcomp="${pathcomp}${1}" shift if [ ! -d "${pathcomp}" ] ; then $mkdirprog "${pathcomp}" else true fi pathcomp="${pathcomp}/" done fi if [ x"$dir_arg" != x ] then $doit $instcmd $dst && if [ x"$chowncmd" != x ]; then $doit $chowncmd $dst; else true ; fi && if [ x"$chgrpcmd" != x ]; then $doit $chgrpcmd $dst; else true ; fi && if [ x"$stripcmd" != x ]; then $doit $stripcmd $dst; else true ; fi && if [ x"$chmodcmd" != x ]; then $doit $chmodcmd $dst; else true ; fi else # If we're going to rename the final executable, determine the name now. if [ x"$transformarg" = x ] then dstfile=`basename $dst` else dstfile=`basename $dst $transformbasename | sed $transformarg`$transformbasename fi # don't allow the sed command to completely eliminate the filename if [ x"$dstfile" = x ] then dstfile=`basename $dst` else true fi # Make a temp file name in the proper directory. dsttmp=$dstdir/#inst.$$# # Move or copy the file name to the temp name $doit $instcmd $src $dsttmp && trap "rm -f ${dsttmp}" 0 && # and set any options; do chmod last to preserve setuid bits # If any of these fail, we abort the whole thing. If we want to # ignore errors from any of these, just make sure not to ignore # errors from the above "$doit $instcmd $src $dsttmp" command. if [ x"$chowncmd" != x ]; then $doit $chowncmd $dsttmp; else true;fi && if [ x"$chgrpcmd" != x ]; then $doit $chgrpcmd $dsttmp; else true;fi && if [ x"$stripcmd" != x ]; then $doit $stripcmd $dsttmp; else true;fi && if [ x"$chmodcmd" != x ]; then $doit $chmodcmd $dsttmp; else true;fi && # Now rename the file to the real destination. $doit $rmcmd -f $dstdir/$dstfile && $doit $mvcmd $dsttmp $dstdir/$dstfile fi && exit 0 w3m-el-snapshot-1.4.527+0.20140108.orig/w3m-cookie.el0000644000000000000000000004420011403204104017605 0ustar rootroot;;; w3m-cookie.el --- Functions for cookie processing ;; Copyright (C) 2002, 2003, 2005, 2006, 2008, 2009, 2010 ;; TSUCHIYA Masatoshi ;; Authors: Teranishi Yuuichi ;; Keywords: w3m, WWW, hypermedia ;; This file is a part of emacs-w3m. ;; This program 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, or (at your option) ;; any later version. ;; This program 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 this program; see the file COPYING. If not, write to ;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ;; Boston, MA 02110-1301, USA. ;;; Commentary: ;; This file contains the functions for cookies. For more detail ;; about emacs-w3m, see: ;; ;; http://emacs-w3m.namazu.org/ ;; Reference for version 0 cookie: ;; http://www.netscape.com/newsref/std/cookie_spec.html ;; Reference for version 1 cookie: ;; http://www.ietf.org/rfc/rfc2965.txt ;; ;;; Code: (eval-when-compile (require 'cl)) (require 'w3m-util) (require 'w3m) (defvar w3m-cookies nil "A list of cookie elements. Currently only browser local cookies are stored.") (defconst w3m-cookie-two-dot-domains-regexp (concat "\\.\\(?:" (mapconcat 'identity (list "com" "edu" "net" "org" "gov" "mil" "int") "\\|") "\\)$") "A regular expression of top-level domains that only require two matching '.'s in the domain name in order to set a cookie.") (defcustom w3m-cookie-accept-domains nil "A list of trusted domain name string." :group 'w3m :type '(repeat (string :format "Domain name: %v\n" :size 0))) (defcustom w3m-cookie-reject-domains nil "A list of untrusted domain name string." :group 'w3m :type '(repeat (string :format "Domain name: %v\n" :size 0))) (defcustom w3m-cookie-accept-bad-cookies nil "If nil, don't accept bad cookies. If t, accept bad cookies. If ask, ask user whether accept bad cookies or not." :group 'w3m :type '(radio (const :tag "Don't accept bad cookies" nil) (const :tag "Ask accepting bad cookies" ask) (const :tag "Always accept bad cookies" t))) (defcustom w3m-cookie-save-cookies t "*Non-nil means save cookies when emacs-w3m cookie system shutdown." :group 'w3m :type 'boolean) (defcustom w3m-cookie-file (expand-file-name ".cookie" w3m-profile-directory) "File in which cookies are kept." :group 'w3m :type '(file :size 0)) ;;; Cookie accessor. (defmacro w3m-cookie-url (cookie) `(aref ,cookie 0)) (defmacro w3m-cookie-domain (cookie) `(aref ,cookie 1)) (defmacro w3m-cookie-secure (cookie) `(aref ,cookie 2)) (defmacro w3m-cookie-name (cookie) `(aref ,cookie 3)) (defmacro w3m-cookie-value (cookie) `(aref ,cookie 4)) (defmacro w3m-cookie-path (cookie) `(aref ,cookie 5)) (defmacro w3m-cookie-version (cookie) `(aref ,cookie 6)) (defmacro w3m-cookie-expires (cookie) `(aref ,cookie 7)) (defmacro w3m-cookie-ignore (cookie) `(aref ,cookie 8)) (defun w3m-cookie-create (&rest args) (let ((cookie (make-vector 9 nil))) (setf (w3m-cookie-url cookie) (plist-get args :url)) (setf (w3m-cookie-domain cookie) (plist-get args :domain)) (setf (w3m-cookie-secure cookie) (plist-get args :secure)) (setf (w3m-cookie-name cookie) (plist-get args :name)) (setf (w3m-cookie-value cookie) (plist-get args :value)) (setf (w3m-cookie-path cookie) (plist-get args :path)) (setf (w3m-cookie-version cookie) (or (plist-get args :version) 0)) (setf (w3m-cookie-expires cookie) (plist-get args :expires)) (setf (w3m-cookie-ignore cookie) (plist-get args :ignore)) cookie)) (defun w3m-cookie-store (cookie) "Store COOKIE." (let (ignored) (catch 'found (dolist (c w3m-cookies) (when (and (string= (w3m-cookie-domain c) (w3m-cookie-domain cookie)) (string= (w3m-cookie-path c) (w3m-cookie-path cookie)) (string= (w3m-cookie-name c) (w3m-cookie-name cookie))) (if (w3m-cookie-ignore c) (setq ignored t) (setq w3m-cookies (delq c w3m-cookies))) (throw 'found t)))) (unless ignored (push cookie w3m-cookies)))) (defun w3m-cookie-remove (domain path name) "Remove COOKIE if stored." (dolist (c w3m-cookies) (when (and (string= (w3m-cookie-domain c) domain) (string= (w3m-cookie-path c) path) (string= (w3m-cookie-name c) name)) (setq w3m-cookies (delq c w3m-cookies))))) (defun w3m-cookie-retrieve (host path &optional secure) "Retrieve cookies for DOMAIN and PATH." (let ((case-fold-search t) expires cookies) (dolist (c w3m-cookies) (if (and (w3m-cookie-expires c) (w3m-time-newer-p (current-time) (w3m-time-parse-string (w3m-cookie-expires c)))) (push c expires) (when (and (not (w3m-cookie-ignore c)) (or ;; A special case that domain name is ".hostname". (string= (concat "." host) (w3m-cookie-domain c)) (string-match (concat (regexp-quote (w3m-cookie-domain c)) "$") host)) (string-match (concat "^" (regexp-quote (w3m-cookie-path c))) path)) (if (w3m-cookie-secure c) (if secure (push c cookies)) (push c cookies))))) ;; Delete expired cookies. (dolist (expire expires) (setq w3m-cookies (delq expire w3m-cookies))) cookies)) ;; HTTP URL parser. (defun w3m-parse-http-url (url) "Parse an absolute HTTP URL." (let (secure split) (w3m-string-match-url-components url) (when (and (match-beginning 4) (or (equal (match-string 2 url) "http") (setq secure (equal (match-string 2 url) "https")))) (setq split (save-match-data (split-string (match-string 4 url) ":"))) (vector secure (nth 0 split) (string-to-number (or (nth 1 split) "80")) (if (eq (length (match-string 5 url)) 0) "/" (match-string 5 url)))))) (defsubst w3m-http-url-secure (http-url) "Secure flag of the HTTP-URL." (aref http-url 0)) (defsubst w3m-http-url-host (http-url) "Host name of the HTTP-URL." (aref http-url 1)) (defsubst w3m-http-url-port (http-url) "Port number of the HTTP-URL." (aref http-url 2)) (defsubst w3m-http-url-path (http-url) "Path of the HTTP-URL." (aref http-url 3)) ;;; Cookie parser. (defvar w3m-cookie-parse-args-syntax-table (copy-syntax-table emacs-lisp-mode-syntax-table) "A syntax table for parsing sgml attributes.") (modify-syntax-entry ?' "\"" w3m-cookie-parse-args-syntax-table) (modify-syntax-entry ?` "\"" w3m-cookie-parse-args-syntax-table) (modify-syntax-entry ?{ "(" w3m-cookie-parse-args-syntax-table) (modify-syntax-entry ?} ")" w3m-cookie-parse-args-syntax-table) (defun w3m-cookie-parse-args (str &optional nodowncase) (let (name value results name-pos val-pos) (with-current-buffer (get-buffer-create " *w3m-cookie-parse-temp*") (erase-buffer) (set-syntax-table w3m-cookie-parse-args-syntax-table) (insert str) (goto-char (point-min)) (while (not (eobp)) (skip-chars-forward "; \n\t") (setq name-pos (point)) (skip-chars-forward "^ \n\t=;") (unless nodowncase (downcase-region name-pos (point))) (setq name (buffer-substring name-pos (point))) (skip-chars-forward " \t\n") (if (/= (or (char-after (point)) 0) ?=) ; There is no value (setq value nil) (skip-chars-forward " \t\n=") (setq val-pos (point) value (cond ((or (= (or (char-after val-pos) 0) ?\") (= (or (char-after val-pos) 0) ?')) (buffer-substring (1+ val-pos) (condition-case () (prog2 (forward-sexp 1) (1- (point)) (skip-chars-forward "\"")) (error (skip-chars-forward "^ \t\n") (point))))) (t (buffer-substring val-pos (progn (skip-chars-forward "^;") (skip-chars-backward " \t") (point))))))) (push (cons name value) results) (skip-chars-forward "; \n\t")) results))) (defun w3m-cookie-trusted-host-p (host) "Returns non-nil when the HOST is specified as trusted by user." (let ((accept w3m-cookie-accept-domains) (reject w3m-cookie-reject-domains) (trusted t) regexp tlen rlen) (while accept (cond ((string= (car accept) ".") (setq regexp ".*")) ((string= (car accept) ".local") (setq regexp "^[^\\.]+$")) ((eq (string-to-char (car accept)) ?.) (setq regexp (concat (regexp-quote (car accept)) "$"))) (t (setq regexp (concat "^" (regexp-quote (car accept)) "$")))) (when (string-match regexp host) (setq tlen (length (car accept)) accept nil)) (pop accept)) (while reject (cond ((string= (car reject) ".") (setq regexp ".*")) ((string= (car reject) ".local") (setq regexp "^[^\\.]+$")) ((eq (string-to-char (car reject)) ?.) (setq regexp (concat (regexp-quote (car reject)) "$"))) (t (setq regexp (concat "^" (regexp-quote (car reject)) "$")))) (when (string-match regexp host) (setq rlen (length (car reject)) reject nil)) (pop reject)) (if tlen (if rlen (if (<= tlen rlen) (setq trusted nil))) (if rlen (setq trusted nil))) trusted)) ;;; Version 0 cookie. (defun w3m-cookie-1-acceptable-p (host domain) (let ((numdots 0) (last nil) (case-fold-search t) (mindots 3)) (while (setq last (string-match "\\." domain last)) (setq numdots (1+ numdots) last (1+ last))) (if (string-match w3m-cookie-two-dot-domains-regexp domain) (setq mindots 2)) (cond ((string= host domain) ; Apparently netscape lets you do this t) ;; A special case that domain name is ".hostname". ((string= (concat "." host) domain) t) ((>= numdots mindots) ; We have enough dots in domain name ;; Need to check and make sure the host is actually _in_ the ;; domain it wants to set a cookie for though. (string-match (concat (regexp-quote domain) "$") host)) (t nil)))) (defun w3m-cookie-1-set (url &rest args) ;; Set-Cookie:, version 0 cookie. (let ((http-url (w3m-parse-http-url url)) (case-fold-search t) secure domain expires path rest) (when http-url (setq secure (and (w3m-assoc-ignore-case "secure" args) t) domain (or (cdr-safe (w3m-assoc-ignore-case "domain" args)) (w3m-http-url-host http-url)) expires (cdr-safe (w3m-assoc-ignore-case "expires" args)) path (or (cdr-safe (w3m-assoc-ignore-case "path" args)) (file-name-directory (w3m-http-url-path http-url)))) (while args (if (not (member (downcase (car (car args))) '("secure" "domain" "expires" "path"))) (setq rest (cons (car args) rest))) (setq args (cdr args))) (cond ((not (w3m-cookie-trusted-host-p (w3m-http-url-host http-url))) ;; The site was explicity marked as untrusted by the user nil) ((or (w3m-cookie-1-acceptable-p (w3m-http-url-host http-url) domain) (eq w3m-cookie-accept-bad-cookies t) (and (eq w3m-cookie-accept-bad-cookies 'ask) (y-or-n-p (format "Accept bad cookie from %s for %s? " (w3m-http-url-host http-url) domain)))) ;; Cookie is accepted by the user, and passes our security checks (dolist (elem rest) ;; If a CGI script wishes to delete a cookie, it can do so by ;; returning a cookie with the same name, and an expires time ;; which is in the past. (when (and expires (w3m-time-newer-p (current-time) (w3m-time-parse-string expires))) (w3m-cookie-remove domain path (car elem))) (w3m-cookie-store (w3m-cookie-create :url url :domain domain :name (car elem) :value (cdr elem) :path path :expires expires :secure secure)))) (t (message "%s tried to set a cookie for domain %s - rejected." (w3m-http-url-host http-url) domain)))))) ;;; Version 1 cookie. (defun w3m-cookie-2-acceptable-p (http-url domain) ;; A user agent rejects (SHALL NOT store its information) if the Version ;; attribute is missing. Moreover, a user agent rejects (SHALL NOT ;; store its information) if any of the following is true of the ;; attributes explicitly present in the Set-Cookie2 response header: ;; * The value for the Path attribute is not a prefix of the ;; request-URI. ;; * The value for the Domain attribute contains no embedded dots, ;; and the value is not .local. ;; * The effective host name that derives from the request-host does ;; not domain-match the Domain attribute. ;; * The request-host is a HDN (not IP address) and has the form HD, ;; where D is the value of the Domain attribute, and H is a string ;; that contains one or more dots. ;; * The Port attribute has a "port-list", and the request-port was ;; not in the list. ) (defun w3m-cookie-2-set (url &rest args) ;; Set-Cookie2:, version 1 cookie. ;; Not implemented yet. ) ;;; Save & Load (defvar w3m-cookie-init nil) (defun w3m-cookie-clear () "Clear cookie list." (setq w3m-cookies nil)) (defun w3m-cookie-save (&optional domain) "Save cookies. When DOMAIN is non-nil, only save cookies whose domains match it." (interactive) (let (cookies) (dolist (cookie w3m-cookies) (when (and (or (not domain) (string= (w3m-cookie-domain cookie) domain)) (w3m-cookie-expires cookie) (w3m-time-newer-p (w3m-time-parse-string (w3m-cookie-expires cookie)) (current-time))) (push cookie cookies))) (w3m-save-list w3m-cookie-file cookies))) (defun w3m-cookie-save-current-site-cookies () "Save cookies for the current site." (interactive) (when (and w3m-current-url (not (w3m-url-local-p w3m-current-url))) (w3m-string-match-url-components w3m-current-url) (w3m-cookie-save (match-string 4 w3m-current-url)))) (defun w3m-cookie-load () "Load cookies." (when (null w3m-cookies) (setq w3m-cookies (w3m-load-list w3m-cookie-file)))) (defun w3m-cookie-setup () "Setup cookies. Returns immediataly if already initialized." (interactive) (unless w3m-cookie-init (w3m-cookie-load) (setq w3m-cookie-init t))) ;;;###autoload (defun w3m-cookie-shutdown () "Save cookies, and reset cookies' data." (interactive) (when w3m-cookie-save-cookies (w3m-cookie-save)) (setq w3m-cookie-init nil) (w3m-cookie-clear) (if (get-buffer " *w3m-cookie-parse-temp*") (kill-buffer (get-buffer " *w3m-cookie-parse-temp*")))) ;;;###autoload (defun w3m-cookie-set (url beg end) "Register cookies which correspond to URL. BEG and END should be an HTTP response header region on current buffer." (w3m-cookie-setup) (when (and url beg end) (save-excursion (let ((case-fold-search t) (version 0) data) (goto-char beg) (while (re-search-forward "^\\(?:Set-Cookie\\(2\\)?:\\) *\\(.*\\(?:\n[ \t].*\\)*\\)\n" end t) (setq data (match-string 2)) (if (match-beginning 1) (setq version 1)) (apply (case version (0 'w3m-cookie-1-set) (1 'w3m-cookie-2-set)) url (w3m-cookie-parse-args data 'nodowncase))))))) ;;;###autoload (defun w3m-cookie-get (url) "Get a cookie field string which corresponds to the URL." (w3m-cookie-setup) (let* ((http-url (w3m-parse-http-url url)) (cookies (and http-url (w3m-cookie-retrieve (w3m-http-url-host http-url) (w3m-http-url-path http-url) (w3m-http-url-secure http-url))))) ;; When sending cookies to a server, all cookies with a more specific path ;; mapping should be sent before cookies with less specific path mappings. (setq cookies (sort cookies (lambda (x y) (< (length (w3m-cookie-path x)) (length (w3m-cookie-path y)))))) (when cookies (mapconcat (lambda (cookie) (concat (w3m-cookie-name cookie) "=" (w3m-cookie-value cookie))) cookies "; ")))) ;;;###autoload (defun w3m-cookie (&optional no-cache) "Display cookies and enable you to manage them." (interactive "P") (w3m-goto-url "about://cookie/" no-cache)) ;;;###autoload (defun w3m-about-cookie (url &optional no-decode no-cache post-data &rest args) "Make the html contents to display and to enable you to manage cookies." (unless w3m-use-cookies (error "You must enable emacs-w3m to use cookies.")) (w3m-cookie-setup) (let ((pos 0)) (when post-data (dolist (pair (split-string post-data "&")) (setq pair (split-string pair "=")) (setf (w3m-cookie-ignore (nth (string-to-number (car pair)) w3m-cookies)) (eq (string-to-number (cadr pair)) 0)))) (insert (concat "\ Cookies
Cookies

    ")) (dolist (cookie w3m-cookies) (insert (concat "

  1. " (w3m-cookie-url cookie) "

    " "" "" (when (w3m-cookie-expires cookie) (concat "")) "" (when (w3m-cookie-domain cookie) (concat "")) (when (w3m-cookie-path cookie) (concat "")) "
    Cookie:" (w3m-cookie-name cookie) "=" (w3m-cookie-value cookie) "
    Expires:" (w3m-cookie-expires cookie) "
    Version:" (number-to-string (w3m-cookie-version cookie)) "
    Domain:" (w3m-cookie-domain cookie) "
    Path:" (w3m-cookie-path cookie) "
    Secure:" (if (w3m-cookie-secure cookie) "Yes" "No") "
    " "
    Use:" (format "Yes" pos (if (w3m-cookie-ignore cookie) "" " checked")) "  " (format "No" pos (if (w3m-cookie-ignore cookie) " checked" "")) "

    ")) (setq pos (1+ pos))) (insert "

") "text/html")) (provide 'w3m-cookie) ;;; w3m-cookie.el ends here w3m-el-snapshot-1.4.527+0.20140108.orig/BUGS.ja0000644000000000000000000000701610536203003016371 0ustar rootroot$Date: 2006/12/08 06:28:19 $ ■ TODOs stopping release --> URL の encode 問題の解決 [emacs-w3m:05387], [emacs-w3m:05576] --> 各種 form 用の face の変更 [emacs-w3m:05490] --> xml.el のインストーラの完成 [emacs-w3m:05353] ■ TODOs --> 開発ポリシーの合意事項一覧を作成する．できれば英訳も． --> rendering 速度の改善 --> w3mnav.el 相当の処理ができるように w3m-relationship-estimate-rules を見直す．[emacs-w3m:06211] --> WiKi 用の拡張を入れる [emacs-w3m:06841] --> w3m-correct-charset-alist と w3m-charset-coding-system-alist の整 理．[emacs-w3m:06109] --> 意図しない字形の変換を避けるため，できるだけ元のページの文字コー ドのままで処理を行うようにする． [emacs-w3m:06674], [emacs-w3m:06701] --> ucs_conv=0 オプションが利用できない環境がある http://emacs-w3m.namazu.org/ml/msg06787.html --> w3m-safe-* コマンドの整理．「安全」を定義する必要あり． [emacs-w3m:06240] --> shimbun の配布パッケージの分割 [emacs-w3m:05607] --> w3m-copy-buffer() で，history に格納されている buffer-local properties (form data などを含む) を捨てずにコピーする．--ky --> about: で始まる url のページを既存の history とは別扱いにする． [emacs-w3m:05670] -- ky --> https なページの閲覧に関わる諸問題の解明と対策． [emacs-w3m:04901, 04857] --> file-name- 系の関数を url 文字列の処理に使うのは問題あり． [emacs-w3m:04799] --> 変数/関数の docstring と comment の英語の整備．-- ky --> frame 対応 --> ソースコード中の FIXME を直す --> エラーチェックが手抜きなのを直す ■ Known BUGs (1) XEmacs で ">" "," すると，カーソルが隠れる時がある． XEmacs で w3m-horizontal-shift-columns の値を char-width より小さく すると，"," が動かないときがある．XEmacs は表示幅が異なる文字が混在 している場合の制御が未完成なので，仕方が無いのだが． (2) という書式で指定されたアンカーにジャンプできない． [emacs-w3m:05816] (3) w3m-antenna-sites の customize がうまく動かない．[emacs-w3m:06213] (4) プロセスが同時に大量に呼び出されてエラーになることがある． [emacs-w3m:06896], [emacs-w3m:06901] ■ Known LIMITATIONs (1) w3m の制限により Del/Strikeの打ち消し線がテーブルを跨がる． ■ Wishlist and Idea Notes --> keybind の整理 [emacs-w3m:06253] --> メニューの整理 [emacs-w3m:06254] --> Fontify pages display text/plain sources. source code の text/plain なページを閲覧しているときは font-lock してくれると嬉しいかもしれない． --> Info / man 閲覧機能の追加 --> Bookmark と BBDB or LSDB の連携などが出来たら嬉しいかも知れない． --> キャッシュ機構の整理と永続コンテンツ [emacs-w3m:01076] --> ソースの整理 --> 説明文書の整備 --> [emacs-w3m:00011] などのメーリングリストのヘッダ文字列を自動的に URL に変換してジャンプする機能がほしい． --> [emacs-w3m:05901] 406 Not Accetable & Alternates なページを閲覧す る方法が欲しい． --> [emacs-w3m:06103] widget-based antenna editor --> configure 時に --with-icondir=... で指定した値を自動的に w3m-icon-directory の初期値として反映してほしい．[emacs-w3m:03912] --> shimbun --> ML archive の検索エンジンとの連動 --> 掲示板などの場合は post も出来るようにならないか? ■ How to access our mailing list archive [emacs-w3m:#####] のようにメーリングリストの記事が指定されている場合 は，以下のような記事番号を含む URI のページにアクセスすると，その記事 を見つけることが出来ます． http://emacs-w3m.namazu.org/ml/##### Local Variables: mode: indented-text coding: euc-japan-unix fill-column: 72 End: w3m-el-snapshot-1.4.527+0.20140108.orig/mew-w3m.el0000644000000000000000000004334212247630163017151 0ustar rootroot;; mew-w3m.el --- View Text/Html content with w3m in Mew ;; Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2008, 2009, 2010 ;; TSUCHIYA Masatoshi ;; Author: Shun-ichi GOTO , ;; Hideyuki SHIRAI ;; Created: Wed Feb 28 03:31:00 2001 ;; Version: $Revision: 1.71 $ ;; Keywords: Mew, mail, w3m, WWW, hypermedia ;; This file is a part of emacs-w3m. ;; This program 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, or (at ;; your option) any later version. ;; This program 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 this program; see the file COPYING. If not, write to ;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ;; Boston, MA 02110-1301, USA. ;;; Commentary: ;; This package is for viewing formatted (rendered) Text/Html content ;; in Mew's message buffer. ;;; Installation: ;; (1) Simply load this file and add followings in your ~/.mew file. ;; ;; (require 'mew-w3m) ;; ;; (2) And you can use keymap of w3m-mode as mew-w3m-minor-mode. ;; To activate this feaeture, add followings also: ;; ;; (setq mew-use-w3m-minor-mode t) ;; (add-hook 'mew-message-hook 'mew-w3m-minor-mode-setter) ;; ;; (3) If you use mew-1.95b118 or later on which Emacs 21, 22 or XEmacs, ;; can display the images in the Text/Html message. ;; To activate this feaeture, add following in your ~/.mew file. ;; ;; (define-key mew-summary-mode-map "T" 'mew-w3m-view-inline-image) ;; ;; Press "T": Toggle the visibility of the images included its message only. ;; Press "C-uT": Display the all images included its Text/Html part." ;; ;; (4) You can use emacs-w3m to fetch and/or browse ;; `external-body with URL access'. To activate this feaeture, ;; add followings also: ;; ;; (setq mew-ext-url-alist ;; '(("^application/" "Fetch by emacs-w3m" mew-w3m-ext-url-fetch nil) ;; (t "Browse by emacs-w3m" mew-w3m-ext-url-show nil))) ;; or ;; (setq mew-ext-url-alist ;; '((t "Browse by emacs-w3m" mew-w3m-ext-url-show nil))) ;; ;;; Usage: ;; There's nothing special. Browse messages in usual way. ;; On viewing Text/Html file, rendered text is appeared in message ;; buffer instead of usual "HTML" banner. ;; C-c C-e operation is also allowed to view with external browser. ;; ;; If mew-use-w3m-minor-mode is t, key operations of w3m-mode is ;; allowed (as minor-mode-map) and jump links in message buffer. ;; NOTE: This feature is not complete. You may confuse. ;; ;; ;;; Code: (require 'mew) (require 'w3m) (eval-when-compile (require 'cl)) ;;; initializer for mew (defgroup mew-w3m nil "mew-w3m - Inline HTML rendering extension of Mew" :group 'w3m) (defcustom mew-use-w3m-minor-mode nil "*Use w3m minor mode in message buffer. Non-nil means that the minor mode whose keymap contains keys binded to some emacs-w3m commands are activated in message buffer, when viewing Text/Html contents." :group 'mew-w3m :type 'boolean) (defcustom mew-w3m-auto-insert-image nil "*If non-nil, images are inserted automatically in Multipart/Related message. This variable is effective only in XEmacs, Emacs 21 and Emacs 22." :group 'mew-w3m :type 'boolean) (defcustom mew-w3m-cid-retrieve-hook nil "*Hook run after cid retrieved" :group 'mew-w3m :type 'hook) (defcustom mew-w3m-region-cite-mark "> " "*Method of converting `blockquote'." :group 'mew-w3m :type '(choice (const :tag "Use Indent" nil) (const :tag "Use Cite Mark \"> \"" "> ") (string :tag "Use Other Mark"))) (defconst mew-w3m-safe-url-regexp "\\`cid:") ;; Avoid bytecompile error and warnings. (eval-when-compile (defvar mew-use-text/html) (unless (fboundp 'mew-current-get-fld) (autoload 'mew-coding-system-p "mew") (autoload 'mew-current-get-fld "mew") (autoload 'mew-current-get-msg "mew") (autoload 'mew-syntax-get-entry-by-cid "mew") (defun mew-cache-hit (&rest args) ()))) (defmacro mew-w3m-add-text-properties (props) `(add-text-properties (point-min) (min (1+ (point-min)) (point-max)) ,props)) (defun mew-w3m-minor-mode-setter () "Check message buffer and activate w3m-minor-mode." (w3m-minor-mode (or (and (get-text-property (point-min) 'w3m) mew-use-w3m-minor-mode) 0))) (defvar mew-w3m-use-safe-url-regexp t) (defun mew-w3m-view-inline-image (&optional allimage) "Display the images of Text/Html part. \\ '\\[mew-w3m-view-inline-image]' Toggle display the images included its message only. '\\[universal-argument]\\[mew-w3m-view-inline-image]' Display the all images included its Text/Html part." (interactive "P") (mew-summary-msg-or-part (if allimage (let ((mew-use-text/html t) (mew-w3m-auto-insert-image t) (mew-w3m-use-safe-url-regexp nil)) (mew-summary-display 'force)) (with-current-buffer (mew-buffer-message) (let* ((image (get-text-property (point-min) 'w3m-images)) (w3m-display-inline-images image) (w3m-safe-url-regexp (when mew-w3m-use-safe-url-regexp mew-w3m-safe-url-regexp))) (w3m-toggle-inline-images) (mew-elet (mew-w3m-add-text-properties `(w3m-images ,(not image))) (set-buffer-modified-p nil))))))) (defun mew-w3m-cite-blockquote (&optional inside-blockquote) "Quote paragraphs in
...
with the citation mark. The variable `mew-w3m-region-cite-mark' specifies the citation mark." (let ((case-fold-search t)) (while (and (re-search-forward "\ \[\t\n ]*<[\t\n ]*blockquote\\(?:[\t\n ]*>\\|[\t\n ]+[^>]+>\\)" nil t) (w3m-end-of-tag "blockquote" t)) (save-restriction (narrow-to-region (match-beginning 0) (match-end 0)) (delete-region (goto-char (match-end 3)) (match-end 0)) (insert "\n") (delete-region (goto-char (point-min)) (match-beginning 3)) (insert "\n") (while (and (re-search-forward "<[\t\n ]*pre\\(?:[\t\n ]*>\\|[\t\n ]+[^>]+>\\)" nil t) (w3m-end-of-tag "pre" t)) (delete-region (goto-char (match-end 2)) (match-end 0)) (if (bolp) (when (looking-at "\n+") (replace-match "")) (insert "\n")) (delete-region (goto-char (match-beginning 0)) (match-beginning 2)) (if (bolp) (when (looking-at "\n+") (replace-match "")) (insert "\n"))) (goto-char (point-min)) (mew-w3m-cite-blockquote 'inside-blockquote) (goto-char (point-min)) (while (re-search-forward "[\t\n ]*\\|[\t\n ]+[^>]+>\\)" nil t) (replace-match "\n")) (goto-char (point-min)) (while (and (re-search-forward "[\t\n ]*\\|[\t\n ]+[^>]+>\\)" nil t) (w3m-end-of-tag "div")) (goto-char (match-beginning 0)) (insert "\n") (goto-char (1+ (match-end 0))) (insert "\n")) (goto-char (point-min)) (while (re-search-forward "^[\t <>]+$" nil t) (replace-match "")) (goto-char (point-min)) (while (re-search-forward "\n\n\n+" nil t) (replace-match "\n\n")) (goto-char (point-min)) (when mew-w3m-region-cite-mark (goto-char (point-min)) (while (re-search-forward "[^\t\n ]" nil t) (beginning-of-line) (if (looking-at "[\t ]+") (replace-match mew-w3m-region-cite-mark) (insert mew-w3m-region-cite-mark)) (end-of-line))) (unless inside-blockquote ; "> > > " --> ">>> " (when (and mew-w3m-region-cite-mark (string-match " \\'" mew-w3m-region-cite-mark)) (let ((base (substring mew-w3m-region-cite-mark 0 (match-beginning 0))) (regexp (regexp-quote mew-w3m-region-cite-mark))) (setq regexp (concat "^" regexp "\\(?:" regexp "\\)+")) (goto-char (point-min)) (while (re-search-forward regexp nil t) (dotimes (i (prog1 (/ (- (match-end 0) (match-beginning 0)) (length mew-w3m-region-cite-mark)) (delete-region (match-beginning 0) (match-end 0)))) (insert base)) (insert " ")))) (goto-char (point-min)) (insert "
")
	  (goto-char (point-max))
	  (insert "
\n")))))) (defun mew-w3m-region (start end &optional url charset) "w3m-region with inserting the cite mark." (if (null mew-w3m-region-cite-mark) (w3m-region start end url charset) (save-restriction (narrow-to-region (goto-char start) end) (mew-w3m-cite-blockquote) (w3m-region (point-min) (point-max) url charset) (goto-char (point-min)) (while (re-search-forward "^[\t ]+$" nil t) (replace-match "")) (goto-char (point-min)) (while (re-search-forward "\n\n\n+" nil t) (replace-match "\n\n")) (goto-char (point-min)) (skip-chars-forward "\n") (delete-region (point-min) (point)) (goto-char (point-max)) (skip-chars-backward "\n") (delete-region (point) (point-max)) (insert "\n")))) ;; processing Text/Html contents with w3m. (defun mew-mime-text/html-w3m (&rest args) "View Text/Html contents with w3m rendering output." (let ((w3m-display-inline-images mew-w3m-auto-insert-image) (w3m-safe-url-regexp (when mew-w3m-use-safe-url-regexp mew-w3m-safe-url-regexp)) w3m-force-redisplay ;; don't redraw charset wcs xref cache begin end params execute) (if (= (length args) 2) ;; Mew-2 (setq begin (nth 0 args) end (nth 1 args)) ;; Old Mew (setq cache (nth 0 args)) (setq begin (nth 1 args)) (setq end (nth 2 args)) (setq params (nth 3 args)) (setq execute (nth 4 args))) (if (and cache (or execute (<= end begin))) ;; 'C-cC-e' + Old Mew (apply 'mew-mime-text/html (list cache begin end params execute)) (save-excursion ;; search Xref: Header in SHIMBUN article (when cache (set-buffer cache)) (goto-char (point-min)) (when (re-search-forward mew-eoh nil t) (let ((eoh (point)) (case-fold-search t)) (goto-char (point-min)) (when (and (re-search-forward "^X-Shimbun-Id: " eoh t) (goto-char (point-min)) (re-search-forward "^Xref: \\(.+\\)\n" eoh t)) (setq xref (match-string 1)) (w3m-static-if (fboundp 'match-string-no-properties) (setq xref (match-string-no-properties 1)) (setq xref (match-string 1)) (set-text-properties 0 (length xref) nil xref)))))) (mew-elet (cond ((and (null cache) (eq w3m-type 'w3m-m17n)) ;; Mew-2 + w3m-m17n. ;; Coding-system and charset are decided by Mew. (let ((w3m-input-coding-system w3m-input-coding-system) (w3m-output-coding-system w3m-output-coding-system) (w3m-halfdump-command-arguments w3m-halfdump-command-arguments)) (when (setq charset (mew-charset-guess-region begin end)) (setq wcs (mew-charset-to-cs charset))) (when (and charset wcs (mew-coding-system-p wcs)) ;; guess correctly and not us-ascii (setq w3m-input-coding-system wcs) (setq w3m-output-coding-system wcs) (setq w3m-halfdump-command-arguments (list "-halfdump" "-I" charset "-O" charset "-o" "ext_halfdump=1" "-o" "pre_conv=1" "-o" "strict_iso2022=0"))) (mew-w3m-region begin end xref))) ((null cache) ;; Mew-2 + w3m, w3mmee (mew-w3m-region begin end xref (mew-charset-guess-region begin end))) (t ;; Old Mew (setq charset (or (mew-syntax-get-param params "charset") (with-current-buffer cache (mew-charset-guess-region begin end)))) (if charset (setq wcs (mew-charset-to-cs charset)) (setq wcs mew-cs-text-for-write)) (mew-frwlet mew-cs-dummy wcs (mew-w3m-region (point) (progn (insert-buffer-substring cache begin end) (point)) xref)))) (mew-w3m-add-text-properties `(w3m t w3m-images ,mew-w3m-auto-insert-image)))))) (defvar w3m-mew-support-cid (and (boundp 'mew-version-number) (fboundp 'mew-syntax-get-entry-by-cid))) (defun mew-w3m-cid-retrieve (url &rest args) (let ((output-buffer (current-buffer))) (with-current-buffer w3m-current-buffer (when (and w3m-mew-support-cid (string-match "^cid:\\(.+\\)" url)) (setq url (match-string 1 url)) (let* ((fld (mew-current-get-fld (mew-frame-id))) (msg (mew-current-get-msg (mew-frame-id))) (cache (mew-cache-hit fld msg 'must-hit)) (syntax (mew-cache-decode-syntax cache)) cidstx beg end) (if (string< "4.0.53" mew-version-number) (setq cidstx (mew-syntax-get-entry-by-cid syntax (concat "<" url ">"))) (setq cidstx (mew-syntax-get-entry-by-cid syntax url))) (when cidstx (setq beg (mew-syntax-get-begin cidstx)) (setq end (mew-syntax-get-end cidstx)) (prog1 (with-current-buffer output-buffer (set-buffer-multibyte t) (insert-buffer-substring cache beg end) (set-buffer-multibyte nil) (downcase (car (mew-syntax-get-ct cidstx)))) (run-hooks 'mew-w3m-cid-retrieve-hook)))))))) (when w3m-mew-support-cid (push (cons 'mew-message-mode 'mew-w3m-cid-retrieve) w3m-cid-retrieve-function-alist)) (defun mew-w3m-ext-url-show (dummy url) (pop-to-buffer (mew-buffer-message)) (w3m url)) (defun mew-w3m-ext-url-fetch (dummy url) (lexical-let ((url url) (name (file-name-nondirectory url)) handler) (w3m-process-do (success (prog1 (w3m-download url nil nil handler) (message "Download: %s..." name))) (if success (message "Download: %s...done" name) (message "Download: %s...failed" name)) (sit-for 1)))) (defun w3m-mail-compose-with-mew (source url charset content-type to subject other-headers) "Compose a mail using Mew." (when (one-window-p) (split-window)) (select-window (next-window)) (condition-case nil (unless (and (boundp 'mew-init-p) mew-init-p (progn (mew-summary-jump-to-draft-buffer) (and (eq major-mode 'mew-draft-mode) (y-or-n-p "Attatch this draft? ")))) (mew-user-agent-compose to subject other-headers)) (quit (if (y-or-n-p "Create new draft? ") (mew-user-agent-compose to subject other-headers) (delete-window) (error "Abort mail composing")))) (let* ((basename (file-name-nondirectory (w3m-url-strip-query url))) (ct (downcase content-type)) (mew-attach-move-next-after-copy nil) (i 1) (pos -1) (csorig (mew-charset-to-cs (symbol-name charset))) last filename cs) (unless (mew-attach-p) (mew-draft-prepare-attachments)) ;; goto last attachment (setq last (catch 'last (while (not (= pos (point))) (setq i (1+ i)) (mew-attach-goto-number 'here `(,i)) (when (mew-attach-line-lastp) (throw 'last t))))) (when (eq csorig mew-cs-unknown) (setq csorig nil)) (if (or (not last) (not (mew-attach-not-line012-1))) (message "Can not attach from emacs-w3m here!") ;; Application/.*xml is not inline view with Mew. (cond ((string= "application/xhtml+xml" ct) (setq ct "text/html")) ((string-match "^application/.*xml$" ct) (setq ct "text/xml"))) (setq filename (expand-file-name (cond ((and (string-match "^[\t ]*$" basename) (string= ct "text/html")) "index.html") ((and (string-match "^[\t ]*$" basename) (string= ct "text/xml")) "index.xml") ((string-match "^[\t ]*$" basename) "dummy") (t basename)) mew-temp-dir)) (with-temp-buffer (cond ((string= "text/html" ct) (insert source) (setq cs (w3m-static-if (fboundp 'mew-text/html-detect-cs) (mew-text/html-detect-cs (point-min) (point-max)))) (when (or (eq cs mew-cs-unknown) (not cs)) (cond (csorig (setq cs csorig)) (t (setq cs mew-cs-autoconv))))) ((string= "text/xml" ct) (insert source) (setq cs (w3m-static-if (fboundp 'mew-text/html-detect-cs) (mew-text/html-detect-cs (point-min) (point-max)))) (when (or (eq cs mew-cs-unknown) (not cs)) (cond (csorig (setq cs csorig)) ((mew-coding-system-p 'utf-8) (setq cs 'utf-8)) (t (setq cs mew-cs-autoconv))))) ((string-match "^text/" ct) (insert source) (setq cs mew-cs-autoconv)) (t (mew-set-buffer-multibyte nil) (insert source) (setq cs mew-cs-binary))) (setq charset (cond ((eq cs mew-cs-autoconv) (mew-charset-guess-region (point-min) (point-max))) ((eq cs mew-cs-binary) nil) (t (mew-cs-to-charset cs)))) (mew-frwlet mew-cs-text-for-read cs (write-region (point-min) (point-max) filename nil 'nomsg))) (when ct (setq ct (mew-capitalize ct))) (mew-attach-copy filename (file-name-nondirectory filename)) ;; content-type check & set (let* ((nums (mew-syntax-nums)) (syntax (mew-syntax-get-entry mew-encode-syntax nums)) (file (mew-syntax-get-file syntax)) (ctl (mew-syntax-get-ct syntax)) (ct-orig (mew-syntax-get-value ctl 'cap)) cte) (unless (string= ct ct-orig) (setq ctl (list ct)) (mew-syntax-set-ct syntax ctl) (setq cte (mew-ctdb-cte (mew-ctdb-by-ct ct))) (mew-syntax-set-cte syntax cte) (mew-syntax-set-cdp syntax (mew-syntax-cdp-format ct file)) (mew-encode-syntax-print mew-encode-syntax))) ;; charset set (let* ((nums (mew-syntax-nums)) (syntax (mew-syntax-get-entry mew-encode-syntax nums)) (file (mew-syntax-get-file syntax)) (ctl (mew-syntax-get-ct syntax)) (ct (mew-syntax-get-value ctl 'cap)) (params (mew-syntax-get-params ctl)) (ocharset "charset")) (when (and (string-match "^Text" ct) charset) (setq params (mew-delete ocharset params)) (setq ctl (cons ct (cons (list ocharset charset) params))) (mew-syntax-set-ct syntax ctl)) (mew-syntax-set-cd syntax url) (mew-encode-syntax-print mew-encode-syntax)) (message "Compose a mail using Mew with %s...done" url) (when (and (file-exists-p filename) (file-writable-p filename)) (delete-file filename))))) ;;; (provide 'mew-w3m) ;; mew-w3m.el ends here w3m-el-snapshot-1.4.527+0.20140108.orig/w3m-filter.el0000644000000000000000000006137712245635476017670 0ustar rootroot;;; w3m-filter.el --- filtering utility of advertisements on WEB sites -*- coding: utf-8 -*- ;; Copyright (C) 2001-2008, 2012, 2013 TSUCHIYA Masatoshi ;; Authors: TSUCHIYA Masatoshi ;; Keywords: w3m, WWW, hypermedia ;; This file is a part of emacs-w3m. ;; This program 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, or (at your option) ;; any later version. ;; This program 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 this program; see the file COPYING. If not, write to ;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, ;; Boston, MA 02110-1301, USA. ;;; Commentary: ;; w3m-filter.el is the add-on utility to filter advertisements on WEB ;; sites. ;;; Code: (provide 'w3m-filter) (eval-when-compile (require 'cl)) (require 'w3m) (defcustom w3m-filter-configuration `((t ("Strip Google's click-tracking code from link urls" "Google click-tracking 潟若潟 url ゃ障") "\\`https?://[a-z]+\\.google\\." w3m-filter-google-click-tracking) (t ("Align table columns vertically to shrink the table width in Google" "Google 罎膣∝若膰劫ф綛障") "\\`http://\\(www\\|images\\|news\\|maps\\|groups\\)\\.google\\." w3m-filter-google-shrink-table-width) (t ("Add name anchors that w3m can handle in all pages" "鴻若吾 w3m 宴 name ≪潟若菴遵障") "" w3m-filter-add-name-anchors) (t ("Substitute disabled attr with readonly attr in forms" "若筝 disabled 絮с readonly 絮ст撮障") "" w3m-filter-subst-disabled-with-readonly) (nil ("Render ... after ..." "若 緇祉障") "" w3m-filter-fix-tfoot-rendering) (nil ("Remove garbage in http://www.geocities.co.jp/*" "http://www.geocities.co.jp/* с眼ゃ障") "\\`http://www\\.geocities\\.co\\.jp/" (w3m-filter-delete-regions "
\n" "\n
")) (nil ("Remove ADV in http://*.hp.infoseek.co.jp/*" "http://*.hp.infoseek.co.jp/* уゃ障") "\\`http://[a-z]+\\.hp\\.infoseek\\.co\\.jp/" (w3m-filter-delete-regions "" "")) (nil ("Remove ADV in http://linux.ascii24.com/linux/*" "http://linux.ascii24.com/linux/* уゃ障") "\\`http://linux\\.ascii24\\.com/linux/" (w3m-filter-delete-regions "" "")) (nil "A filter for Google" "\\`http://\\(www\\|images\\|news\\|maps\\|groups\\)\\.google\\." w3m-filter-google) (nil "A filter for Amazon" "\\`https?://\\(?:www\\.\\)?amazon\\.\ \\(?:com\\|co\\.\\(?:jp\\|uk\\)\\|fr\\|de\\)/" w3m-filter-amazon) (nil ("A filter for Mixi.jp" "激ｇｃ") "\\`https?://mixi\\.jp" w3m-filter-mixi) (nil "A filter for http://eow.alc.co.jp/*/UTF-8*" "\\`http://eow\\.alc\\.co\\.jp/[^/]+/UTF-8" w3m-filter-alc) (nil ("A filter for Asahi Shimbun" "ユ域ｃ") "\\`http://www\\.asahi\\.com/" w3m-filter-asahi-shimbun) (nil "A filter for http://imepita.jp/NUM/NUM*" "\\`http://imepita\\.jp/[0-9]+/[0-9]+" w3m-filter-imepita) (nil "A filter for http://allatanys.jp/*" "\\`http://allatanys\\.jp/" w3m-filter-allatanys) (nil "A filter for Wikipedia" "\\`http://.*\\.wikipedia\\.org/" w3m-filter-wikipedia) (nil ("Remove inline frames in all pages" "鴻若吾сゃ潟ゃ潟若ゃ障") "" w3m-filter-iframe)) "List of filter configurations applied to web contents. Each filter configuration consists of the following form: \(FLAG DESCRIPTION REGEXP FUNCTION) FLAG Non-nil means this filter is enabled. DESCRIPTION Describe what this filter does. The value may be a string or a list of two strings; in the later case, those descriptions are written in English and Japanese respectively, and only either one is displayed in the customization buffer according to `w3m-language'. REGEXP Regular expression to restrict this filter so as to run only on web contents of which the url matches. FUNCTION Filter function to run on web contents. The value may be a function or a list of a function and rest argument(s). A function should take at least one argument, a url of contents retrieved then, as the first argument even if it is useless. Use the later (i.e. a function and arguments) if the function requires rest arguments." :group 'w3m :type '(repeat :convert-widget w3m-widget-type-convert-widget (let ((locker (lambda (fn) `(lambda (&rest args) (when (and (not inhibit-read-only) (eq (get-char-property (point) 'face) 'widget-inactive)) (when (and (not debug-on-error) (eventp (cadr args)) (memq 'down (event-modifiers (cadr args)))) (setq before-change-functions `((lambda (from to) (setq before-change-functions ',before-change-functions))))) (error "The widget here is not active")) (apply #',fn args))))) `((group :indent 2 ;; Work around a widget bug: the default value of `choice' ;; gets nil regardless of the type of items if it is within ;; (group :inline t ...). Fixed in Emacs 24.4 (Bug#12670). :default-get (lambda (widget) '(t "Not documented" ".*" ignore)) :value-create (lambda (widget) (widget-group-value-create widget) (unless (car (widget-value widget)) (let ((children (widget-get widget :children))) (widget-specify-inactive (cadr (widget-get widget :args)) (widget-get (car children) :to) (widget-get (car (last children)) :to))))) (checkbox :format "\n%[%v%]" :action (lambda (widget &optional event) (let ((widget-edit-functions (lambda (widget) (let* ((parent (widget-get widget :parent)) (child (cadr (widget-get parent :args)))) (if (widget-value widget) (progn (widget-specify-active child) (widget-put child :inactive nil)) (widget-specify-inactive child (widget-get widget :to) (widget-get (car (last (widget-get (car (last (widget-get parent :children))) :children))) :to))))))) (widget-checkbox-action widget event)))) (group :inline t (choice :format " %v" (string :format "%v") (group ,@(if (equal "Japanese" w3m-language) '((sexp :format "") (string :format "%v")) '((string :format "%v") (sexp :format "")))) (const :format "Not documented\n" nil)) (regexp :format "Regexp matching url: %v") (choice :tag "Type" :format "Function %[Type%]: %v" :action ,(funcall locker 'widget-choice-action) (function :tag "Function with no rest arg" :format "%v") (group :tag "Function and rest arg(s)" :indent 0 :offset 4 (function :format "%v") (editable-list :inline t :entry-format "%i %d Arg: %v" :insert-before ,(funcall locker 'widget-editable-list-insert-before) :delete-at ,(funcall locker 'widget-editable-list-delete-at) (sexp :format "%v")))))))))) (defcustom w3m-filter-rules nil "Rules to filter advertisements on WEB sites. This variable is semi-obsolete; use `w3m-filter-configuration' instead." :group 'w3m :type '(repeat (group :format "%v" :indent 2 (regexp :format "Regexp: %v\n" :value ".*" :size 0) (choice :tag "Filtering Rule" (group :inline t :tag "Delete regions surrounded with these patterns" (const :format "Function: %v\n" w3m-filter-delete-regions) (string :format "Start: %v\n" :size 0 :value "not a regexp") (string :format " End: %v\n" :size 0 :value "not a regexp")) (function :tag "Filter with a user defined function" :format "Function: %v\n" :size 0))))) (defcustom w3m-filter-google-use-utf8 (or (featurep 'un-define) (fboundp 'utf-translate-cjk-mode) (and (not (equal "Japanese" w3m-language)) (w3m-find-coding-system 'utf-8))) "*Use the converting rule to UTF-8 on the site of Google." :group 'w3m :type 'boolean) (defcustom w3m-filter-google-use-ruled-line t "*Use the ruled line on the site of Google." :group 'w3m :type 'boolean) (defcustom w3m-filter-google-separator "
" "Field separator for Google's search results ." :group 'w3m :type 'string) (defcustom w3m-filter-amazon-regxp (concat "\\`\\(https?://\\(?:www\\.\\)?amazon\\." "\\(?:com\\|co\\.\\(?:jp\\|uk\\)\\|fr\\|de\\)" ;; "Joyo.com" "\\)/" "\\(?:" "\\(?:exec/obidos\\|o\\)/ASIN" "\\|" "gp/product" "\\|" "\\(?:[^/]+/\\)?dp" "\\)" "/\\([0-9]+\\)") "*Regexp to extract ASIN number for Amazon." :group 'w3m :type '(string :size 0)) (defcustom w3m-filter-amazon-short-url-bottom nil "*Amazon short URLs insert bottom position." :group 'w3m :type 'boolean) ;;;###autoload (defun w3m-filter (url) "Apply filtering rule of URL against a content in this buffer." (save-match-data (dolist (elem (append w3m-filter-rules (delq nil (mapcar (lambda (config) (when (car config) (if (consp (nth 3 config)) (cons (nth 2 config) (nth 3 config)) (list (nth 2 config) (nth 3 config))))) w3m-filter-configuration)))) (when (string-match (car elem) url) (apply (cadr elem) url (cddr elem)))))) (defun w3m-filter-delete-regions (url start end) "Delete regions surrounded with a START pattern and an END pattern." (goto-char (point-min)) (let (p (i 0)) (while (and (search-forward start nil t) (setq p (match-beginning 0)) (search-forward end nil t)) (delete-region p (match-end 0)) (incf i)) (> i 0))) (defun w3m-filter-replace-regexp (url regexp to-string) "Replace all occurrences of REGEXP with TO-STRING." (goto-char (point-min)) (while (re-search-forward regexp nil t) (replace-match to-string nil nil))) ;; Filter functions: (defun w3m-filter-google-click-tracking (url) "Strip Google's click-tracking code from link urls" (goto-char (point-min)) (while (re-search-forward "\\(]+[\t\n ]+\\)*\ href=\"\\)\\(?:[^\"]+\\)?/\\(?:imgres\\?imgurl\\|url\\?\\(?:q\\|url\\)\\)=\ \\([^&]+\\)[^>]+>" nil t) ;; In a search result Google encodes some special characters like "+" ;; and "?" to "%2B" and "%3F" in a real url, so we need to decode them. (insert (w3m-url-decode-string (prog1 (concat (match-string 1) (match-string 2) "\">") (delete-region (match-beginning 0) (match-end 0))))))) (defun w3m-filter-google-shrink-table-width (url) "Align table columns vertically to shrink the table width." (let ((case-fold-search t) last) (goto-char (point-min)) (while (re-search-forward "]" nil t) (when (w3m-end-of-tag "tr") (save-restriction (narrow-to-region (goto-char (match-beginning 0)) (match-end 0)) (setq last nil) (while (re-search-forward "]" nil t) (when (w3m-end-of-tag "td") (setq last (match-end 0)) (replace-match "\\&"))) (when last (goto-char (+ 4 last)) (delete-char 4)) (goto-char (point-max))))) ;; Remove rowspan and width specs, and
s. (goto-char (point-min)) (while (re-search-forward "]" nil t) (when (w3m-end-of-tag "table") (save-restriction (narrow-to-region (goto-char (match-beginning 0)) (match-end 0)) (while (re-search-forward "\ \[\t\n\r ]*\\(?:\\(?:rowspan\\|width\\)=\"[^\"]+\"\\|
\\)[\t\n\r ]*" nil t) ;; Preserve a space at the line-break point. (replace-match " ")) ;; Insert a space between ASCII and non-ASCII characters ;; and after a comma. (goto-char (point-min)) (while (re-search-forward "\ \\([!-;=?-~]\\)\\([^ -~]\\)\\|\\([^ -~]\\)\\([!-;=?-~]\\)\\|\\(,\\)\\([^ ]\\)" nil t) (forward-char -1) (insert " ") (forward-char)) (goto-char (point-max))))))) (defun w3m-filter-add-name-anchors (url) ;; cf. [emacs-w3m:11153] "Add name anchors that w3m can handle. This function adds ``'' in front of ``FOO BAR'' in the current buffer." (let ((case-fold-search t) names st nd name) (goto-char (point-min)) (while (re-search-forward "]+[\t\n\r ]+\\)*\ href=\"#\\([a-z][-.0-9:_a-z]*\\)\"" nil t) (add-to-list 'names (match-string 1))) (when names (setq names (concat "<\\(?:[^\t\n\r >]+\\)\ \[\t\n\r ]+\\(?:[^\t\n\r >]+[\t\n\r ]+\\)*[Ii][Dd]=\"\\(" (mapconcat 'regexp-quote names "\\|") "\\)\"") case-fold-search nil) (goto-char (point-min)) (while (re-search-forward names nil t) (goto-char (setq st (match-beginning 0))) (setq nd (match-end 0) name (match-string 1)) (insert "") (goto-char (+ nd (- (point) st))))))) (defun w3m-filter-subst-disabled-with-readonly (url) ;; cf. [emacs-w3m:12146] [emacs-w3m:12222] "Substitute disabled attr with readonly attr in forms." (let ((case-fold-search t) st nd val default) (goto-char (point-min)) (while (re-search-forward "\ <\\(?:input\\|\\(option\\)\\|textarea\\)\ \\(?:[\t\n ]+[^\t\n >]+\\)*[\t\n ]\ \\(?:\\(disabled\\(=\"[^\"]+\"\\)?\\)\\|\\(readonly\\(?:=\"[^\"]+\"\\)?\\)\\)\ \\(?:[\t\n ]+[^\t\n >]+\\)*[\t\n /]*>" nil t) (setq st (match-beginning 0) nd (match-end 0) val (if (match-beginning 2) (if (match-beginning 3) "readonly=\"readonly\"" "readonly") (match-string 4))) (if (match-beginning 1) ;; Unfortunately w3m doesn't support readonly attr in select forms, ;; so we replace them with read-only input forms. (if (and (re-search-backward "]+\\)*[\t\n ]selected\\(?:=\"[^\"]+\"\\)?\ \\(?:[\t\n ]+[^\t\n >]+\\)*[\t\n /]*>[\t\n ]*\\([^<]+\\)" nil t) (goto-char (match-end 1)) (skip-chars-backward "\t\n ") (buffer-substring (match-beginning 1) (point)))) (delete-region (point-min) (point-max)) (insert "")) (goto-char (point-max))))) (goto-char nd)) (if (match-beginning 2) (save-restriction (narrow-to-region st nd) (delete-region (goto-char (match-beginning 2)) (match-end 2)) (insert val) (goto-char (point-max))) (goto-char nd)))))) (defun w3m-filter-fix-tfoot-rendering (url &optional recursion) "Render ... after ...." (let ((table-exists recursion) (mark "!-- emacs-w3m-filter ") (tbody-end (make-marker)) tfoots) (goto-char (if table-exists (match-end 0) (point-min))) (while (or table-exists (re-search-forward "]" nil t)) (setq table-exists nil) (save-restriction (if (w3m-end-of-tag "table") (narrow-to-region (match-beginning 0) (match-end 0)) (narrow-to-region (match-beginning 0) (point-max))) (goto-char (1+ (match-beginning 0))) (insert mark) (while (re-search-forward "]" nil t) (w3m-filter-fix-tfoot-rendering url t)) (goto-char (point-min)) (while (search-forward "" nil t) (set-marker tbody-end (match-end 0)) (goto-char (1+ (match-beginning 0))) (insert mark)) (unless (bobp) (setq tfoots nil) (goto-char (point-min)) (while (re-search-forward "]" nil t) (when (w3m-end-of-tag "tfoot") (push (match-string 0) tfoots) (delete-region (match-beginning 0) (match-end 0)))) (when tfoots (goto-char tbody-end) (dolist (tfoot (nreverse tfoots)) (insert "<" mark (substring tfoot 1))))) (goto-char (point-max)))) (set-marker tbody-end nil) (unless recursion (goto-char (point-min)) (while (search-forward mark nil t) (delete-region (match-beginning 0) (match-end 0)))))) (defun w3m-filter-asahi-shimbun (url) "Convert entity reference of UCS." (when w3m-use-mule-ucs (goto-char (point-min)) (let ((case-fold-search t) end ucs) (while (re-search-forward "alt=\"\\([^\"]+\\)" nil t) (goto-char (match-beginning 1)) (setq end (set-marker (make-marker) (match-end 1))) (while (re-search-forward "&#\\([0-9]+\\);" (max end (point)) t) (setq ucs (string-to-number (match-string 1))) (delete-region (match-beginning 0) (match-end 0)) (insert-char (w3m-ucs-to-char ucs) 1)))))) (defun w3m-filter-google (url) "Insert separator within items." (goto-char (point-min)) (let ((endm (make-marker)) (case-fold-search t) pos beg end) (when (and w3m-filter-google-use-utf8 (re-search-forward "\ " nil t)) (insert w3m-filter-google-separator)) (if w3m-filter-google-use-ruled-line (while (search-backward "
")))))) (defun w3m-filter-amazon (url) "Insert Amazon short URIs." (when (string-match w3m-filter-amazon-regxp url) (let* ((base (match-string 1 url)) (asin (match-string 2 url)) (shorturls `(,(concat base "/dp/" asin "/") ,(concat base "/o/ASIN/" asin "/") ,(concat base "/gp/product/" asin "/"))) (case-fold-search t) shorturl) (goto-char (point-min)) (setq url (file-name-as-directory url)) (when (or (and (not w3m-filter-amazon-short-url-bottom) (search-forward "" nil t)) (and w3m-filter-amazon-short-url-bottom (search-forward "" nil t) (goto-char (match-beginning 0)))) (insert "\n") (while (setq shorturl (car shorturls)) (setq shorturls (cdr shorturls)) (unless (string= url shorturl) (insert (format "Amazon Short URL: %s
\n" shorturl shorturl)))) (insert "\n"))))) (defun w3m-filter-mixi (url) "Direct jump to the external diary." (goto-char (point-min)) (let (newurl) (while (re-search-forward "]+\\)>" nil t) (setq newurl (match-string 1)) (when newurl (delete-region (match-beginning 0) (match-end 0)) (when (string-match "&owner_id=[0-9]+\"?\\'" newurl) (setq newurl (substring newurl 0 (match-beginning 0)))) (insert (format "" (w3m-url-readable-string newurl))))))) (defun w3m-filter-alc (url) (let ((baseurl "http://eow.alc.co.jp/%s/UTF-8/") curl cword beg tmp1) (when (string-match "\\`http://eow\\.alc\\.co\\.jp/\\([^/]+\\)/UTF-8/" url) (setq curl (match-string 0 url)) (setq cword (match-string 1 url)) (setq cword (car (split-string (w3m-url-decode-string cword 'utf-8) " "))) (goto-char (point-min)) (while (search-forward "若帥荵∵胼障" nil t) (delete-region (line-beginning-position) (line-end-position)) (insert "
")) (goto-char (point-min)) (when (search-forward "沿 on the WEB

\n") (setq beg (point)) (when (search-forward "" nil t) (forward-line 1) (delete-region beg (point))) (when (search-forward "" nil t) (forward-line 1) (setq beg (point)) (when (search-forward "" nil t) (delete-region beg (match-beginning 0)))) (insert "
鐚若帥荵∵胼障") ;; next/previous page (goto-char (point-min)) (while (re-search-forward "" nil t) (setq tmp1 (match-string 1)) (delete-region (match-beginning 0) (match-end 0)) (insert (format "" curl tmp1))) ;; wordlink (goto-char (point-min)) (while (re-search-forward "\\([^<]+\\)" nil t) (setq tmp1 (match-string 1)) (delete-region (match-beginning 0) (match-end 0)) (insert (format "%s" (format baseurl tmp1) tmp1))) ;; goGradable/goFairWord (goto-char (point-min)) (while (re-search-forward "" nil t) (setq tmp1 (match-string 2)) (delete-region (match-beginning 0) (match-end 0)) (insert (format "" (format baseurl tmp1)))) ;; remove spacer (goto-char (point-min)) (while (search-forward "img/spacer.gif" nil t) (delete-region (line-beginning-position) (line-end-position))) (goto-char (point-min)) ;; remove 若潟 (when (search-forward "alt=\"若潟\"" nil t) (delete-region (line-beginning-position) (line-end-position))) ;; 茵腓冴∞ (goto-char (point-min)) (while (re-search-forward (concat "
*" "" "茵腓冴") nil t) (delete-region (match-beginning 0) (match-end 0))) ;; Java Document write... ;_; ;; (while (re-search-forward ;; "" ;; nil t) ;; (setq tmp1 (match-string 1)) ;; (setq tmp2 (match-string 2)) ;; (delete-region (match-beginning 0) (match-end 0)) ;; ;; &dk=JE, &dk=EJ ;; (insert (format "" ;; curl tmp1 tmp2 ;; (if (string-match "\\Cj" cword) "JE" "EJ")))) )))) (defun w3m-filter-imepita (url) "JavaScript emulation." (goto-char (point-min)) (let (tmp) (when (re-search-forward (concat "\n" "") nil t) (setq tmp (match-string 1)) (delete-region (match-beginning 0) (match-end 0)) (insert tmp)))) (defun w3m-filter-iframe (url) (goto-char (point-min)) (while (re-search-forward "