w3m-el-snapshot-1.4.609+0.20171225.orig/0000755000000000000000000000000013224004712015321 5ustar rootrootw3m-el-snapshot-1.4.609+0.20171225.orig/w3m-fb.el0000644000000000000000000001503510504204522016741 0ustar rootroot;;; w3m-fb.el --- frame-local buffers support for Emacs-w3m ;;; Copyright (C) 2005, 2006 Matthew P. Hodges ;; Author: Matthew P. Hodges ;; Version: $Id: w3m-fb.el,v 1.4 2006/09/20 09:26:42 yamaoka Exp $ ;; w3m-fb.el is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published ;; by the Free Software Foundation; either version 2, or (at your ;; option) any later version. ;; w3m-fb.el is distributed in the hope that it will be useful, but ;; WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU ;; General Public License for more details. ;;; Commentary: ;; ;; With this mode switched on, W3M buffers are associated with the ;; frame on which they were created. Only tabs for the current ;; frame's W3M buffers are shown (with non-nil w3m-use-tab); other ;; affected commands are w3m-next-buffer w3m-previous-buffer, ;; w3m-select-buffer and w3m-quit. ;; ;; Switch the mode on programmatically with: ;; ;; (w3m-fb-mode 1) ;; ;; or toggle interactively with M-x w3m-fb-mode RET. ;;; Code: (defconst w3m-fb-version "1.0.0" "Version number of this package.") (eval-when-compile (autoload 'w3m-delete-buffer "w3m" nil t) (autoload 'w3m-list-buffers "w3m-util") (autoload 'w3m-next-buffer "w3m" nil t) (defvar w3m-pop-up-frames)) (eval-and-compile (defalias 'w3m-fb-frame-parameter (cond ((fboundp 'frame-parameter) 'frame-parameter) ((fboundp 'frame-property) 'frame-property) (t (error "No frame parameter/property function"))))) (defvar w3m-fb-delete-frame-functions (cond ((boundp 'delete-frame-functions) 'delete-frame-functions) ((boundp 'delete-frame-hook) 'delete-frame-hook) (t (error "No delete-frame hook/functions variable found"))) "Symbol associated with `delete-frame' hooks.") (defvar w3m-fb-list-buffers-frame nil "Frame to list buffers for in `w3m-list-buffers'. Bind this if the buffers associated with a frame other than the selected frame are required.") ;; Customizable variables (defgroup w3m-fb nil "Frame local buffers for Emacs-w3m." :group 'w3m) (defcustom w3m-fb-delete-frame-kill-buffers t "If non-nil, kill W3M buffers after deleting frames." :group 'w3m-fb :type 'boolean :set (lambda (sym val) (set sym val) (when (boundp 'w3m-fb-mode) (if w3m-fb-mode (add-hook w3m-fb-delete-frame-functions 'w3m-fb-delete-frame-buffers) (remove-hook w3m-fb-delete-frame-functions 'w3m-fb-delete-frame-buffers))))) ;; Internal variables (defvar w3m-fb-buffer-list nil "List of w3m buffers associated with the selected frame.") (defvar w3m-fb-inhibit-buffer-selection nil "Non-nil to inhibit selecting a suitable w3m buffer.") ;; Internal functions (defun w3m-fb-delete-frame-buffers (&optional frame) "Delete W3M buffers associated with frame FRAME." (let* ((w3m-fb-list-buffers-frame frame) (buffers (w3m-list-buffers)) ;; Now bind w3m-fb-mode to nil so that w3m-delete-buffer ;; doesn't call w3m-quit when there are w3m buffers belonging ;; to other frames. (w3m-fb-mode nil) (w3m-fb-inhibit-buffer-selection t)) (save-window-excursion (dolist (b buffers) (with-current-buffer b (w3m-delete-buffer)))))) ;; Could use set-frame-parameter here, but it isn't portable (defun w3m-fb-set-frame-parameter (frame parameter value) "Set for frame FRAME parameter PARAMETER to VALUE." (modify-frame-parameters frame (list (cons parameter value)))) (defun w3m-fb-add () "Add current buffer to `w3m-fb-buffer-list'." (let ((val (w3m-fb-frame-parameter nil 'w3m-fb-buffer-list))) (w3m-fb-set-frame-parameter nil 'w3m-fb-buffer-list (nconc val (list (current-buffer)))))) (defun w3m-fb-remove () "Remove current buffer from `w3m-fb-buffer-list'. Applies to all frames." (when (eq major-mode 'w3m-mode) (let (val) (dolist (f (frame-list)) (setq val (w3m-fb-frame-parameter f 'w3m-fb-buffer-list)) (w3m-fb-set-frame-parameter f 'w3m-fb-buffer-list (delq (current-buffer) val)))))) (defun w3m-fb-associate () "Associate all `w3m-mode' buffers with a frame." (let (buffers done rest) ;; Buffers displayed in windows (dolist (f (frame-list)) (setq buffers nil) (dolist (w (window-list f nil (frame-selected-window f))) (when (with-current-buffer (window-buffer w) (eq major-mode 'w3m-mode)) (setq buffers (nconc buffers (list (window-buffer w)))) (setq done (nconc done (list (window-buffer w)))))) (w3m-fb-set-frame-parameter f 'w3m-fb-buffer-list buffers)) ;; Buffers not displayed in windows; add to selected frame (let ((w3m-fb-mode nil)) (setq rest (w3m-list-buffers))) (dolist (b done) (setq rest (delq b rest))) (when rest (w3m-fb-set-frame-parameter nil 'w3m-fb-buffer-list (nconc (w3m-fb-frame-parameter nil 'w3m-fb-buffer-list) rest))))) (defun w3m-fb-dissociate () "Disassociate `w3m-mode' buffers from frames." (dolist (f (frame-list)) (w3m-fb-set-frame-parameter f 'w3m-fb-buffer-list nil))) (defun w3m-fb-select-buffer () "Select an appropriate W3M buffer to display." ;; If there are w3m buffers belonging to this frame, ensure one is ;; selected; if not make sure that we're not displaying a w3m ;; buffer (cond ;; Select w3m buffer belonging to frame, if one is available ((w3m-list-buffers) (unless (memq (current-buffer) (w3m-list-buffers)) (w3m-next-buffer -1))) (t ;; If no w3m buffers belong to frame, don't display any w3m buffer (while (eq major-mode 'w3m-mode) ;; (assert (eq (current-buffer) ;; (window-buffer (selected-window)))) (bury-buffer))))) ;; Minor mode setup ;;;###autoload (define-minor-mode w3m-fb-mode "Toggle W3M Frame Buffer mode. This allows frame-local lists of buffers (tabs)." :init-value nil :group 'w3m-fb :global t (if (and w3m-fb-mode (if w3m-pop-up-frames (prog1 (setq w3m-fb-mode nil) (message "\ W3M Frame Buffer mode not activated (non-nil w3m-pop-up-frames)") (sit-for 2)) t)) (progn (add-hook 'w3m-mode-hook 'w3m-fb-add) (add-hook 'kill-buffer-hook 'w3m-fb-remove) (when w3m-fb-delete-frame-kill-buffers (add-hook w3m-fb-delete-frame-functions 'w3m-fb-delete-frame-buffers)) (w3m-fb-associate)) (remove-hook 'w3m-mode-hook 'w3m-fb-add) (remove-hook 'kill-buffer-hook 'w3m-fb-remove) (remove-hook w3m-fb-delete-frame-functions 'w3m-fb-delete-frame-buffers) (w3m-fb-dissociate))) (provide 'w3m-fb) ;;; w3m-fb.el ends here w3m-el-snapshot-1.4.609+0.20171225.orig/.cvsignore0000644000000000000000000000021310043402525017315 0ustar rootroot*.elc Makefile autom4te.cache confdefs.h config.cache config.log config.status* configure emacs-w3m-*.tar.gz patch w3m-kwds.el w3m-load.el w3m-el-snapshot-1.4.609+0.20171225.orig/NEWS0000644000000000000000000002424012764264213016036 0ustar rootrootEmacs-w3m NEWS -- history of user-visible changes. Copyright (C) 2007 TSUCHIYA Masatoshi See the end of the file for license conditions. Please send bug reports to emacs-w3m@namazu.org. If possible, use M-x report-emacs-w3m-bug. This file is about changes in emacs-w3m version 1.5. * Required Emacs version changes ** Emacs-w3m no longer works with old Emacs versions. Now emacs-w3m will hopefully work with Emacs 21.1 or greater, XEmacs 21.4.17 or greater, or XEmacs 21.5-b19 or greater. *** Version-specific modules are now w3m-ems.el and w3m-xmas.el. The modules w3m-e21.el, w3m-e23.el, and w3m-fsf.el have been integrated into w3m-ems.el. *** We can now use shy group in regular expressions. * Appearance changes ** Emacs-w3m can now display italic text. While web pages often use italic text to emphasize words or sentences, emacs-w3m (and w3m) displayed them as normal text formerly. To enable this feature, you need to have w3m 0.5.2 or greater installed. The face used to display italic text is `w3m-italic'. ** Emphasizing of text to display has been much improved. The face attributes including bold, italic, underline, and strike-thru can be overlapped in the same text now. ** Emacs-w3m can now display the uri and the title in the hreader-line. This is controlled by the `w3m-use-header-line-title' variable. ** Emacs-w3m can now use the title of the page as a buffer name. This is controlled by the `w3m-use-title-buffer-name' variable. ** The PNG icon files in addition to the XPM icons are now available. Those are the ones used in the tool bar, are the best suited to Emacs built with GTK. So, emacs-w3m uses them for GTK Emacs by default. Which type of icons to use is controlled by the variable `w3m-toolbar-icon-preferred-image-types'. * Changes in tabs, sessions, and menu ** A handy menu now pops up by clicking mouse-3 on links. It doesn't work on tty of course, though. ** Tabs now have useful menu succeeding to Firefox+TabMixPlus' way. You can pop the menu up by a Mouse-3 click on a tab, and may also see the key bindings of those menu items. The menu is also available in the `Tab' menu in the menu bar. ** You can now use the mouse wheel to manipulate tabs. Rolling the mouse wheel on the tabs line circulates the tabs. In addition to this, pressing the control key while rolling the mouse wheel changes the order of the tabs. ** Emacs-w3m can now create a new session in the background. If this is enabled, the page you instruct emacs-w3m to visit as a new session will not appear unless you select the buffer. This is disabled by default. You can set the `w3m-new-session-in-background' variable to a non-nil value to enable it. ** The w3m menu appears about the middle of the menu bar by default. If you'd like to place it in the leftmost of the menu bar as before, set the `w3m-menu-on-forefront' variable to a non-nil value. * Changes in contents decoding ** Emacs-w3m now uses a superset of the charset the page specifies. For instance, some European web sites sometimes use the `windows-1252' charset for encoding contents even if the page is labeled with `iso-8859-1'. In such a case, emacs-w3m uses `windows-1252', which is a superset of `iso-8859-1', for decoding contents if it is available. The variable `w3m-compatible-encoding-alist' holds the table of charsets and their supersets. ** Emacs-w3m can now follow links containing non-ASCII characters. Emacs-w3m encodes the urls of links whenever retrieving the contents using the charset by which the page containing the links has been encoded. (In shimbun, the charset can be overridden by the `shimbun-url-coding-system' class variable; see below.) ** You can now instruct emacs-w3m how much it decodes html sources. Give a numeric prefix to the `w3m-view-source' command, which is bound to the `\' key. See the doc string of the command for details. ** Emacs-w3m now decodes application/xml pages as text/html. In the case where the page source looks like xhtml+xml. ** Now emacs-w3m trusts the image type gotten from parsing image data. Because the type that web sites specify as the Content-Type header is sometimes bogus. Currently, gif, jpeg, and png types can be identified. * New Lisp modules ** w3m-fb.el -- frame-local buffers support. You can now have several emacs-w3m frames for various purposes. For example, one is for news sites, the other is for search engines. See (info "(emacs-w3m)Frame Local Buffers"). ** w3m-mail.el -- interface to mail-user-agent for sending web pages. You can now mail a web page that you are viewing. The command is `M-x w3m-mail'. Note that you have to have the `mail-user-agent' set properly. ** w3m-session.el -- functions to load/save sessions. You can now save in the file the current session in which you visit several pages. Moreover the last session you use before quitting emacs-w3m will be saved automatically if `w3m-session-autosave' is non-nil (the default). Saved sessions can be loaded afterward. The useful commands are `M-S' for saving and `M-s' for selecting saved ones. Those are available also in the `Session' submenu in the `w3m' menu. * Search engines changes ** Many search engines have been added. See (info "(emacs-w3m)Using Search Engines"). * Changes in filters ** Google searches are prevented from getting corrupted and tidied up. ** Displaying shortened uris for Amazon. ** Support direct access to mixi's diaries being displayed externally. ** Support accessing to the online dictionary Eijiro. * Miscellaneous ** vm-w3m.el has been transferred to the new VM team. It is now in the VM 8.x package. See http://www.nongnu.org/viewmail/. ** Emacs-w3m now allows arbitrary string as a uri. This feature succeeds to Google's `I'm Feeling Lucky', i.e., the string is searched for using Google. The `w3m-enable-google-feeling-lucky' variable controls this feature (enabled by default). ** `w3m-goto-article-function' is now a user option. ** Run XEmacs 21.5 safely. We gave up asynchronous operation when XEmacs 21.5 accesses many pages at a time, in order to prevent it from freezing. ** Prevent the byte compiler from issuing useless warnings. We will continue to do this thoroughly. It makes it easy to find real errors when compiling emacs-w3m. ** The installation directory name is allowed to have spaces and/or tabs. ** We've done many other improvements and bug fixes in this release. (Some of them might cause new bugs, though.) * Shimbun changes ** New shimbun class variable `shimbun-prefer-text-plain'. It controls whether a shimbun module generates text/plain articles or html articles. While the sb-asahi.el module (for example) generates text/plain articles by default, you can tell it to generate html articles by setting the `shimbun-asahi-prefer-text-plain' variable to nil. Oppositely, setting `shimbun-mainichi-prefer-text-plain' to non- nil leads the sb-mainichi.el module to generate text/plain articles while it generates html articles by default. With this feature, sb-asahi-html.el and sb-yomiuri-html.el have been made semi-obsolete. Note that all the shimbun modules don't allow for it. ** Shimbun now supports redirection of urls when fetching articles. Urls that some web sites offer in the index pages are not the ones that point to the article pages directly. The real url for the article is in the page to which such a url points, and it is also likely to require the client to wait for a while (often for displaying ads). Shimbun now examines it and fetches the real article contents with no wait. ** Shimbun can now convert wide non-ASCII characters into Hankaku. English words and numbers displayed with wide (a.k.a. Zenkaku) non- ASCII characters are illegible. Although it is not available in all the shimbun modules, it will be worth trying setting the `shimbun-japanese-hankaku' variable to non-nil. It not only converts wide non-ASCII characters into the normal ones but also performs Wakachi-Gaki (which means separating alphanumeric words and Japanese sentences with space characters). If you want to do it per shimbun server, use `shimbun-SERVER-japanese-hankaku' instead. ** New shimbun class `shimbun-newspaper'. This is used for adding a caution on the copyright to non-Japanese shimbun articles. For Japanese, use `shimbun-japanese-newspaper'. ** New shimbun class variable `shimbun-url-coding-system'. This overrides the charset used for encoding the urls of links which contain non-ASCII letters (by default, the urls of links will be encoded by the charset by which the page containing the links has been encoded). Use the `shimbun-SERVER-url-coding-system' variable per server. ** New shimbun class variable `shimbun-retry-fetching'. When fetching contents of a url fails, shimbun retries it up to that number of times if it is a positive number. Use the variable `shimbun-SERVER-retry-fetching' per server. ** New shimbun modules have been added. sb-aljazeera.el sb-debugmagazin-de.el sb-gendai-net.el sb-nytimes.el sb-ohmynews-jp.el sb-perlentaucher-de.el sb-slashdot.el sb-sueddeutsche-de.el sb-tech-on.el ** Some shimbun modules are being well-maintained but others aren't. Volunteers welcome! *** New variable `nnshimbun-default-group-level' for Gnus. The value of this variable determines the initial group level of a shimbun group that is newly created. The default value is nil, which means that of `gnus-level-default-subscribed' is used. *** New command `gnus-group-make-shimbun-groups' for Gnus. This makes all the shimbun groups a server provides. ---------------------------------------------------------------------- Emacs-w3m 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. Emacs-w3m 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 emacs-w3m; see the file COPYING. If not, write to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. Local variables: mode: outline paragraph-separate: "[ ]*$" end: w3m-el-snapshot-1.4.609+0.20171225.orig/w3m-namazu.el0000644000000000000000000002121113127150703017643 0ustar rootroot;;; w3m-namazu.el --- The add-on program to search files with Namazu. ;; Copyright (C) 2001, 2002, 2003, 2004, 2005, 2007, 2009, 2017 ;; TSUCHIYA Masatoshi ;; Author: TSUCHIYA Masatoshi ;; Keywords: w3m, WWW, hypermedia, namazu ;; 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-namazu.el is the add-on program of emacs-w3m to search files ;; with Namazu. For more detail about emacs-w3m, see: ;; ;; http://emacs-w3m.namazu.org/ ;;; History: ;; Original program was posted by ;; Takayuki Arakawa in [emacs-w3m:01340] at ;; Jul 31, 2001. ;; Many codes are imported from namazu.el written by ;; Yukihiro Matsumoto et al. ;; All stuffs are rewritten by ;; TSUCHIYA Masatoshi at Aug 2, 2001. ;;; Code: (eval-when-compile (require 'cl)) (require 'w3m) (eval-and-compile (autoload 'w3m-search-read-query "w3m-search")) (defgroup w3m-namazu nil "w3m-namazu front-end for Emacs." :group 'w3m :prefix "w3m-namazu-") (defcustom w3m-namazu-command "namazu" "*Name of the executable file of Namazu." :group 'w3m-namazu :type 'string) (defcustom w3m-namazu-arguments '("-h" ; print in HTML format. "-H" ; print further result links. "-n" w3m-namazu-page-max ; set number of documents shown to NUM. "-w" whence) ; set first number of documents shown to NUM. "*Arguments of Namazu." :group 'w3m-namazu :type '(repeat (restricted-sexp :format "Argument: %v\n" :match-alternatives (stringp 'w3m-namazu-page-max 'whence)))) (defcustom w3m-namazu-page-max (if (boundp 'namazu-search-num) (symbol-value 'namazu-search-num) 30) "*A maximum number of documents which are retrieved by one-time search." :group 'w3m-namazu :type 'integer) (defconst w3m-namazu-default-index-customize-spec '`(choice (const :tag "No default index" nil) ,@(mapcar (lambda (x) (list 'const (car x))) w3m-namazu-index-alist) (directory :format "Index directory: %v\n"))) (defcustom w3m-namazu-index-alist (when (boundp 'namazu-dir-alist) (mapcar (lambda (pair) (cons (car pair) (split-string (cdr pair)))) (symbol-value 'namazu-dir-alist))) "*Alist of alias and index directories." :group 'w3m-namazu :type '(repeat (group :indent 0 :inline t (cons :format "%v" (string :format "Alias: %v\n") (repeat :format "%v%i\n" :indent 8 (directory :format "Index directory: %v\n"))))) :set (lambda (symbol value) (custom-set-default symbol value) (put 'w3m-namazu-default-index 'custom-type (eval w3m-namazu-default-index-customize-spec)))) (defcustom w3m-namazu-default-index (unless (and (boundp 'namazu-always-query-index-directory) (symbol-value 'namazu-always-query-index-directory)) (when (boundp 'namazu-default-dir) (symbol-value 'namazu-default-dir))) "*Alias or directory of the default index. If this variable equals nil, it is required to input an index path whenever `w3m-namazu' is called interactively without prefix argument." :group 'w3m-namazu :type (eval w3m-namazu-default-index-customize-spec)) (defcustom w3m-namazu-output-coding-system (if (boundp 'namazu-cs-write) (symbol-value 'namazu-cs-write) (if (memq system-type '(OS/2 emx windows-nt)) 'shift_jis-dos 'euc-japan-unix)) "*Coding system for namazu process." :group 'w3m-namazu :type 'coding-system) (defcustom w3m-namazu-input-coding-system (if (boundp 'namazu-cs-read) (symbol-value 'namazu-cs-read) 'undecided) "*Coding system for namazu process." :group 'w3m-namazu :type 'coding-system) (defun w3m-namazu-call-process (index query whence) (setq index (if (assoc index w3m-namazu-index-alist) (mapcar 'expand-file-name (cdr (assoc index w3m-namazu-index-alist))) (list (expand-file-name index)))) (let ((file-name-coding-system w3m-file-name-coding-system) (coding-system-for-read w3m-namazu-input-coding-system) (coding-system-for-write w3m-namazu-output-coding-system) (default-process-coding-system (cons w3m-namazu-input-coding-system w3m-namazu-output-coding-system))) (apply 'call-process w3m-namazu-command nil t nil (let ((w3m-namazu-page-max (number-to-string w3m-namazu-page-max))) (nconc (mapcar 'eval w3m-namazu-arguments) (list query) index))))) ;;;###autoload (defun w3m-about-namazu (url &optional no-decode no-cache &rest args) (let (index query (whence "0")) (when (string-match "\\`about://namazu/\\?" url) (dolist (s (split-string (substring url (match-end 0)) "&")) (when (string-match "\\`\\(?:index\\|\\(query\\)\\|\\(whence\\)\\)=" s) (set (cond ((match-beginning 1) 'query) ((match-beginning 2) 'whence) (t 'index)) (substring s (match-end 0))))) (when (zerop (w3m-namazu-call-process (w3m-url-decode-string index) (w3m-url-decode-string query) whence)) (let ((case-fold-search t)) (goto-char (point-min)) (let ((max (if (re-search-forward "\\([0-9]+\\)" nil t) (string-to-number (match-string 1)) 0)) (cur (string-to-number whence))) (goto-char (point-min)) (when (search-forward "" nil t) (when (> cur 0) (insert (format " " index query (max (- cur w3m-namazu-page-max) 0)))) (when (> max (+ cur w3m-namazu-page-max)) (insert (format " " index query (+ cur w3m-namazu-page-max)))))) (goto-char (point-min)) (while (search-forward " ;; Authors: Hideyuki SHIRAI , ;; 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: ;; This file contains the functions for TAB browsing. For more detail ;; about emacs-w3m, see: ;; ;; http://emacs-w3m.namazu.org/ ;;; Code: (eval-when-compile (require 'cl)) (require 'w3m-util) (require 'w3m) (require 'easymenu) (defun w3m-setup-tab-menu () "Setup w3m tab menubar." (when w3m-use-tab-menubar (w3m-static-if (featurep 'xemacs) (unless (car (find-menu-item current-menubar '("Tab"))) (easy-menu-define w3m-tab-menu w3m-mode-map "" '("Tab" ["dummy" w3m-switch-buffer t])) (easy-menu-add w3m-tab-menu) (add-hook 'activate-menubar-hook 'w3m-tab-menubar-update)) (unless (lookup-key w3m-mode-map [menu-bar Tab]) (easy-menu-define w3m-tab-menu w3m-mode-map "" '("Tab")) (easy-menu-add w3m-tab-menu) (add-hook 'menu-bar-update-hook 'w3m-tab-menubar-update))))) (defun w3m-switch-buffer () "Switch `w3m-mode' buffer in the current window." (interactive) (let ((items (w3m-tab-menubar-make-items 'nomenu)) (minibuffer-setup-hook (append minibuffer-setup-hook '(beginning-of-line))) (count 1) (form "%s [%s]") (completion-ignore-case t) comp hist histlen default buf) (dolist (item items) (when (nth 2 item) ;; current-buffer (setq default count)) (setq comp (cons (cons (format form (nth 1 item) (nth 0 item)) (nth 0 item)) comp)) (setq hist (cons (format form (nth 1 item) (nth 0 item)) hist)) (setq count (1+ count))) (setq comp (nreverse comp)) (setq histlen (length hist)) (setq hist (append hist hist hist hist hist)) ;; STARTPOS at 3rd hist (setq buf (completing-read "Switch to w3m buffer: " comp nil t (car (nth (1- default) comp)) (cons 'hist (+ (* 3 histlen) (- histlen default -1))) (car (nth (1- default) comp)))) (setq buf (cdr (assoc buf comp))) (when (get-buffer buf) (switch-to-buffer buf)))) (defun w3m-tab-menubar-open-item (buf) "Open w3m buffer from tab menubar." (interactive) (when (get-buffer buf) (switch-to-buffer buf))) (defun w3m-tab-menubar-update () "Update w3m tab menubar." (when (and (eq major-mode 'w3m-mode) (w3m-static-if (featurep 'xemacs) (frame-property (selected-frame) 'menubar-visible-p) menu-bar-mode)) (easy-menu-define w3m-tab-menu w3m-mode-map "The menu kepmap for the emacs-w3m tab." (cons "Tab" (w3m-tab-menubar-make-items))) (w3m-static-when (featurep 'xemacs) (let ((items (car (find-menu-item current-menubar '("Tab"))))) (when items (setcdr items (cdr w3m-tab-menu)) (set-buffer-menubar current-menubar)))))) (defvar w3m-tab-menubar-items-sub-coeff 30) ;; 30? (defvar w3m-tab-menubar-items-width 50) ;; 50? (defun w3m-tab-menubar-make-items-1 (buffers &optional nomenu) (let ((i 0) (current (current-buffer)) (width w3m-tab-menubar-items-width) title unseen) (mapcar (lambda (buffer) (if nomenu (list (buffer-name buffer) (format "%s%s" (if (w3m-unseen-buffer-p buffer) "(u)" "") (w3m-buffer-title buffer)) (eq buffer current)) (setq title (w3m-buffer-title buffer)) (setq unseen (w3m-unseen-buffer-p buffer)) (when (>= (string-width title) width) (setq title (concat (w3m-truncate-string title (- width 3)) "..."))) (vector (format "%d:%s%s" (incf i) (cond ((eq buffer current) "* ") (unseen "u ") (t " ")) title) `(w3m-tab-menubar-open-item ,(buffer-name buffer)) buffer))) buffers))) (defvar w3m-tab-menubar-make-items-precbuf nil) (defvar w3m-tab-menubar-make-items-prebuflst nil) (defvar w3m-tab-menubar-make-items-preurl nil) (defvar w3m-tab-menubar-make-items-preitems nil) (defun w3m-tab-menubar-force-update (&rest args) (setq w3m-tab-menubar-make-items-preitems nil) (w3m-tab-menubar-update)) (add-hook 'w3m-display-functions 'w3m-tab-menubar-force-update) (defun w3m-tab-menubar-make-items (&optional nomenu) "Create w3m tab menu items." (let (menu buflst total max) (if nomenu (w3m-tab-menubar-make-items-1 (w3m-list-buffers) t) (setq w3m-tab-button-menu-current-buffer (current-buffer)) (setq buflst (w3m-list-buffers)) (if (and w3m-tab-menubar-make-items-preitems (eq w3m-tab-button-menu-current-buffer w3m-tab-menubar-make-items-precbuf) (equal w3m-tab-menubar-make-items-prebuflst buflst) (equal w3m-tab-menubar-make-items-preurl w3m-current-url)) w3m-tab-menubar-make-items-preitems (setq w3m-tab-menubar-make-items-precbuf w3m-tab-button-menu-current-buffer) (setq w3m-tab-menubar-make-items-prebuflst buflst) (setq w3m-tab-menubar-make-items-preurl w3m-current-url) (setq total (length buflst)) (setq max (- (frame-height (selected-frame)) w3m-tab-menubar-items-sub-coeff)) (if (< total max) (setq menu (w3m-tab-menubar-make-items-1 buflst)) (setq menu (list `(,(w3m-make-menu-item "$B%?%V$NA*Br(B" "Select TAB") ,@(w3m-tab-menubar-make-items-1 buflst))))) (setq w3m-tab-menubar-make-items-preitems (append menu '("-") '("-") (w3m-make-menu-commands w3m-tab-button-menu-commands))))))) (provide 'w3m-tabmenu) ;;; w3m-tabmenu.el ends here w3m-el-snapshot-1.4.609+0.20171225.orig/w3m-favicon.el0000644000000000000000000003124613127150703020006 0ustar rootroot;;; w3m-favicon.el --- utilities for handling favicon in emacs-w3m ;; Copyright (C) 2001-2005, 2007, 2009, 2011, 2017 ;; TSUCHIYA Masatoshi ;; Authors: Yuuichi Teranishi , ;; TSUCHIYA Masatoshi , ;; 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: ;;; Code: (eval-when-compile (require 'cl)) ;;(require 'w3m-util) ;;(require 'w3m-proc) (require 'w3m-image) (eval-when-compile (defvar w3m-current-buffer) (defvar w3m-current-url) (defvar w3m-favicon-image) (defvar w3m-icon-data) (defvar w3m-modeline-favicon) (defvar w3m-profile-directory) (defvar w3m-use-favicon) (defvar w3m-work-buffer-name) (defvar w3m-work-buffer-list) (autoload 'w3m-expand-url "w3m") (autoload 'w3m-load-list "w3m") (autoload 'w3m-message "w3m") (autoload 'w3m-retrieve "w3m") (autoload 'w3m-save-list "w3m") (autoload 'w3m-url-readable-string "w3m")) (defcustom w3m-favicon-size nil "Size of favicon. The value should be `(WIDTH . HEIGHT)' or nil. Where WIDTH and HEIGHT are positive integers; both or any of them can be omitted." :group 'w3m :type '(radio (const :tag "Not specified" nil) (cons :format "%v" (integer :format "Width: %v " :value 16) (integer :format "Height: %v " :value 16)))) (defconst w3m-favicon-name "favicon.ico" "The favicon name.") (add-hook 'w3m-display-functions 'w3m-favicon-setup) (defcustom w3m-favicon-use-cache-file nil "*If non-nil, use favicon cache file." :group 'w3m :type 'boolean) (defcustom w3m-favicon-cache-file nil "Filename of saving favicon cache. It defaults to the file named \".favicon\" under the directory specified by the `w3m-profile-directory' variable." :group 'w3m :type '(radio (const :format "Not specified\n") (file :format "%t: %v\n"))) (defcustom w3m-favicon-cache-expire-wait (* 30 24 60 60) "*The cache will be expired after specified seconds passed since retrieval. If this variable is nil, never expired." :group 'w3m :type 'integer) (defcustom w3m-favicon-type (let ((types '(gif png pbm xpm bmp)) type) (catch 'det (while types (setq type (car types) types (cdr types)) (if (if (featurep 'xemacs) (featurep type) ;; Silence SXEmacs 22.1.14's byte compiler. (eval (list 'image-type-available-p (list 'quote type)))) (throw 'det type))))) "*Image type of display favicon." :group 'w3m :type (cons 'radio (let ((types (if (or (featurep 'xemacs) (not (fboundp 'image-types))) (delq nil (mapcar (lambda (type) (if (featurep type) type)) '(gif jpeg png tiff xpm))) (delq 'postscript (copy-sequence image-types))))) (nconc (mapcar (lambda (x) `(const :format "%v " ,x)) (butlast types)) `((const ,(car (last types)))))))) (defcustom w3m-space-before-favicon " " "String of space char(s) to be put in front of favicon in the mode-line. It may be better to use two or more spaces if you are using oblique or italic font in the modeline." :group 'w3m :type 'string) (defcustom w3m-favicon-convert-args nil "List of additional arguments passed to ImageMagick's convert program. Args that are always passed to convert in addition to this value are: \(\"-geometry\" \"WIDTHxHEIGHT\" \"fromTYPE:temp-file\" \"toTYPE:-\") Args might also contain (\"-transparent\" \"COLOR\") in the beginning. Note that this value is effective only with Emacs 22 and greater." :group 'w3m :type `(repeat (group :inline t :match-inline (lambda (widget vals) (if (and (eq (aref (car vals) 0) ?-) (cdr vals) (not (eq (aref (nth 1 vals) 0) ?-))) (cons (list (car vals) (nth 1 vals)) (nthcdr 2 vals)) (cons (list (car vals)) (cdr vals)))) (string :format "Arg: %v " :value "-") (checklist :inline t (string :format "Value: %v\n"))))) (defcustom w3m-favicon-default-background nil "Color name used as transparent color of favicon image. Nil means to use the background color of the Emacs frame. The null string \"\" is special, that will be replaced with the background color of the header line or the mode line on which the favicon is displayed. Note that this value is effective only with Emacs 22 and greater." :group 'w3m :type '(radio (string :format "Color: %v\n" :match (lambda (widget value) (and (stringp value) (> (length value) 0)))) (const :tag "Use the background color of the Emacs frame" nil) (const :tag "Null string" ""))) (defvar w3m-favicon-type-alist '((pbm . ppm)) "A list of a difference type of image between Emacs and ImageMagick. 0. Type of Emacs 1. Type of ImageMagick") (defvar w3m-favicon-cache-data nil "A list of favicon cache (internal variable). Each information is a list whose elements are: 0. URL 1. (RAW_DATA . TYPE) 2. DATE when the RAW_DATA was retrieved 3. IMAGE Where IMAGE highly depends on the Emacs version and is not saved in the cache file.") (w3m-static-if (featurep 'xemacs) (set 'w3m-modeline-favicon '("" w3m-space-before-favicon w3m-favicon-image)) (put 'w3m-modeline-favicon 'risky-local-variable t)) (make-variable-buffer-local 'w3m-modeline-favicon) (make-variable-buffer-local 'w3m-favicon-image) (defmacro w3m-favicon-cache-p (url) "Say whether the favicon data for URL has been chached." `(assoc ,url w3m-favicon-cache-data)) (defmacro w3m-favicon-cache-favicon (url) "Pull out the favicon image corresponding to URL from the cache." `(nth 3 (assoc ,url w3m-favicon-cache-data))) (defmacro w3m-favicon-cache-retrieved (url) "Return the time when the favicon data for URL was retrieved." `(nth 2 (assoc ,url w3m-favicon-cache-data))) (defmacro w3m-favicon-set-image (image) "Set IMAGE to `w3m-favicon-image' and `w3m-modeline-favicon'." (if (featurep 'xemacs) `(set 'w3m-favicon-image ,image) `(when (setq w3m-favicon-image ,image) (set 'w3m-modeline-favicon (list "" 'w3m-space-before-favicon (propertize " " 'display w3m-favicon-image) (propertize " " 'display '(space :width 0.5))))))) (defun w3m-favicon-setup (url) "Set up the favicon data in the current buffer. The buffer-local variable `w3m-favicon-image' will be set to non-nil value when the favicon is ready." (w3m-favicon-set-image nil) (when (and w3m-use-favicon w3m-current-url (w3m-static-if (featurep 'xemacs) (and (device-on-window-system-p) (featurep w3m-favicon-type)) (and (display-images-p) (image-type-available-p w3m-favicon-type)))) (let (icon) (cond ((and (string-match "\\`about://\\([^/]+\\)/" url) (setq icon (intern-soft (concat "w3m-about-" (match-string 1 url) "-favicon")))) (with-current-buffer w3m-current-buffer (w3m-favicon-set-image (w3m-favicon-convert (base64-decode-string (symbol-value icon)) 'ico)))) ((or (string-match "\\`https?://" url) (and (string-match "\\`about://\\(?:header\\|source\\)/https?://" url) (setq url (substring url 15)))) (if w3m-icon-data (w3m-favicon-retrieve (car w3m-icon-data) (cdr w3m-icon-data) w3m-current-buffer) (w3m-favicon-retrieve (w3m-expand-url (concat "/" w3m-favicon-name) url) 'ico w3m-current-buffer))))))) (defun w3m-favicon-convert (data type) "Convert the favicon DATA in TYPE to the favicon image and return it." (when (or (not (eq type 'ico)) ;; Is it really in the ico format? (string-equal "\x00\x00\x01\x00" (substring data 0 4)) ;; Some icons named favicon.ico are animated GIFs. (and (member (substring data 0 5) '("GIF87" "GIF89")) (setq type 'gif))) (let ((height (or (cdr w3m-favicon-size) (w3m-static-if (featurep 'xemacs) (face-height 'default) (frame-char-height)))) (new (w3m-static-unless (featurep 'xemacs) (>= emacs-major-version 22))) bg args img) ;; Examine the transparent color of the image. (when (and w3m-imagick-identify-program (equal w3m-favicon-default-background "")) (with-temp-buffer (set-buffer-multibyte nil) (insert data) (let ((coding-system-for-read 'raw-text) (coding-system-for-write 'binary)) (condition-case nil (call-process-region (point-min) (point-max) w3m-imagick-identify-program t t nil "-verbose" (format "%s:-" type)) (error))) (goto-char (point-min)) (setq case-fold-search t) (while (and (not bg) (re-search-forward "^ *Transparent +color: *\ \\([^\n ]+\\(?: +[^\n ]+\\)*\\)" nil t)) (when (string-match "\\`none\\'" (setq bg (match-string 1))) (setq bg nil))))) (setq args (list "-geometry" (format "%dx%d" (or (car w3m-favicon-size) height) height))) (w3m-static-unless (featurep 'xemacs) (when new ;; "-transparent" should precede the other arguments. (setq args (nconc (when bg (list "-transparent" bg)) args w3m-favicon-convert-args)))) (setq img (apply #'w3m-imagick-convert-data data (symbol-name type) (symbol-name (or (cdr (assq w3m-favicon-type w3m-favicon-type-alist)) w3m-favicon-type)) args)) (when img (w3m-static-if (featurep 'xemacs) (make-glyph (make-image-instance (vector w3m-favicon-type :data img))) (if new (create-image img w3m-favicon-type t :ascent 'center :background w3m-favicon-default-background) (create-image img w3m-favicon-type t :ascent 'center))))))) (defun w3m-favicon-retrieve (url type target) "Retrieve favicon from URL and convert it to image as TYPE in TARGET. TYPE is a symbol like `ico' and TARGET is a buffer where the image is stored in the `w3m-favicon-image' buffer-local variable." (if (and (w3m-favicon-cache-p url) (or (null w3m-favicon-cache-expire-wait) (< (- (w3m-float-time) (w3m-float-time (w3m-favicon-cache-retrieved url))) w3m-favicon-cache-expire-wait))) (with-current-buffer target (w3m-favicon-set-image (w3m-favicon-cache-favicon url))) (lexical-let ((url url) (type type) (target target) (silent w3m-message-silent)) (w3m-process-with-null-handler (w3m-process-do-with-temp-buffer (ok (w3m-retrieve url 'raw nil nil nil handler)) (let ((w3m-message-silent silent) idata image) (if (and ok ;; Some broken servers provides empty contents. (>= (buffer-size) 4)) (setq idata (buffer-string) image (w3m-favicon-convert idata type)) (w3m-message "Reading %s...done (no favicon)" (w3m-url-readable-string url))) (with-current-buffer target (w3m-favicon-set-image image) (push (list url idata (current-time) w3m-favicon-image) w3m-favicon-cache-data))))))) ;; Emacs frame needs to be redisplayed to make favicon come out. (w3m-force-window-update-later target 1)) (defun w3m-favicon-save-cache-file () "Save the cached favicon data into the local file." (when w3m-favicon-use-cache-file (w3m-save-list (or w3m-favicon-cache-file (expand-file-name ".favicon" w3m-profile-directory)) (delq nil (mapcar (lambda (elem) (when (= (length elem) 4) (butlast elem))) w3m-favicon-cache-data)) 'binary))) (defun w3m-favicon-load-cache-file () "Load the cached favicon data from the local file." (when (and w3m-favicon-use-cache-file (null w3m-favicon-cache-data)) (let ((cache (w3m-load-list (or w3m-favicon-cache-file (expand-file-name ".favicon" w3m-profile-directory)) 'binary)) elem data image) (while cache (setq elem (car cache) cache (cdr cache) data (cadr elem)) (when (stringp data) (setcar (cdr elem) (setq data (cons data 'ico)))) (when (setq image (condition-case nil (w3m-favicon-convert (car data) (cdr data)) (error nil))) (push (nconc elem (list image)) w3m-favicon-cache-data)))))) (add-hook 'w3m-arrived-setup-functions 'w3m-favicon-load-cache-file) (add-hook 'w3m-arrived-shutdown-functions 'w3m-favicon-save-cache-file) (provide 'w3m-favicon) ;;; w3m-favicon.el ends here w3m-el-snapshot-1.4.609+0.20171225.orig/Makefile.in0000644000000000000000000002124312632267727017413 0ustar rootrootINSTALL = @INSTALL@ INSTALL_DATA = @INSTALL_DATA@ prefix = @prefix@ datarootdir = @datarootdir@ datadir = @datadir@ infodir = @infodir@ lispdir = @lispdir@ srcdir = @srcdir@ PACKAGEDIR = @PACKAGEDIR@ ICONDIR = @ICONDIR@ ADDITIONAL_LOAD_PATH = @ADDITIONAL_LOAD_PATH@ GZIP_PROG = @GZIP_PROG@ COMPRESS_INSTALL = @COMPRESS_INSTALL@ SHELL = /bin/sh @SET_MAKE@ EMACS = @EMACS@ VANILLA_FLAG = @VANILLA_FLAG@ FLAGS = $(VANILLA_FLAG) -batch -l $(srcdir)/w3mhack.el '$(ADDITIONAL_LOAD_PATH)' ## This is used to set the environment variable XEMACSDEBUG for XEmacs ## 21.5 in order to suppress warnings for Lisp shadows when XEmacs 21.5 ## starts. This is used also for not installing w3m-ems.el for XEmacs ## and w3m-xmas.el for GNU Emacs. XEMACSDEBUG = @XEMACSDEBUG@ IGNORES = w3mhack.el PACKAGE = emacs-w3m TARBALL = $(PACKAGE)-$(VERSION).tar.gz DISTDIR = $(PACKAGE)-$(VERSION) default: all all: lisp info all-en: lisp info-en all-ja: lisp info-ja lisp: Makefile env test ! -f w3m-util.elc -o w3m-util.elc -nt w3m-util.el || $(MAKE) clean env test ! -f w3m-proc.elc -o w3m-proc.elc -nt w3m-proc.el || $(MAKE) clean $(XEMACSDEBUG) '$(EMACS)' $(FLAGS) -f w3mhack-compile # `w3mhack-what-where' respects DESTDIR what-where: @$(XEMACSDEBUG) '$(EMACS)' $(FLAGS) -f w3mhack-what-where\ '$(lispdir)' '$(ICONDIR)' '$(PACKAGEDIR)' '$(infodir)' info: cd doc && $(MAKE) EMACS="$(EMACS)" info-en: cd doc && $(MAKE) EMACS="$(EMACS)" en info-ja: cd doc && $(MAKE) EMACS="$(EMACS)" ja install: install-lisp install-info install-en: install-lisp install-info-en install-ja: install-lisp install-info-ja install-lisp: lisp @$(SHELL) $(srcdir)/mkinstalldirs "$(DESTDIR)$(lispdir)";\ for p in ChangeLog ChangeLog.[1-9] ChangeLog.[1-9][0-9] *.el; do\ if test -f "$$p"; then\ case "$$p" in\ $(IGNORES)) ;;\ w3m-ems\.el) if test -z "$(XEMACSDEBUG)"; then\ echo "$(INSTALL_DATA) $$p \"$(DESTDIR)$(lispdir)/$$p\"";\ $(INSTALL_DATA) $$p "$(DESTDIR)$(lispdir)/$$p"; fi;;\ w3m-xmas\.el) if test -n "$(XEMACSDEBUG)"; then\ echo "$(INSTALL_DATA) $$p \"$(DESTDIR)$(lispdir)/$$p\"";\ $(INSTALL_DATA) $$p "$(DESTDIR)$(lispdir)/$$p"; fi;;\ *) echo "$(INSTALL_DATA) $$p \"$(DESTDIR)$(lispdir)/$$p\"";\ $(INSTALL_DATA) $$p "$(DESTDIR)$(lispdir)/$$p";;\ esac;\ if test $(COMPRESS_INSTALL) = yes -a -n "$(GZIP_PROG)"\ -a -f "$$p"c -a -f "$(DESTDIR)$(lispdir)/$$p"; then\ rm -f "$(DESTDIR)$(lispdir)/$$p".gz;\ "$(GZIP_PROG)" -9n "$(DESTDIR)$(lispdir)/$$p";\ fi;\ fi;\ done;\ for p in *.elc; do\ if test -f "$$p"; then\ echo "$(INSTALL_DATA) $$p \"$(DESTDIR)$(lispdir)/$$p\"";\ $(INSTALL_DATA) $$p "$(DESTDIR)$(lispdir)/$$p";\ fi;\ done;\ if test -f shimbun/shimbun.elc; then\ for p in `cd shimbun && echo ChangeLog ChangeLog.[1-9] ChangeLog.[1-9][0-9]`; do\ if test -f "shimbun/$$p"; then\ echo "$(INSTALL_DATA) shimbun/$$p \"$(DESTDIR)$(lispdir)/s$$p\"";\ $(INSTALL_DATA) shimbun/$$p "$(DESTDIR)$(lispdir)/s$$p";\ fi;\ done;\ for p in `cd shimbun && echo *.el`; do\ echo "$(INSTALL_DATA) shimbun/$$p \"$(DESTDIR)$(lispdir)/$$p\"";\ $(INSTALL_DATA) shimbun/$$p "$(DESTDIR)$(lispdir)/$$p";\ if test $(COMPRESS_INSTALL) = yes -a -n "$(GZIP_PROG)"\ -a -f "shimbun/$$p"c; then\ rm -f "$(DESTDIR)$(lispdir)/$$p".gz;\ "$(GZIP_PROG)" -9n "$(DESTDIR)$(lispdir)/$$p";\ fi;\ done;\ for p in `cd shimbun && echo *.elc`; do\ echo "$(INSTALL_DATA) shimbun/$$p \"$(DESTDIR)$(lispdir)/$$p\"";\ $(INSTALL_DATA) shimbun/$$p "$(DESTDIR)$(lispdir)/$$p";\ done;\ fi install-icons: @if test "$(ICONDIR)" = NONE; then\ echo "You don't have to install icon files for \"$(EMACS)\".";\ else\ $(SHELL) $(srcdir)/mkinstalldirs "$(DESTDIR)$(ICONDIR)";\ for i in `cd icons && echo *.gif *.png *.xpm`; do\ echo "$(INSTALL_DATA) icons/$$i \"$(DESTDIR)$(ICONDIR)/$$i\"";\ $(INSTALL_DATA) icons/$$i "$(DESTDIR)$(ICONDIR)/$$i";\ done;\ fi install-icons30: @if test "$(ICONDIR)" = NONE; then\ echo "You don't have to install icon files for \"$(EMACS)\".";\ else\ $(SHELL) $(srcdir)/mkinstalldirs "$(DESTDIR)$(ICONDIR)";\ for i in `cd icons30 && echo *.gif *.png *.xpm`; do\ echo "$(INSTALL_DATA) icons30/$$i \"$(DESTDIR)$(ICONDIR)/$$i\"";\ $(INSTALL_DATA) icons30/$$i "$(DESTDIR)$(ICONDIR)/$$i";\ done;\ fi install-info: info @echo "cd doc && $(MAKE) EMACS=\"$(EMACS)\" infodir=\"$(DESTDIR)$(infodir)\" install";\ cd doc && $(MAKE) EMACS="$(EMACS)" infodir="$(infodir)" install install-info-en: info-en @echo "cd doc && $(MAKE) EMACS=\"$(EMACS)\" infodir=\"$(DESTDIR)$(infodir)\" install-en";\ cd doc && $(MAKE) EMACS="$(EMACS)" infodir="$(infodir)" install-en install-info-ja: info-ja @echo "cd doc && $(MAKE) EMACS=\"$(EMACS)\" infodir=\"$(DESTDIR)$(infodir)\" install-ja";\ cd doc && $(MAKE) EMACS="$(EMACS)" infodir="$(infodir)" install-ja install-package: @if test $(PACKAGEDIR) = NONE; then\ echo "What a pity! Your \"$(EMACS)\" does not support"\ "the package system.";\ else\ $(MAKE) lispdir="$(PACKAGEDIR)/lisp/w3m" install-lisp;\ $(MAKE) ICONDIR="$(PACKAGEDIR)/etc/images/w3m" install-icons30;\ $(MAKE) infodir="$(PACKAGEDIR)/info" install-info;\ echo $(XEMACSDEBUG) \'$(EMACS)\' $(FLAGS) -f w3mhack-make-package $(DESTDIR)$(PACKAGEDIR);\ $(XEMACSDEBUG) '$(EMACS)' $(FLAGS) -f w3mhack-make-package $(DESTDIR)$(PACKAGEDIR);\ fi install-package-ja: @if test $(PACKAGEDIR) = NONE; then\ echo "What a pity! Your \"$(EMACS)\" does not support"\ "the package system.";\ else\ $(MAKE) lispdir="$(PACKAGEDIR)/lisp/w3m" install-lisp;\ $(MAKE) ICONDIR="$(PACKAGEDIR)/etc/images/w3m" install-icons30;\ $(MAKE) infodir="$(PACKAGEDIR)/info" install-info-ja;\ echo $(XEMACSDEBUG) \'$(EMACS)\' $(FLAGS) -f w3mhack-make-package $(DESTDIR)$(PACKAGEDIR);\ $(XEMACSDEBUG) '$(EMACS)' $(FLAGS) -f w3mhack-make-package $(DESTDIR)$(PACKAGEDIR);\ fi Makefile: Makefile.in config.status $(srcdir)/config.status config.status: configure $(srcdir)/config.status --recheck configure: configure.in aclocal.m4 autoconf dist: Makefile w3m.elc $(MAKE) tarball \ VERSION=`$(XEMACSDEBUG) '$(EMACS)' $(FLAGS) -f w3mhack-version 2>/dev/null` \ BRANCH=`cvs status Makefile.in|grep "Sticky Tag:"|awk '{print $$3}'|sed 's,(none),HEAD,'` tarball: CVS/Root CVS/Repository -rm -rf $(DISTDIR) $(TARBALL) `basename $(TARBALL) .gz` cvs -d `cat CVS/Root` -w export -d $(DISTDIR) -r $(BRANCH) `cat CVS/Repository` -cvs diff |( cd $(DISTDIR) && patch -p0 ) for f in BUGS.ja; do\ if [ -f $(DISTDIR)/$${f} ]; then\ rm -f $(DISTDIR)/$${f} || exit 1;\ fi;\ done find $(DISTDIR) -name .cvsignore | xargs rm -f find $(DISTDIR) -type d | xargs chmod 755 find $(DISTDIR) -type f | xargs chmod 644 cd $(DISTDIR) && autoconf chmod 755 $(DISTDIR)/configure $(DISTDIR)/install-sh tar -cf `basename $(TARBALL) .gz` $(DISTDIR) "$(GZIP_PROG)" -9 `basename $(TARBALL) .gz` rm -rf $(DISTDIR) clean: -rm -rf $(PACKAGE)* ;\ rm -f *~ *.elc shimbun/*.elc w3m-load.el ;\ rm -f doc/*~ doc/*.info doc/*.info-[0-9] doc/*.info-[0-9][0-9]\ doc/version.texi distclean: clean -rm -f config.log config.status config.cache Makefile doc/Makefile;\ rm -fr autom4te*.cache ## Rules for the developers to check the portability for each module. .SUFFIXES: .elc .el .el.elc: @echo $(XEMACSDEBUG) \'$(EMACS)\' $(FLAGS) -f batch-byte-compile $*.el;\ $(XEMACSDEBUG) '$(EMACS)' $(FLAGS) -f batch-byte-compile $*.el slow: Makefile @for i in `$(XEMACSDEBUG) '$(EMACS)' $(FLAGS) -f w3mhack-examine-modules 2>/dev/null`;\ do $(MAKE) -s $$i; done very-slow: clean Makefile @args="$(VANILLA_FLAG) -batch";\ args="$$args -l $(srcdir)/attic/addpath.el '$(ADDITIONAL_LOAD_PATH)'";\ echo "=============================================";\ echo "Compiling the 1st stage-----without elc files";\ echo "=============================================";\ for i in `$(XEMACSDEBUG) '$(EMACS)' $(FLAGS) -f w3mhack-examine-modules 2>/dev/null`;\ do\ j=`echo $$i| sed 's/elc$$/el/g'`;\ echo $(XEMACSDEBUG) \'$(EMACS)\' ARGS -f batch-byte-compile $$j;\ $(XEMACSDEBUG) '$(EMACS)' $$args -f batch-byte-compile $$j;\ mv $$i $$j"x";\ done;\ for i in `echo *.elx shimbun/*.elx`; do\ j=`echo $$i| sed 's/elx$$/elc/g'`;\ if test -f $$i; then mv $$i $$j; fi;\ done;\ echo "==============================================";\ echo "Compiling the 2nd stage-----with all elc files";\ echo "==============================================";\ for i in `$(XEMACSDEBUG) '$(EMACS)' $(FLAGS) -f w3mhack-examine-modules 2>/dev/null`;\ do\ j=`echo $$i| sed 's/elc$$/el/g'`;\ echo $(XEMACSDEBUG) \'$(EMACS)\' ARGS -f batch-byte-compile $$j;\ $(XEMACSDEBUG) '$(EMACS)' $$args -f batch-byte-compile $$j;\ done w3m-el-snapshot-1.4.609+0.20171225.orig/w3m-util.el0000644000000000000000000017300713213222142017331 0ustar rootroot;;; w3m-util.el --- Utility macros and functions for emacs-w3m ;; Copyright (C) 2001-2014, 2016, 2017 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 utility macros ;; and inline functions. Visit for ;; more details of emacs-w3m. ;;; Code: (eval-when-compile (require 'cl)) ;; Variables and functions which are used in the following inline ;; functions. They should be defined in the other module at run-time. (eval-when-compile (defvar w3m-current-process) (defvar w3m-current-refresh) (defvar w3m-current-title) (defvar w3m-current-url) (defvar w3m-fb-list-buffers-frame) (defvar w3m-fb-mode) (defvar w3m-mode-hook) (defvar w3m-pop-up-frames) (defvar w3m-pop-up-windows) (defvar w3m-popup-frame-parameters) (defvar w3m-refresh-timer) (defvar w3m-select-buffer-name) (defvar w3m-use-refresh) (defvar w3m-use-tab) (defvar w3m-work-buffer-list) (defvar w3m-use-japanese-menu) (defvar w3m-mode-map) (defvar w3m-use-title-buffer-name) (defvar w3m-buffer-unseen) (defvar w3m-puny-utf-16be) (unless (fboundp 'select-frame-set-input-focus) (defalias 'select-frame-set-input-focus 'ignore))) (eval-and-compile (when (featurep 'xemacs) (require 'poe) (require 'poem))) ;;; Things should be defined in advance: (eval-when-compile (autoload 'w3m-detect-coding-region (if (featurep 'emacs) "w3m-ems" "w3m-xmas")) (autoload 'w3m-fb-frame-parameter "w3m-fb") (autoload 'w3m-history-restore-position "w3m-hist" nil t)) ;; XEmacs 21.4 wants this. (defalias 'w3m-make-local-hook (if (featurep 'xemacs) 'make-local-hook 'ignore)) ;;; Control structures: (defmacro w3m-static-if (cond then &rest else) "Like `if', except that it evaluates COND at compile-time." (if (eval cond) then `(progn ,@else))) (put 'w3m-static-if 'lisp-indent-function 2) (def-edebug-spec w3m-static-if (&rest def-form)) (put 'w3m-static-when 'lisp-indent-function 1) (defmacro w3m-static-when (cond &rest body) "Like `when', but evaluate COND at compile time." (if (eval cond) `(progn ,@body))) (def-edebug-spec w3m-static-when (&rest def-form)) (put 'w3m-static-unless 'lisp-indent-function 1) (defmacro w3m-static-unless (cond &rest body) "Like `unless', but evaluate COND at compile time." (if (eval cond) nil `(progn ,@body))) (def-edebug-spec w3m-static-unless (&rest def-form)) (defmacro w3m-static-cond (&rest clauses) "Like `cond', except that it evaluates CONDITION part of each clause at compile-time." (while (and clauses (not (eval (car (car clauses))))) (setq clauses (cdr clauses))) (if clauses (cons 'progn (cdr (car clauses))))) (def-edebug-spec w3m-static-cond (&rest (&rest def-form))) (put 'w3m-condition-case 'lisp-indent-function 2) (defmacro w3m-condition-case (var bodyform &rest handlers) "Like `condition-case', except that signal an error if `debug-on-error' or `debug-on-quit' is non-nil." `(if (or debug-on-error debug-on-quit) ,bodyform (condition-case ,var ,bodyform ,@handlers))) ;;; Functions used in common: ;; Moved from w3m-(ems,xmas).el because of modules' dependency problem. (defvar w3m-coding-system) (defvar w3m-default-coding-system) (defun w3m-decode-coding-string-with-priority (str coding) "Decode the string STR which is encoded in CODING. If CODING is a list, look for the coding system using it as a priority list." (w3m-static-if (featurep 'mule) (with-temp-buffer (w3m-static-when (featurep 'emacs) (set-buffer-multibyte nil)) (insert str) (decode-coding-string (buffer-string) (or (if (listp coding) (w3m-detect-coding-region (point-min) (point-max) coding) coding) w3m-default-coding-system w3m-coding-system 'iso-2022-7bit))) str)) ;;; Text props: (defmacro w3m-add-text-properties (start end props &optional object) "Like `add-text-properties' but always add non-sticky properties." (let ((non-stickies (if (featurep 'xemacs) ;; Default to start-closed and end-open in XEmacsen. '(list 'start-open t) ;; Default to front-nonsticky and rear-sticky in Emacsen. '(list 'rear-nonsticky t)))) `(add-text-properties ,start ,end (append ,non-stickies ,props) ,object))) (defun w3m-add-face-property (start end name &optional object) "Add face NAME to the face text property of the text from START to END. The value of the existing text property should be a list. If the optional fourth argument OBJECT is a buffer (or nil, which means the current buffer), START and END are buffer positions (integers or markers). If OBJECT is a string, START and END are 0-based indices into it." (let ((pos start) next prop) (while (< pos end) (setq prop (get-text-property pos 'face object) next (next-single-property-change pos 'face object end)) (w3m-add-text-properties pos next (list 'face (cons name prop)) object) (setq pos next)))) (defun w3m-remove-face-property (start end name &optional object) "Remove face NAME from the face text property of text from START to END. The value of the existing text property should be a list. If the optional fourth argument OBJECT is a buffer (or nil, which means the current buffer), START and END are buffer positions (integers or markers). If OBJECT is a string, START and END are 0-based indices into it." (let ((pos start) next prop new-prop elem) (while (< pos end) (setq prop (get-text-property pos 'face object)) (setq next (next-single-property-change pos 'face object end)) (setq new-prop nil) (while prop (setq elem (pop prop)) (unless (eq elem name) (push elem new-prop))) (when new-prop (w3m-add-text-properties pos next (list 'face new-prop))) (setq pos next)))) (defmacro w3m-get-text-property-around (prop) "Search for the text property PROP in one character before and behind the current position. Return the value corresponding to PROP or nil. If PROP is not found at the current position, point will move to the position where PROP exists." `(let ((position (point)) value) (or (get-text-property position ,prop) (and (not (bolp)) (setq value (get-text-property (1- position) ,prop)) (goto-char (1- position)) value) (and (not (eolp)) (setq value (get-text-property (1+ position) ,prop)) (goto-char (1+ position)) value)))) (defmacro w3m-action (&optional position) "Return the value of the `w3m-action' property at the given POSITION. NOTE: If POSITION is omitted, it searches for the property in one character before and behind the current position, and point will move to the position where the property exists." (if position `(get-text-property ,position 'w3m-action) `(w3m-get-text-property-around 'w3m-action))) (defmacro w3m-anchor (&optional position) "Return the value of the `w3m-href-anchor' property at the given POSITION. NOTE: If POSITION is omitted, it searches for the property in one character before and behind the current position, and point will move to the position where the property exists." (if position `(get-text-property ,position 'w3m-href-anchor) `(w3m-get-text-property-around 'w3m-href-anchor))) (defmacro w3m-image (&optional position) "Return the value of the `w3m-image' property at the given POSITION. NOTE: If POSITION is omitted, it searches for the property in one character before and behind the current position, and point will move to the position where the property exists." (if position `(get-text-property ,position 'w3m-image) `(w3m-get-text-property-around 'w3m-image))) (defmacro w3m-image-alt (&optional position) "Return the value of the `w3m-image-alt' property at the given POSITION. NOTE: If POSITION is omitted, it searches for the property in one character before and behind the current position, and point will move to the position where the property exists." (if position `(get-text-property ,position 'w3m-image-alt) `(w3m-get-text-property-around 'w3m-image-alt))) (defmacro w3m-anchor-title (&optional position) "Return the value of the `w3m-anchor-title' property at the given POSITION. NOTE: If POSITION is omitted, it searches for the property in one character before and behind the current position, and point will move to the position where the property exists." (if position `(get-text-property ,position 'w3m-anchor-title) `(w3m-get-text-property-around 'w3m-anchor-title))) (defmacro w3m-submit (&optional position) "Return the value of the `w3m-submit' property at the given POSITION. NOTE: If POSITION is omitted, it searches for the property in one character before and behind the current position, and point will move to the position where the property exists." (if position `(get-text-property ,position 'w3m-submit) `(w3m-get-text-property-around 'w3m-submit))) (defmacro w3m-anchor-sequence (&optional position) "Return the value of the `w3m-anchor-sequence' property at POSITION. If POSITION is omitted, the current position is assumed." (if position `(get-text-property ,position 'w3m-anchor-sequence) '(get-text-property (point) 'w3m-anchor-sequence))) ;;; Attributes: (eval-and-compile ;; `eval-and-compile' is necessary since the value of the constant ;; is referred to at the compile time. (defconst w3m-html-string-regexp "\\(\"\\([^\"]+\\)\"\\|'\\([^']+\\)'\\|[^\"'<> \t\r\f\n]*\\)" "Regexp matching a string of the field-value like .")) (put 'w3m-parse-attributes 'lisp-indent-function '1) (def-edebug-spec w3m-parse-attributes ((&rest &or (symbolp &optional symbolp) symbolp) body)) (defmacro w3m-parse-attributes (attributes &rest forms) "Extract ATTRIBUTES, KEYWORD=\"VALUE\" pairs, in a tag and run FORMS. ATTRIBUTES is a list of symbols that looks like `(KEYWORD KEYWORD...)'. A symbol KEYWORD, that will express a value extracted from a tag, can be used as a Lisp variable within FORMS. The point has to be within a tag initially, and only attributes that follow the point will be extracted. The value of KEYWORD is a string by default, or is nil if the KEYWORD is not found in a tag. KEYWORD can be `(KEYWORD TYPE)', where TYPE is one of `:case-ignore', `:integer', `:bool', and `:decode-entity'. Those types mean converting the value into a lower-case string, an integer, a boolean (t or nil), and a decoded string respectively." `(let (,@(mapcar (lambda (attr) (if (listp attr) (car attr) attr)) attributes)) (skip-chars-forward " \t\r\f\n") (while (cond ,@(mapcar (lambda (attr) (or (symbolp attr) (and (listp attr) (<= (length attr) 2) (symbolp (car attr))) (error "Internal error, type mismatch")) (let ((sexp (quote (w3m-remove-redundant-spaces (or (match-string-no-properties 2) (match-string-no-properties 3) (match-string-no-properties 1))))) type) (when (listp attr) (setq type (nth 1 attr)) (cond ((eq type :case-ignore) (setq sexp (list 'downcase sexp))) ((eq type :integer) (setq sexp (list 'string-to-number sexp))) ((eq type :bool) (setq sexp t)) ((eq type :decode-entity) (setq sexp (list 'w3m-decode-entities-string sexp))) ((nth 1 attr) (error "Internal error, unknown modifier"))) (setq attr (car attr))) `((looking-at ,(if (eq type :bool) (format "%s\\(?:[ \t\r\f\n]*=[ \t\r\f\n]*%s\\)?" (symbol-name attr) w3m-html-string-regexp) (format "%s[ \t\r\f\n]*=[ \t\r\f\n]*%s" (symbol-name attr) w3m-html-string-regexp))) (setq ,attr ,sexp)))) attributes) ((looking-at ,(concat "[A-Za-z]*[ \t\r\f\n]*=[ \t\r\f\n]*" w3m-html-string-regexp))) ((looking-at "[^<> \t\r\f\n]+"))) (goto-char (match-end 0)) (skip-chars-forward " \t\r\f\n")) (skip-chars-forward "^>") (forward-char) ,@forms)) ;;; Working buffers: (defun w3m-get-buffer-create (name) "Return the buffer named NAME, or create such a buffer and return it." (or (get-buffer name) (let ((buf (get-buffer-create name))) (setq w3m-work-buffer-list (cons buf w3m-work-buffer-list)) (buffer-disable-undo buf) buf))) (defun w3m-kill-buffer (buffer) "Kill the buffer BUFFER and remove it from `w3m-work-buffer-list'. The argument may be a buffer or may be the name of a buffer. An argument of nil means kill the current buffer." (unless buffer (setq buffer (current-buffer))) (when (stringp buffer) (setq buffer (get-buffer buffer))) (when (buffer-live-p buffer) (kill-buffer buffer)) (setq w3m-work-buffer-list (delq buffer w3m-work-buffer-list)) nil) (defun w3m-kill-all-buffer () "Kill all working buffer." (dolist (buf w3m-work-buffer-list) (when (buffer-live-p buf) (kill-buffer buf))) (setq w3m-work-buffer-list nil)) (defun w3m-current-title () "Return the title of the current buffer." (cond (w3m-current-process "") ((and (stringp w3m-current-title) (not (string= w3m-current-title ""))) w3m-current-title) ((stringp w3m-current-url) (directory-file-name (if (string-match "^[^/:]+:/+" w3m-current-url) (substring w3m-current-url (match-end 0)) w3m-current-url))) (t ""))) (defun w3m-buffer-title (buffer) "Return the title of the buffer BUFFER." (with-current-buffer buffer (w3m-current-title))) (defun w3m-buffer-number (buffer) (when (and (bufferp buffer) (string-match "\\*w3m\\*\\(<\\([0-9]+\\)>\\)?\\'" (buffer-name buffer))) (if (match-beginning 1) (string-to-number (match-string 2 (buffer-name buffer))) 1))) ;; `1' should not be represented in the buffer name. (defun w3m-buffer-set-number (buffer number) (with-current-buffer buffer (let ((newname (if w3m-use-title-buffer-name (if (= number 1) (format "%s *w3m*" (w3m-current-title)) (format "%s *w3m*<%d>" (w3m-current-title) number)) (if (= number 1) "*w3m*" (format "*w3m*<%d>" number))))) (if (eq (w3m-buffer-number buffer) number) (when w3m-use-title-buffer-name (unless (get-buffer newname) (rename-buffer newname))) (unless (get-buffer newname) (rename-buffer newname)))))) (defun w3m-buffer-name-add-title () "Add current tile to buffer name." (when w3m-use-title-buffer-name (let ((number (w3m-buffer-number (current-buffer))) newname) (if (= number 1) (setq newname (format "%s *w3m*" (w3m-current-title))) (setq newname (format "%s *w3m*<%d>" (w3m-current-title) number))) (rename-buffer newname)))) (defun w3m-generate-new-buffer (name &optional next) "Create and return a buffer with a name based on NAME. Make the new buffer the next of the current buffer if NEXT is non-nil." (when (string-match "<[0-9]+>\\'" name) (setq name (substring name 0 (match-beginning 0)))) (let* ((w3m-fb-mode nil) (buffers (w3m-list-buffers)) (regexp (concat "\\`" (regexp-quote name) "\\(?:<[0-9]+>\\)?\\'")) (siblings (delq nil (mapcar (lambda (buffer) (when (string-match regexp (buffer-name buffer)) buffer)) buffers))) youngers cur number num) (if (and next (setq youngers (cdr (memq (setq cur (current-buffer)) siblings)))) (progn (setq number (1+ (w3m-buffer-number cur)) num (+ 1 (length youngers) (w3m-buffer-number (car (reverse youngers))))) (dolist (buffer (reverse youngers)) (w3m-buffer-set-number buffer (setq num (1- num)))) (setq num number) (dolist (buffer youngers) (w3m-buffer-set-number buffer (setq num (1+ num)))) (generate-new-buffer (format "%s<%d>" name number))) (if (setq number (w3m-buffer-number (car (nreverse siblings)))) (generate-new-buffer (format "%s<%d>" name (1+ number))) (generate-new-buffer name))))) (defun w3m-buffer-name-lessp (x y) "Return t if first arg buffer's name is less than second." (when (bufferp x) (setq x (buffer-name x))) (when (bufferp y) (setq y (buffer-name y))) (if (and (string-match "\\*w3m\\*\\(<\\([0-9]+\\)>\\)?\\'" x) (setq x (cons x (if (match-beginning 1) (string-to-number (match-string 2 x)) 0)))) (if (string-match "\\*w3m\\*\\(<\\([0-9]+\\)>\\)?\\'" y) (< (cdr x) (if (match-beginning 1) (string-to-number (match-string 2 y)) 0)) (string< (car x) y)) (string< x y))) (defun w3m-list-buffers (&optional nosort) "Return a list of buffers in which emacs-w3m sessions are open. If the optional NOSORT is nil, the list is sorted in the order of buffer names." (let ((buffers (buffer-list)) buffer rest) (save-current-buffer (while buffers (set-buffer (setq buffer (pop buffers))) (when (eq major-mode 'w3m-mode) (push buffer rest)))) (setq buffers (if nosort (nreverse rest) (sort rest #'w3m-buffer-name-lessp))) (when (and (boundp 'w3m-fb-mode) w3m-fb-mode (if (or w3m-pop-up-frames (not (memq 'w3m-fb-add w3m-mode-hook))) ;; `w3m-fb-mode' might have been set by something ;; other than the `w3m-fb-mode' function. (setq w3m-fb-mode nil) t)) ;; Don't just return `w3m-fb-buffer-list' for the selected frame ;; because `buffers' may have been sorted. (let ((fbs (w3m-fb-frame-parameter w3m-fb-list-buffers-frame 'w3m-fb-buffer-list))) (setq rest buffers) (while rest (unless (memq (setq buffer (pop rest)) fbs) (setq buffers (delq buffer buffers)))))) buffers)) ;;; Pop up and delete buffers, windows or frames: (defmacro w3m-popup-frame-parameters () "Return a pop-up frame plist if this file is compiled for XEmacs, otherwise return an alist." (if (featurep 'xemacs) '(let ((params (or w3m-popup-frame-parameters pop-up-frame-plist))) (if (consp (car-safe params)) (alist-to-plist params) params)) '(let ((params (or w3m-popup-frame-parameters pop-up-frame-alist)) alist) (if (consp (car-safe params)) params (while params (push (cons (car params) (cdr params)) alist) (setq params (cddr params))) (nreverse alist))))) (defun w3m-device-on-window-system-p () "Return non-nil if the selected frame is on a widnow system" (w3m-static-if (featurep 'xemacs) (device-on-window-system-p) window-system)) (defmacro w3m-popup-frame-p () "Return non-nil if `w3m-pop-up-frames' is non-nil and Emacs really supports separate frames." '(and w3m-pop-up-frames (w3m-device-on-window-system-p))) (defmacro w3m-use-tab-p () "Return non-nil if `w3m-use-tab' is non-nil and Emacs really supports the tabs line." (cond ((featurep 'xemacs) '(and w3m-use-tab (device-on-window-system-p))) (t 'w3m-use-tab))) (defun w3m-lefttab-exist-p (&optional buffer) (not (eq (or buffer (current-buffer)) (car (w3m-list-buffers))))) (defun w3m-righttab-exist-p (&optional buffer) (let ((bufs (w3m-list-buffers)) (cbuf (or buffer (current-buffer))) buf) (catch 'exist (while (setq buf (car bufs)) (setq bufs (cdr bufs)) (when (eq cbuf buf) (throw 'exist bufs)))))) (defmacro w3m-popup-window-p () "Return non-nil if `w3m-pop-up-windows' is non-nil and the present situation allows it." '(and w3m-pop-up-windows (not (w3m-use-tab-p)) (not (get-buffer-window w3m-select-buffer-name)))) (defvar w3m-initial-frames nil "Variable used to keep a list of the frame-IDs when emacs-w3m sessions are popped-up as new frames. This variable is used for the control for not deleting frames made for aims other than emacs-w3m sessions.") (make-variable-buffer-local 'w3m-initial-frames) (defun w3m-popup-buffer (buffer) "Pop up BUFFER as a new window or a new frame according to `w3m-pop-up-windows' and `w3m-pop-up-frames' (which see)." (let ((window (get-buffer-window buffer t)) oframe popup-frame-p frame pop-up-frames buffers other) (unless (eq window (selected-window)) (setq oframe (selected-frame) popup-frame-p (w3m-popup-frame-p)) (if (setq pop-up-frames (if window ;; The window showing BUFFER already exists. ;; Don't pop up a new frame if it is just the current frame. (not (eq (setq frame (window-frame window)) oframe)) ;; There is no window for BUFFER, so look for the existing ;; emacs-w3m window if the tabs line is enabled or the ;; selection window exists (i.e., we can reuse it). (if (or (w3m-use-tab-p) (get-buffer-window w3m-select-buffer-name t)) (progn (setq buffers (delq buffer (w3m-list-buffers t))) (while (and (not window) buffers) (setq window (get-buffer-window (setq other (pop buffers)) t))) (if window ;; The window showing another buffer exists. (not (eq (setq frame (window-frame window)) oframe)) (setq other nil) ;; There is no window after all, so leave to the value ;; of `w3m-pop-up-frames' whether to pop up a new frame. popup-frame-p)) ;; Ditto. popup-frame-p))) (progn (cond (other ;; Pop up another emacs-w3m buffer and switch to BUFFER. (pop-to-buffer other) ;; Change the value for BUFFER's `w3m-initial-frames'. (setq w3m-initial-frames (prog1 (copy-sequence w3m-initial-frames) (switch-to-buffer buffer)))) (frame ;; Pop up the existing frame which shows BUFFER. (pop-to-buffer buffer)) (t ;; Pop up a new frame. (let* ((pop-up-frame-alist (w3m-popup-frame-parameters)) (pop-up-frame-plist pop-up-frame-alist)) (pop-to-buffer buffer)) (setq frame (window-frame (get-buffer-window buffer t))))) ;; Raise, select and focus the frame. (if (fboundp 'select-frame-set-input-focus) (select-frame-set-input-focus frame) (raise-frame frame) (select-frame frame) (w3m-static-when (featurep 'xemacs) (focus-frame frame)))) ;; Simply switch to BUFFER in the current frame. (let ((cd default-directory)) (if (w3m-popup-window-p) (let ((pop-up-windows t)) (pop-to-buffer buffer)) (switch-to-buffer buffer)) (setq default-directory cd)) (w3m-history-restore-position))))) (eval-when-compile (when (and (fboundp 'select-frame-set-input-focus) (eq (symbol-function 'select-frame-set-input-focus) 'ignore)) (fmakunbound 'select-frame-set-input-focus))) (defun w3m-add-w3m-initial-frames (&optional frame) "Add FRAME into `w3m-initial-frames', the buffer-local variable. It is done when FRAME is newly created for the emacs-w3m session. This function is added to the hook which is different with the Emacs version as follows: XEmacs `create-frame-hook' Emacs 21,22 `after-make-frame-functions' Emacs 19 `after-make-frame-hook' Note that `after-make-frame-hook' doesn't take an argument." (unless frame (setq frame (selected-frame))) ;; Share the opened frame in `w3m-initial-frames' over all emacs-w3m ;; buffers if `w3m-use-tab' is non-nil. Otherwise, the frame is ;; appended into `w3m-initial-frames' only in the current buffer. (with-current-buffer (window-buffer (frame-first-window frame)) (when (eq major-mode 'w3m-mode) (unless (memq frame w3m-initial-frames) (push frame w3m-initial-frames)) (when w3m-use-tab (dolist (buffer (delq (current-buffer) (w3m-list-buffers t))) (set-buffer buffer) (unless (memq frame w3m-initial-frames) (push frame w3m-initial-frames))))))) (add-hook (if (featurep 'xemacs) 'create-frame-hook 'after-make-frame-functions) 'w3m-add-w3m-initial-frames) (defun w3m-delete-w3m-initial-frames (frame) "Delete FRAME from `w3m-initial-frames', the buffer-local variable. It is done when the FRAME in which emacs-w3m is running is deleted. This function is added to `delete-frame-hook' (`delete-frame-functions' is used instead in Emacs 22) or merged into the `delete-frame' function using `defadvice'." (save-current-buffer (dolist (buffer (w3m-list-buffers t)) (set-buffer buffer) (setq w3m-initial-frames (delq frame w3m-initial-frames))))) (cond ((boundp 'delete-frame-functions) (add-hook 'delete-frame-functions 'w3m-delete-w3m-initial-frames)) (t (add-hook 'delete-frame-hook 'w3m-delete-w3m-initial-frames))) (defun w3m-delete-frames-and-windows (&optional exception) "Delete all frames and windows related to emacs-w3m buffers. If EXCEPTION is a buffer, a window or a frame, it and related visible objects will not be deleted. There are special cases; the following objects will not be deleted: 1. The sole frame in the display device. 2. Frames created not for emacs-w3m sessions. 3. Frames showing not only emacs-w3m sessions but also other windows.\ " (let ((buffers (delq exception (w3m-list-buffers t))) buffer windows window frame one-window-p flag) (save-current-buffer (while buffers (setq buffer (pop buffers) windows (delq exception (get-buffer-window-list buffer 'no-minibuf t))) (set-buffer buffer) (while windows (setq window (pop windows) frame (and (window-live-p window) (window-frame window))) (when (and frame (not (eq frame exception))) (setq flag nil) (setq one-window-p ;; This is similar to the `one-window-p' function ;; but works for even unselected windows in addition ;; to the selected window in all frames. (catch 'two (walk-windows (lambda (w) (when (eq (window-frame w) frame) (if flag (throw 'two nil) (setq flag t)))) 'no-minibuf t) flag)) (when (and (or ;; A frame having only windows for emacs-w3m ;; sessions or the buffer selection can be deleted. (progn (setq flag t) (walk-windows (lambda (w) (when flag (if (eq w exception) (setq flag nil) (set-buffer (window-buffer w)) (when (setq flag (or (memq major-mode '(w3m-mode w3m-select-buffer-mode w3m-session-select-mode)) (string-match "\\` ?\\*w3m[ -]" (buffer-name)))) (if (eq (next-window w 'no-minibuf) w) (bury-buffer) (delete-window w)))))) 'no-minibuf) (set-buffer buffer) flag) ;; Also a frame having the sole window can be deleted. one-window-p) (memq frame w3m-initial-frames) (not (eq (next-frame frame) frame))) (delete-frame frame)))))))) ;;; Navigation: (defmacro w3m-goto-next-defun (name property) "Create function w3m-goto-next- NAME. Return position of the first occurence of PROPERTY. If currently over such PROPERTY, find next such occurence." `(defun ,(intern (concat "w3m-goto-next-" (symbol-name name))) (&optional pos) ,(concat "Return position of next " (symbol-name name) " starting from POS or point.") (setq pos (or pos (point))) (if (get-char-property pos ',property) ; currently over such element (setq pos (next-single-property-change pos ',property))) (if (or (get-char-property pos ',property) (setq pos (next-single-property-change pos ',property))) pos))) (w3m-goto-next-defun link w3m-href-anchor) (w3m-goto-next-defun image2 w3m-image) (defun w3m-goto-next-anchor-or-image (&optional pos) "Return position of next anchor or image starting from POS or point." (setq pos (or pos (point))) (cond ; currently on anchor or image ((w3m-anchor-sequence pos) (setq pos (next-single-property-change pos 'w3m-anchor-sequence))) ((w3m-image pos) (setq pos (next-single-property-change pos 'w3m-image)))) (or (w3m-anchor-sequence pos) (w3m-image pos) (let ((image-pos (next-single-property-change pos 'w3m-image))) (setq pos (next-single-property-change pos 'w3m-anchor-sequence)) (and image-pos (or (not pos) (> pos image-pos)) (setq pos image-pos)))) (if pos (let ((hseq (w3m-anchor-sequence pos))) (if (and hseq (text-property-any ; multiline anchors (point-min) pos 'w3m-anchor-sequence hseq)) (w3m-goto-next-anchor-or-image pos) pos)))) ;;; Miscellaneous: (eval-and-compile (defconst w3m-url-invalid-base "http:///" "A url base used to make url absolutely invalid. `w3m-expand-url' will use it as a last resort if no other appropriate base is given.")) (defsubst w3m-url-valid (url) "Return URL if it is not marked invalid, otherwise nil. This function is intended only to reject a url that `w3m-expand-url' marks invalid purposely (using `w3m-url-invalid-base'), does not necessarily guarantee that URL to return is valid in a general sense." ;; cf. [emacs-w3m:04095], [emacs-w3m:04101] (Japanese), ;; and [emacs-w3m:12761] (summarized in English). (and url (not (string-match (eval-when-compile (concat "\\`" w3m-url-invalid-base)) url)) url)) (defmacro w3m-substitute-key-definitions (new-map old-map &rest keys) "In NEW-MAP substitute cascade of OLD-MAP KEYS. KEYS is alternating list of key-value." (let ((n-map new-map) (o-map old-map)) `(progn ,@(let ((res nil)) (while keys (push `(substitute-key-definition ,(car keys) ,(cadr keys) ,n-map ,o-map) res) (setq keys (cddr keys))) (nreverse res))))) (defmacro w3m-set-match-data (list) "Same as the `set-match-data'; convert points into markers under XEmacs." (if (featurep 'xemacs) `(let ((list ,list)) (store-match-data (dolist (pt (prog1 list (setq list nil)) (nreverse list)) (push (if (markerp pt) pt (set-marker (make-marker) pt)) list)))) `(set-match-data ,list))) (defun w3m-search-tag-1 (regexp) "Subroutine used by `w3m-search-tag'." (let ((start (point)) begin end) (if (and (re-search-forward regexp nil t) (setq begin (match-beginning 0) end (match-end 0)) (or (looking-at "/?>") (and (looking-at "[ \t\f\n]") (search-forward ">" nil t)))) (prog1 (goto-char (match-end 0)) (w3m-set-match-data (cond ((= end (match-beginning 0)) (list begin (match-end 0) (1+ begin) end)) ((eq (char-before (match-beginning 0)) ?/) (if (= end (1- (match-beginning 0))) (list begin (match-end 0) (1+ begin) end) (list begin (match-end 0) (1+ begin) end end (- (match-end 0) 2)))) (t (list begin (match-end 0) (1+ begin) end end (1- (match-end 0))))))) (set-match-data nil) (goto-char start) nil))) (defmacro w3m-search-tag (&rest names) "Search forward for a tag which begins with one of NAMES. This macro generates the form equivalent to: \(re-search-forward \"<\\\\(NAMES\\\\)\\\\([ \\t\\f\\n]+[^>]*\\\\)?/?>\" nil t) but it works even if the tag is considerably large. Note: this macro allows only strings for NAMES, that is, a form something like `(if foo \"bar\" \"baz\")' cannot be used." `(w3m-search-tag-1 ,(concat "<" (regexp-opt names t)))) (defun w3m-beginning-of-tag (&optional tag include-whitespace) "Move point to the beginning of tag. Inner nested tags are skipped. If TAG, which is a name of the tag, is given, this function moves point backward from the closing-tag (point has to exist after or within it initially) to the beginning point of the open-tag . For example, in the following two situations, point moves backward from the rightmost tag to the beginning point of the leftmost tag: ............... ............... If TAG is omitted or nil, this function moves point backward to the beginning point of the tag in which point exists. In this case, point has to initially exist between the end position of the closing-tag and the previous tag as follows: ^^^ If INCLUDE-WHITESPACE is non-nil, include leading and trailing whitespace. Return the end-point and set the match-data #0, #1, #2, and #3 as follows (\"___\" shows whitespace): The case where TAG is spefified: ______...______ 0 1 2 2 1 0 INCLUDE-WHITESPACE=nil 0 1 2 3 3 2 1 0 INCLUDE-WHITESPACE=non-nil The case where TAG is nil: ______ 0 0 INCLUDE-WHITESPACE=nil 0 1 1 0 INCLUDE-WHITESPACE=non-nil" (let ((init (point)) (num 1) (md (match-data)) (case-fold-search t) end regexp nd1 nd2 nd3 st1 st2 st3 st0 nd0) (condition-case nil (progn (if tag (progn (setq end (point) tag (regexp-quote tag)) (if (and (re-search-backward (concat "\ \\(<[\t\n\r ]*/[\t\n\r ]*" tag "\ \\(?:[\t\n\r ]*\\|[\t\n\r ]+[^>]+\\)>\\)[\t\n\r ]*") nil t) (eq end (match-end 0))) (progn (setq nd1 (nth 3 (match-data)) ;; (match-end 1) nd2 (nth 2 (match-data))) ;; (match-beginning 1) (skip-chars-backward "\t\n\r ") (setq nd3 (point-marker)) (goto-char end)) (goto-char end) (search-forward ">") (setq end (point)) (if (and (re-search-backward (concat "\ <[\t\n\r ]*/[\t\n\r ]*" tag "\\(?:[\t\n\r ]*\\|[\t\n\r ]+[^>]+\\)>")) (eq end (match-end 0))) (progn (setq nd1 (nth 1 (match-data)) ;; (match-end 0) nd2 (car (match-data))) ;; (match-beginning 0) (skip-chars-backward "\t\n\r ") (setq nd3 (point-marker))) (error ""))) (goto-char (1- nd2)) (setq regexp (concat "\\(<\\([\t\n\r ]*/\\)?[\t\n\r ]*" tag "\ \\(?:[\t\n\r ]*\\|[\t\n\r ]+[^>]+\\)>\\)[\t\n\r ]*")) (while (and (> num 0) (re-search-backward regexp)) (setq num (if (match-beginning 2) (1+ num) (1- num)))) (setq st1 (car (match-data)) ;; (match-beginning 0) st2 (nth 3 (match-data)) ;; (match-end 1) ;; There may be only whitespace between .... st3 (min nd3 (nth 1 (match-data))))) ;; (match-end 0) (search-forward ">") (setq nd1 (nth 1 (match-data))) ;; (match-end 0) (goto-char init) (while (and (> num 0) (re-search-backward "\\(<\\)\\|>")) (setq num (if (match-beginning 1) (1- num) (1+ num)))) (setq st1 (nth 2 (match-data)))) ;; (match-beginning 1) (if include-whitespace (progn (skip-chars-backward "\t\n\r ") (setq st0 (point-marker)) (goto-char nd1) (skip-chars-forward "\t\n\r ") (setq nd0 (point-marker)) (goto-char st0) (set-match-data (if tag (list st0 nd0 st1 nd1 st2 nd2 st3 nd3) (list st0 nd0 st1 nd1)))) (set-match-data (if tag (list st1 nd1 st2 nd2 st3 nd3) (list st1 nd1)))) (point)) (error (set-match-data md) (goto-char init) nil)))) (defun w3m-end-of-tag (&optional tag include-whitespace) "Move point to the end of tag. Inner nested tags are skipped. If TAG, which is a name of the tag, is given, this function moves point from the open-tag (point has to exist in front of or within it initially) to the end point of the closing-tag . For example, in the following two situations, point moves from the leftmost tag to the end point of the rightmost tag: ............... ............... If TAG is omitted or nil, this function moves point to the end point of the tag in which point exists. In this case, point has to initially exist between the beginning position of the tag and the next tag as follows: ^^^^^^^^ If INCLUDE-WHITESPACE is non-nil, include leading and trailing whitespace. Return the end-point and set the match-data #0, #1, #2, and #3 as follows (\"___\" shows whitespace): The case where TAG is spefified: ______...______ 0 1 2 2 1 0 INCLUDE-WHITESPACE=nil 0 1 2 3 3 2 1 0 INCLUDE-WHITESPACE=non-nil The case where TAG is nil: ______ 0 0 INCLUDE-WHITESPACE=nil 0 1 1 0 INCLUDE-WHITESPACE=non-nil" (let ((init (point)) (num 1) (md (match-data)) (case-fold-search t) regexp st1 st2 st3 nd1 nd2 nd3 nd0 st0) (condition-case nil (progn (if tag (progn (setq tag (regexp-quote tag)) (if (looking-at (concat "\ \[\t\n\r ]*\\(<[\t\n\r ]*" tag "\\(?:[\t\n\r ]*\\|[\t\n\r ]+[^>]+\\)>\\)\ \[\t\n\r ]*")) (setq st1 (nth 2 (match-data)) ;; (match-beginning 1) st2 (nth 3 (match-data)) ;; (match-end 1) st3 (nth 1 (match-data))) ;; (match-end 0) (search-backward "<") (if (looking-at (concat "\ \\(<[\t\n\r ]*" tag "\\(?:[\t\n\r ]*\\|[\t\n\r ]+[^>]+\\)>\\)[\t\n\r ]*")) (setq st1 (car (match-data)) ;; (match-beginning 0) st2 (nth 3 (match-data)) ;; (match-end 1)) st3 (nth 1 (match-data))) ;; (match-end 0) (error ""))) (goto-char (1+ st1)) (setq regexp (concat "\ \[\t\n\r ]*\\(<\\([\t\n\r ]*/\\)?[\t\n\r ]*" tag "\ \\(?:[\t\n\r ]*\\|[\t\n\r ]+[^>]+\\)>\\)")) (while (and (> num 0) (re-search-forward regexp)) (setq num (if (match-beginning 2) (1- num) (1+ num)))) (setq nd1 (nth 3 (match-data)) ;; (match-end 1) nd2 (nth 2 (match-data)) ;; (match-beginning 1) ;; There may be only whitespace between .... nd3 (max st3 (car (match-data))))) ;; (match-beginning 0) (search-backward "<") (setq st1 (car (match-data))) ;; (match-beginning 0) (goto-char init) (while (and (> num 0) (re-search-forward "\\(>\\)\\|<")) (setq num (if (match-beginning 1) (1- num) (1+ num)))) (setq nd1 (nth 3 (match-data)))) ;; (match-end 1) (if include-whitespace (progn (skip-chars-forward "\t\n\r ") (setq nd0 (point-marker)) (goto-char st1) (skip-chars-backward "\t\n\r ") (setq st0 (point-marker)) (goto-char nd0) (set-match-data (if tag (list st0 nd0 st1 nd1 st2 nd2 st3 nd3) (list st0 nd0 st1 nd1)))) (set-match-data (if tag (list st1 nd1 st2 nd2 st3 nd3) (list st1 nd1)))) (point)) (error (set-match-data md) (goto-char init) nil)))) (defun w3m-string-match-url-components-1 (string) "Subroutine used by `w3m-string-match-url-components'." ;; ^(([^:/?#]+):)?(//([^/?#]*))?([^?#]*)(\?([^#]*))?(#(.*))? ;; 12 3 4 5 6 7 8 9 (let ((md (make-vector 20 nil)) pt) (with-temp-buffer (w3m-static-unless (featurep 'xemacs) (set-buffer-multibyte (multibyte-string-p string))) (insert string) (goto-char (point-min)) (aset md 0 0) (aset md 1 (1- (point-max))) (when (looking-at "[^:/?#]+:") (aset md 2 0) (aset md 4 0) (goto-char (match-end 0)) (aset md 3 (setq pt (1- (point)))) (aset md 5 (1- pt))) (when (looking-at "//") (aset md 6 (1- (point))) (forward-char 2) (aset md 8 (1- (point))) (skip-chars-forward "^/?#") (aset md 7 (setq pt (1- (point)))) (aset md 9 pt)) (aset md 10 (1- (point))) (skip-chars-forward "^?#") (aset md 11 (setq pt (1- (point)))) (when (eq (char-after) ??) (aset md 12 pt) (forward-char 1) (aset md 14 (1- (point))) (skip-chars-forward "^#") (aset md 13 (setq pt (1- (point)))) (aset md 15 pt)) (unless (eobp) (aset md 16 (1- (point))) (aset md 18 (point)) (aset md 17 (setq pt (1- (point-max)))) (aset md 19 pt))) (set-match-data (append md nil))) 0) (defconst w3m-url-components-regexp "\\`\\(\\([^:/?#]+\\):\\)?\\(//\\([^/?#]*\\)\\)?\ \\([^?#]*\\)\\(\\?\\([^#]*\\)\\)?\\(#\\(.*\\)\\)?\\'" "Regexp used for parsing a URI Reference. It matches the potential four components and fragment identifier of a URI reference. See RFC2396, Appendix B for details.") (defmacro w3m-string-match-url-components (string) "Do the same thing as `(string-match w3m-url-components-regexp STRING)'. But this function should work even if STRING is considerably long." `(let ((string ,string)) (condition-case nil (string-match w3m-url-components-regexp string) (error ;; Stack overflow in regexp matcher (w3m-string-match-url-components-1 string))))) (defun w3m-time-newer-p (a b) "Return t, if A is newer than B. Otherwise return nil. A and B are lists which represent time in Emacs-style. If value is nil, it is regarded as the oldest time." (and a (or (not b) (or (> (car a) (car b)) (and (= (car a) (car b)) (> (nth 1 a) (nth 1 b))))))) (defun w3m-time-lapse-seconds (start end) "Return lapse seconds from START to END. START and END are lists which represent time in Emacs-style." (+ (* (- (car end) (car start)) 65536) (cadr end) (- (cadr start)))) (defalias 'w3m-float-time (if (fboundp 'float-time) 'float-time (lambda (&optional specified-time) "Return the current time, as a float number of seconds since the epoch. If an argument is given, it specifies a time to convert to float instead of the current time. The argument should have the forms: (HIGH . LOW) or (HIGH LOW USEC) or (HIGH LOW . USEC). WARNING: Since the result is floating point, it may not be exact. Do not use this function if precise time stamps are required." (let ((time (or specified-time (current-time)))) (+ (* (car time) 65536.0) (cadr time) (cond ((consp (setq time (cddr time))) (/ (car time) 1000000.0)) (time (/ time 1000000.0)) (t 0))))))) (defun w3m-url-local-p (url) "If URL points a file on the local system, return non-nil value. Otherwise return nil." (string-match "\\`file:" url)) (defconst w3m-url-authinfo-regexp "\\`\\([^:/?#]+:\\)?//\\([^/?#:]+\\)\\(?::\\([^/?#@]+\\)\\)?@" "Regular expression for parsing the authentication part of a URI reference") (defun w3m-url-authinfo (url) "Return a user name and a password to authenticate URL." (when (string-match w3m-url-authinfo-regexp url) (cons (match-string 2 url) (match-string 3 url)))) (defun w3m-url-strip-authinfo (url) "Remove the authentication part from the URL." (if (string-match w3m-url-authinfo-regexp url) (concat (match-string 1 url) "//" (substring url (match-end 0))) url)) (defun w3m-url-strip-fragment (url) "Remove the fragment identifier from the URL." (if (string-match "\\`\\([^#]*\\)#" url) (match-string 1 url) url)) (defun w3m-url-strip-query (url) "Remove the query part and the fragment identifier from the URL." (if (string-match "\\`\\([^?#]*\\)[?#]" url) (match-string 1 url) url)) (defun w3m-get-server-hostname (url) "Extract a server root from URL." (when (string-match "\\`about://[^/?#]+/" url) (setq url (substring url (match-end 0)))) (setq url (w3m-url-strip-authinfo url)) (if (string-match "\\`[^:/?#]+://\\([^/?#]+\\)" url) (downcase (match-string 1 url)) url)) (defun w3m-which-command (command) (when (stringp command) (if (and (file-name-absolute-p command) (file-executable-p command)) command (setq command (file-name-nondirectory command)) (catch 'found-command (let (bin) (dolist (dir exec-path) (setq bin (expand-file-name command dir)) (when (or (and (file-executable-p bin) (not (file-directory-p bin))) (and (file-executable-p (setq bin (concat bin ".exe"))) (not (file-directory-p bin)))) (throw 'found-command bin)))))))) (defun w3m-cancel-refresh-timer (&optional buffer) "Cancel the timer for REFRESH attribute in META tag." (when w3m-use-refresh (with-current-buffer (or buffer (current-buffer)) (setq w3m-current-refresh nil) (when w3m-refresh-timer (w3m-static-if (featurep 'xemacs) (delete-itimer w3m-refresh-timer) (cancel-timer w3m-refresh-timer)) (setq w3m-refresh-timer nil))))) (cond ((featurep 'xemacs) ;; The function of the XEmacs version doesn't work correctly ;; for wide characters. (defun w3m-truncate-string (str end-column) "Truncate string STR to end at column END-COLUMN." (let ((len (length str)) (column 0) (idx 0)) (condition-case nil (while (< column end-column) (setq column (+ column (char-width (aref str idx))) idx (1+ idx))) (args-out-of-range (setq idx len))) (when (> column end-column) (setq idx (1- idx))) (substring str 0 idx)))) (t (defalias 'w3m-truncate-string 'truncate-string-to-width))) (defun w3m-assoc-ignore-case (name alist) "Return the element of ALIST whose car equals NAME ignoring its case." (let ((dname (downcase name)) match) (while alist (when (and (consp (car alist)) (string= dname (downcase (car (car alist))))) (setq match (car alist) alist nil)) (setq alist (cdr alist))) match)) (defun w3m-prin1 (object &optional stream) "Like `prin1', except that control chars will be represented with ^ as `cat -v' does." (if (stringp object) (let (rest) (dolist (char (append object nil) rest) (cond ((eq char ?\C-?) (push "^?" rest)) ((or (memq char '(?\t ?\n)) (>= char ?\ )) (push (char-to-string char) rest)) (t (push (concat "^" (char-to-string (+ 64 char))) rest)))) (prin1 (apply 'concat (nreverse rest)) stream)) (prin1 object stream))) (defun w3m-modify-plist (plist &rest properties) "Change values in PLIST corresponding to PROPERTIES. This is similar to `plist-put', but handles plural symbol and value pairs and remove pairs from PLIST whose value is nil." (while properties (setq plist (plist-put plist (car properties) (cadr properties)) properties (cddr properties))) (while plist (if (cadr plist) (setq properties (nconc properties (list (car plist) (cadr plist))))) (setq plist (cddr plist))) properties) (def-edebug-spec w3m-insert-string (form)) (defmacro w3m-insert-string (string) "Insert STRING at point without conversions in either case the multibyteness of the buffer." (if (featurep 'emacs) `(let ((string ,string)) (insert (if enable-multibyte-characters string (encode-coding-string string 'utf-8-emacs)))) `(insert ,string))) (defun w3m-custom-hook-initialize (symbol value) "Initialize the hook option pointed by the SYMBOL with the default VALUE." (if (boundp symbol) (progn (setq value (eval value)) (while value (add-hook symbol (car value)) (setq value (cdr value)))) (custom-initialize-set symbol value))) (defun w3m-run-mode-hooks (&rest funcs) "Run `run-mode-hooks' if it is available, otherwise `run-hooks'." (if (fboundp 'run-mode-hooks) (apply 'run-mode-hooks funcs) (apply 'run-hooks funcs))) (defmacro w3m-keep-region-active () "Keep the region active after evaluating this current command. In XEmacs, `zmacs-region-stays' is set to nil everywhen a command is evaluated. This means that the region is always deactivated after evaluating the current command. This macro sets t to it, and keeps the region active." (when (featurep 'xemacs) '(if (interactive-p) (setq zmacs-region-stays t)))) (defmacro w3m-deactivate-region () "Deactivate the region." (if (featurep 'xemacs) '(zmacs-deactivate-region) '(deactivate-mark))) (defmacro w3m-region-active-p () "Say whether the region is active." (if (fboundp 'region-active-p) (list 'region-active-p) (list 'and 'transient-mark-mode 'mark-active))) (eval-and-compile (cond ((fboundp 'replace-regexp-in-string) (defun w3m-replace-in-string (string regexp newtext &optional literal) ;;(replace-regexp-in-string regexp newtext string nil literal))) ;; ;; Don't call the symbol function `replace-regexp-in-string' directly ;; in order to silence the byte-compiler when an Emacs which doesn't ;; provide it is used. The following form generates exactly the same ;; byte-code. (funcall (symbol-function 'replace-regexp-in-string) regexp newtext string nil literal))) (t (defalias 'w3m-replace-in-string 'replace-in-string)))) (defun w3m-replace-regexps-in-string (string &rest regexps) "In STRING replace an alist of REGEXPS." (if (cadr regexps) (w3m-replace-in-string (apply #'w3m-replace-regexps-in-string string (cddr regexps)) (car regexps) (cadr regexps)) string)) (if (fboundp 'string-match-p) (defalias 'w3m-string-match-p 'string-match-p) (defun w3m-string-match-p (regexp string &optional start) "\ Same as `string-match' except this function does not change the match data." (save-match-data (string-match regexp string start)))) (if (fboundp 'substring-no-properties) (defalias 'w3m-substring-no-properties 'substring-no-properties) (defun w3m-substring-no-properties (string &optional from to) "Return a substring of STRING, without text properties. It starts at index FROM and ending before TO. TO may be nil or omitted; then the substring runs to the end of STRING. If FROM is nil or omitted, the substring starts at the beginning of STRING. If FROM or TO is negative, it counts from the end. With one argument, just copy STRING without its properties." (setq string (substring string (or from 0) to)) (set-text-properties 0 (length string) nil string) string)) (if (fboundp 'compare-strings) (defalias 'w3m-compare-strings 'compare-strings) (defun w3m-compare-strings (string1 start1 end1 string2 start2 end2) "Compare the contents of two strings." (let* ((str1 (substring string1 start1 end1)) (str2 (substring string2 start2 end2)) (len (min (length str1) (length str2))) (i 0)) (if (string= str1 str2) t (setq i (catch 'ignore (while (< i len) (when (not (eq (aref str1 i) (aref str2 i))) (throw 'ignore i)) (setq i (1+ i))) i)) (1+ i))))) (eval-and-compile ;; This function will be redefined in w3m-ems.el. (unless (fboundp 'w3m-force-window-update) (defalias 'w3m-force-window-update 'ignore))) (if (boundp 'header-line-format) (defun w3m-force-window-update-later (&optional buffer seconds) "Update the header-line appearance in BUFFER after SECONDS. BUFFER defaults to the current buffer. SECONDS defaults to 0.5." (run-with-timer (or seconds 0.5) nil (lambda (buffer) (when (and (buffer-live-p buffer) (eq (get-buffer-window buffer t) (selected-window))) (w3m-force-window-update))) (or buffer (current-buffer)))) (defalias 'w3m-force-window-update-later 'ignore)) (if (fboundp 'read-number) (defalias 'w3m-read-number 'read-number) (defun w3m-read-number (prompt &optional default) "Read a numeric value in the minibuffer, prompting with PROMPT. DEFAULT specifies a default value to return if the user just types RET. The value of DEFAULT is inserted into PROMPT." (let ((n nil)) (when default (setq prompt (if (string-match "\\(\\):[ \t]*\\'" prompt) (replace-match (format " (default %s)" default) t t prompt 1) (w3m-replace-in-string prompt "[ \t]*\\'" (format " (default %s) " default) t)))) (while (progn (let ((str (read-from-minibuffer prompt nil nil nil nil (and default (number-to-string default))))) (condition-case nil (setq n (cond ((zerop (length str)) default) ((stringp str) (read str)))) (error nil))) (unless (numberp n) (message "Please enter a number.") (sit-for 1) t))) n))) (defun w3m-make-menu-item (japan english) "Make menu item." (cond ((and w3m-use-japanese-menu (featurep 'xemacs)) (concat japan "%_ ")) (w3m-use-japanese-menu japan) (t english))) (defvar w3m-make-menu-commands-keys nil) (defun w3m-make-menu-commands (menu-commands) "Make menu items." (mapcar (lambda (c) (if (consp c) (vector (cadr c) (if (nth 3 c) `(progn (switch-to-buffer w3m-tab-button-menu-current-buffer) (funcall (function ,(car c)) ,@(nthcdr 4 c))) `(save-window-excursion (switch-to-buffer w3m-tab-button-menu-current-buffer) (funcall (function ,(car c)) ,@(nthcdr 4 c)))) :active (nth 2 c) :keys (or (and (assq (car c) w3m-make-menu-commands-keys) (cdr (assq (car c) w3m-make-menu-commands-keys))) (let ((key (where-is-internal (car c) w3m-mode-map))) (when key (setq w3m-make-menu-commands-keys (cons (cons (car c) (key-description (car key))) w3m-make-menu-commands-keys)) (cdr (car w3m-make-menu-commands-keys)))))) (symbol-name c))) menu-commands)) (defun w3m-unseen-buffer-p (buffer) "Return t if buffer unseen." (with-current-buffer buffer w3m-buffer-unseen)) (defun w3m-visited-file-modtime () "Replacement of `visited-file-modtime'. It returns a list of two integers if the current buffer visits a file, otherwise returns the number 0. In modern Emacsen, this function will get to be the alias to `visited-file-modtime'." (let ((modtime (visited-file-modtime))) (cond ((consp (cdr-safe modtime)) (defalias 'w3m-visited-file-modtime 'visited-file-modtime) modtime) ((integerp (cdr-safe modtime)) ;; XEmacs version returns `(0 . 0)' if no file is visited. (if (and (= (car modtime) 0) (= (cdr modtime) 0)) 0 (list (car modtime) (cdr modtime)))) (t modtime)))) (defmacro w3m-interactive-p () (condition-case nil (progn (eval '(called-interactively-p 'any)) ;; Emacs >=23.2 '(called-interactively-p 'any)) ;; Emacs <23.2 (wrong-number-of-arguments '(called-interactively-p)) ;; Old ones (void-function '(interactive-p)))) (defalias 'w3m-force-mode-line-update (if (fboundp 'force-mode-line-update) 'force-mode-line-update 'redraw-modeline)) ;; `flet' and `labels' got obsolete since Emacs 24.3. (defmacro w3m-flet (bindings &rest body) "Make temporary overriding function definitions. This is an analogue of a dynamically scoped `let' that operates on the function cell of FUNCs rather than their value cell. \(fn ((FUNC ARGLIST BODY...) ...) FORM...)" (require 'cl) (if (fboundp 'cl-letf) `(cl-letf ,(mapcar (lambda (binding) `((symbol-function ',(car binding)) (lambda ,@(cdr binding)))) bindings) ,@body) `(flet ,bindings ,@body))) (put 'w3m-flet 'lisp-indent-function 1) (def-edebug-spec w3m-flet ((&rest (sexp sexp &rest form)) &rest form)) (defmacro w3m-labels (bindings &rest body) "Make temporary function bindings. The bindings can be recursive and the scoping is lexical, but capturing them in closures will only work if `lexical-binding' is in use. But in Emacs 24.2 and older, the lexical scoping is handled via `lexical-let' rather than relying on `lexical-binding'. \(fn ((FUNC ARGLIST BODY...) ...) FORM...)" `(,(progn (require 'cl) (if (fboundp 'cl-labels) 'cl-labels 'labels)) ,bindings ,@body)) (put 'w3m-labels 'lisp-indent-function 1) (def-edebug-spec w3m-labels ((&rest (sexp sexp &rest form)) &rest form)) (eval-when-compile (require 'wid-edit)) (defun w3m-widget-type-convert-widget (widget) "Convert the car of `:args' as a widget type in WIDGET." (require 'wid-edit) (w3m-flet ((widget-sexp-value-to-internal (widget value) value)) (apply 'widget-convert (widget-type widget) (eval (car (widget-get widget :args)))))) ;;; Punycode RFC 3492: (defconst w3m-puny-code-regex "xn--\\([-0-9a-zA-z]+\\)") (defconst w3m-puny-code-nonascii "[^\000-\177]") (defconst w3m-puny-base 36) (defconst w3m-puny-tmin 1) (defconst w3m-puny-tmax 26) (defconst w3m-puny-damp 700) (defconst w3m-puny-skew 38) (defconst w3m-puny-initial-bias 72) (defconst w3m-puny-initial-n 128) (defconst w3m-puny-delimiter ?-) (defun w3m-puny-adapt (delta numpoints firsttime) (let ((k 0)) (if firsttime (setq delta (/ delta w3m-puny-damp)) (setq delta (/ delta 2))) (setq delta (+ delta (/ delta numpoints))) (while (> delta (/ (* (- w3m-puny-base w3m-puny-tmin) w3m-puny-tmax) 2)) (setq delta (/ delta (- w3m-puny-base w3m-puny-tmin))) (setq k (+ k w3m-puny-base))) (+ k (/ (* (1+ (- w3m-puny-base w3m-puny-tmin)) delta) (+ delta w3m-puny-skew))))) (defun w3m-puny-decode-digit (cp) (if (< (- cp 48) 10) (- cp 22) (if (< (- cp 65) 26) (- cp 65) (if (< (- cp 97) 26) (- cp 97) w3m-puny-base)))) (defun w3m-puny-encode-digit (d) (if (< d 26) (+ d 22 75) ;; a-z (+ d 22))) ;; 0-9 (defun w3m-puny-decode1 (input) (let* ((n w3m-puny-initial-n) (bias w3m-puny-initial-bias) (len (length input)) (in 0) (out 0) (i 0) (b 0) digit thr oldi w k output ret) (dotimes (j len) (if (= (aref input j) w3m-puny-delimiter) (setq b j))) (dotimes (j b) (setq output (cons (aref input j) output)) (setq out (1+ out))) (setq output (nreverse output)) (if (> b 0) (setq in (1+ b)) (setq in 0)) (while (< in len) (setq oldi i) (setq w 1) (setq k w3m-puny-base) (catch 'loop (while t (if (>= in len) (error "punycode bad input")) (setq digit (w3m-puny-decode-digit (aref input in))) (if (>= digit w3m-puny-base) (error "punycode bad input")) (setq in (1+ in)) (setq i (+ i (* digit w))) (if (<= k bias) (setq thr w3m-puny-tmin) (if (>= k (+ bias w3m-puny-tmax)) (setq thr w3m-puny-tmax) (setq thr (- k bias)))) (if (< digit thr) (throw 'loop nil)) (setq w (* w (- w3m-puny-base thr))) (setq k (+ k w3m-puny-base)))) (setq out (1+ out)) (setq bias (w3m-puny-adapt (- i oldi) out (= oldi 0))) (setq n (+ n (/ i out))) (setq i (% i out)) (if (= i 0) (setq output (cons n (nthcdr i output))) (setcdr (nthcdr (1- i) output) (cons n (nthcdr i output)))) (setq i (1+ i))) (setq ret (make-string (* out 2) ?a)) (let ((j 0)) (dolist (op output) (aset ret j (/ op 256)) (setq j (1+ j)) (aset ret j (% op 256)) (setq j (1+ j)))) ret)) (defun w3m-puny-decode (input) (condition-case nil (save-match-data (decode-coding-string (w3m-puny-decode1 (substring input 4)) ;; xn-- w3m-puny-utf-16be)) (error input))) (defun w3m-puny-decode-url (url) "Decode URL from punycode." (let ((case-fold-search t) prot host after) (when (and w3m-puny-utf-16be (string-match w3m-puny-code-regex url)) (when (string-match "\\`[^:/]+://\\([^/]+\\)" url) (setq prot (substring url 0 (match-beginning 1))) (setq host (substring url (match-beginning 1) (match-end 1))) (setq after (substring url (match-end 0))) (while (string-match w3m-puny-code-regex host) (setq host (concat (substring host 0 (match-beginning 0)) (w3m-puny-decode (substring host (match-beginning 0) (match-end 0))) (substring host (match-end 0))))) (setq url (concat prot host after)))) url)) (defun w3m-puny-encode1 (input) (let* ((len (length input)) (h-len (/ len 2)) (n w3m-puny-initial-n) (bias w3m-puny-initial-bias) (delta 0) (out 0) (output (make-string (* len 4) ?a)) h b m q k thr uni) (dotimes (j len) (setq uni (aref input j)) (setq j (1+ j)) (setq uni (+ (* uni 256) (aref input j))) (when (< uni 128) ;; basic (aset output out uni) (setq out (1+ out)))) (setq h out) (setq b out) (when (> b 0) (aset output out w3m-puny-delimiter) (setq out (1+ out))) (while (< h h-len) (setq m 65536) ;; 17bits (dotimes (j len) (setq uni (aref input j)) (setq j (1+ j)) (setq uni (+ (* uni 256) (aref input j))) (if (and (>= uni n) (< uni m)) (setq m uni))) (setq delta (+ delta (* (- m n) (1+ h)))) (setq n m) (dotimes (j len) (setq uni (aref input j)) (setq j (1+ j)) (setq uni (+ (* uni 256) (aref input j))) (when (< uni n) (setq delta (1+ delta)) (if (= delta 0) (error "punycode overflow"))) (when (= uni n) (setq q delta) (setq k w3m-puny-base) (catch 'loop (while t (if (<= k bias) (setq thr w3m-puny-tmin) (if (>= k (+ bias w3m-puny-tmax)) (setq thr w3m-puny-tmax) (setq thr (- k bias)))) (if (< q thr) (throw 'loop nil)) (aset output out (w3m-puny-encode-digit (+ thr (% (- q thr) (- w3m-puny-base thr))))) (setq out (1+ out)) (setq q (/ (- q thr) (- w3m-puny-base thr))) (setq k (+ k w3m-puny-base)))) (aset output out (w3m-puny-encode-digit q)) (setq out (1+ out)) (setq bias (w3m-puny-adapt delta (1+ h) (= h b))) (setq delta 0) (setq h (1+ h)))) (setq delta (1+ delta)) (setq n (1+ n))) (substring output 0 out))) (defun w3m-puny-encode (input) (condition-case nil (concat "xn--" (w3m-puny-encode1 (encode-coding-string input w3m-puny-utf-16be))) (error input))) (defun w3m-puny-encode-url (url) "Encode URL to punycode." (if (and w3m-puny-utf-16be (not (w3m-url-local-p url)) (string-match w3m-puny-code-nonascii url)) (let (beg end idn) (with-temp-buffer (insert url) (goto-char (point-min)) (if (search-forward "://" nil t) (setq beg (point)) (setq beg (point-min))) (if (search-forward "/" nil t) (setq end (1- (point))) (setq end (point-max))) (save-restriction (narrow-to-region beg end) (goto-char (point-min)) (while (re-search-forward "[^.]?[^.\000-\177][^.]*" nil t) (setq idn (match-string-no-properties 0)) (delete-region (match-beginning 0) (match-end 0)) (insert (w3m-puny-encode idn)))) (buffer-substring-no-properties (point-min) (point-max)))) url)) (provide 'w3m-util) ;;; w3m-util.el ends here w3m-el-snapshot-1.4.609+0.20171225.orig/mime-w3m.el0000644000000000000000000001771613127150703017316 0ustar rootroot;;; mime-w3m.el --- mime-view content filter for text ;; Copyright (C) 2001-2005, 2009, 2010, 2012, 2013, 2017 ;; TSUCHIYA Masatoshi ;; Author: TSUCHIYA Masatoshi , ;; Akihiro Arisawa ;; Keywords: HTML, MIME, multimedia, mail, news ;; This file is *NOT* yet part of SEMI (Suite of Emacs MIME Interfaces). ;; 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: ;; To use this module along with a SEMI-based mail client (e.g. ;; Wanderlust), add this one to your ~/.emacs file or ~/.wl.el file: ;; ;; (require 'mime-w3m) ;;; Code: (eval-when-compile (require 'cl) (require 'calist) ;; mime-parse.el should be loaded before mime.el so as not to make ;; `mime-uri-parse-cid' an autoloaded function to which the byte ;; compiler might issue a nonsense warning. (require 'mime-parse) (require 'mime) (require 'w3m) (defvar mime-preview-condition) (defvar mime-setup-enable-inline-html) (defvar mime-view-mode-default-map)) (eval-and-compile (when (featurep 'xemacs) (require 'font))) (defcustom mime-w3m-display-inline-images 'default "*Non-nil means that inline images are displayed. When this option is equal to `default', `w3m-default-display-inline-images' is refered instead of this option, to decide whether inline images are displayed." :group 'w3m :group 'mime-view :type '(radio (const :format "%v " nil) (sexp :format "non-nil " :match (lambda (widget value) (and value (not (eq value 'default)))) :value-to-internal (lambda (widget value) (if (and value (not (equal value "default"))) (widget-sexp-value-to-internal widget value) "t"))) (const default))) (defcustom mime-w3m-safe-url-regexp "\\`cid:" "*Regexp that matches safe url names. Some HTML mails might have the trick of spammers using tags. It is likely to be intended to verify whether you have read the mail. You can prevent your personal informations from leaking by setting this to the regexp which matches the safe url names. The value of the variable `w3m-safe-url-regexp' will be bound with this value. You may set this value to nil if you consider all the urls to be safe." :group 'mime-w3m :type '(choice (regexp :format "%t: %v\n") (const :tag "All URLs are safe" nil))) (defcustom mime-w3m-after-cursor-move-hook '(w3m-print-this-url) "*Hook run each time after the cursor moves in mime-w3m buffers. This hook is called by the `mime-w3m-check-current-position' function by way of `post-command-hook'." :group 'mime-w3m :type 'hook) (defcustom mime-w3m-setup-hook nil "*Hook run at the end of function `mime-w3m-setup'." :group 'mime-w3m :type 'hook) (defvar mime-w3m-message-structure nil) (make-variable-buffer-local 'mime-w3m-message-structure) (defun mime-w3m-insinuate () "Insinuate `mime-w3m' module to SEMI." (setq mime-setup-enable-inline-html nil) (let (flag) (when (boundp 'mime-preview-condition) (w3m-labels ((overwrite (x) (if (symbolp x) (if (eq x 'mime-preview-text/html) (setq flag 'mime-w3m-preview-text/html) (when (eq x 'mime-w3m-preview-text/html) (setq flag t)) x) (if (consp x) (cons (overwrite (car x)) (overwrite (cdr x))) x)))) (setq mime-preview-condition (overwrite mime-preview-condition)))) (unless flag (eval-after-load "mime-view" '(progn (ctree-set-calist-strictly 'mime-preview-condition '((type . text) (subtype . html) (body . visible) (body-presentation-method . mime-w3m-preview-text/html))) (set-alist 'mime-view-type-subtype-score-alist '(text . html) 3)))))) (defun mime-w3m-setup () "Setup `mime-w3m' module." (require 'w3m) (when (eq mime-w3m-display-inline-images 'default) (setq mime-w3m-display-inline-images w3m-default-display-inline-images)) (unless (assq 'mime-view-mode w3m-cid-retrieve-function-alist) (push (cons 'mime-view-mode 'mime-w3m-cid-retrieve) w3m-cid-retrieve-function-alist)) (run-hooks 'mime-w3m-setup-hook)) (def-edebug-spec mime-w3m-save-background-color t) (defmacro mime-w3m-save-background-color (&rest body) (if (featurep 'xemacs) `(let ((color (color-name (face-background 'default)))) (prog1 (progn ,@body) (font-set-face-background 'default color (current-buffer)))) (cons 'progn body))) ;;;###autoload (defun mime-w3m-preview-text/html (entity situation) (mime-w3m-setup) (setq mime-w3m-message-structure (mime-find-root-entity entity)) (let ((p (point)) (xref (or (mime-entity-fetch-field entity "xref") (mime-entity-fetch-field mime-w3m-message-structure "xref")))) (goto-char p) (insert "\n") (goto-char p) (mime-w3m-save-background-color (save-restriction (narrow-to-region p p) (mime-insert-text-content entity) (run-hooks 'mime-text-decode-hook) (condition-case err (let ((w3m-safe-url-regexp mime-w3m-safe-url-regexp) (w3m-display-inline-images mime-w3m-display-inline-images) w3m-force-redisplay) (w3m-region p (point-max) (and (stringp xref) (string-match "\\`http://" xref) xref) (mime-content-type-parameter (mime-entity-content-type entity) "charset")) (add-text-properties p (point-max) (list 'keymap w3m-minor-mode-map 'text-rendered-by-mime-w3m t))) (error (message "%s" err))))))) (let (current-load-list) (defadvice mime-display-message (after add-emacs-w3m-functions-to-pre/post-command-hook activate compile) "Advised by emacs-w3m. Add some emacs-w3m utility functions to pre/post-command-hook." (when (featurep 'w3m) (w3m-make-local-hook 'pre-command-hook) (w3m-make-local-hook 'post-command-hook) (add-hook 'pre-command-hook 'w3m-store-current-position nil t) (add-hook 'post-command-hook 'mime-w3m-check-current-position nil t)))) (defun mime-w3m-check-current-position () "Run `mime-w3m-after-cursor-move-hook' if the cursor has been moved." (when (and (/= (point) (car w3m-current-position)) (ignore-errors (or (get-text-property (point) 'text-rendered-by-mime-w3m) (get-text-property (car w3m-current-position) 'text-rendered-by-mime-w3m)))) (run-hooks 'mime-w3m-after-cursor-move-hook))) (defun mime-w3m-cid-retrieve (url &rest args) (let ((entity (mime-find-entity-from-content-id (mime-uri-parse-cid url) (with-current-buffer w3m-current-buffer mime-w3m-message-structure)))) (when entity ;; `mime-decode-string' should be performed in a unibyte buffer. (w3m-insert-string (mime-entity-content entity)) (mime-entity-type/subtype entity)))) (eval (quote ;; Arglist varies according to Emacs version. ;; Emacs 21.1~21.4, 23.3, 24, XEmacs, SXEmacs: ;; (kill-new string &optional replace) ;; Emacs 22.1~23.2: ;; (kill-new string &optional replace yank-handler) (defadvice kill-new (before strip-keymap-properties-from-kill activate) "Advised by emacs-w3m. Strip `keymap' or `local-map' properties from a killed string." (if (text-property-any 0 (length (ad-get-arg 0)) 'text-rendered-by-mime-w3m t (ad-get-arg 0)) (remove-text-properties 0 (length (ad-get-arg 0)) '(keymap nil local-map nil) (ad-get-arg 0)))))) (mime-w3m-insinuate) (provide 'mime-w3m) ;;; mime-w3m.el ends here w3m-el-snapshot-1.4.609+0.20171225.orig/w3m.el0000644000000000000000000147175613215724236016410 0ustar rootroot;;; w3m.el --- an Emacs interface to w3m -*- coding: iso-2022-7bit; -*- ;; Copyright (C) 2000-2017 TSUCHIYA Masatoshi ;; Authors: TSUCHIYA Masatoshi , ;; Shun-ichi GOTO , ;; Satoru Takabayashi , ;; Hideyuki SHIRAI , ;; Keisuke Nishida , ;; Yuuichi Teranishi , ;; Akihiro Arisawa , ;; Katsumi Yamaoka , ;; Tsuyoshi CHO ;; Keywords: w3m, WWW, hypermedia ;; This file is the main 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: ;; Emacs-w3m is an Emacs interface to the w3m program. For more ;; detail about w3m, see: ;; ;; http://w3m.sourceforge.net/ ;;; How to install: ;; See the README file in any case. We also recommend you check ;; whether a newer version of w3m is released. ;; ;; The outline of installation is: run the `configure' script and type ;; `make install' in the top directory of the emacs-w3m distribution. ;;; Code: ;; Developers, you must not use the cl functions (e.g., `coerce', ;; `equalp', `merge', etc.) in any emacs-w3m or shimbun modules. To ;; exclude run-time cl is the policy of emacs-w3m. However, XEmacs ;; employs the cl package for all time, or those functions are ;; possibly provided in the other modules like APEL, so you may use ;; them only in w3m-xmas.el. Note that `caaaar', for example, is not ;; a cl function if it is byte compiled; see cl-macs.el. (eval-when-compile (require 'cl)) (eval-when-compile (unless (dolist (var nil t)) ;; Override the `dolist' macro which may be faultily provided by ;; old egg.el. (load "cl-macs" nil t))) ;; The following variables will be referred to by the external modules ;; which bind such variables only when compiling themselves. And also ;; some modules have the `defadvice' forms including them and run ;; `byte-compile' at run-time. (eval-and-compile (defvar w3m-current-title nil "Title of a page visiting in the current buffer.") (defvar w3m-current-url nil "A url of a page visiting in the current buffer.")) (require 'w3m-util) (require 'w3m-proc) ;; Silence the Emacs's byte-compiler that says ``might not be defined''. (eval-when-compile (defalias 'w3m-setup-menu 'ignore)) (eval-and-compile (cond ((featurep 'xemacs) (require 'w3m-xmas)) ((>= emacs-major-version 21) (require 'w3m-ems)) (t (error "Emacs-w3m of this version no longer supports Emacs %s" (mapconcat 'identity (nbutlast (split-string emacs-version "\\.")) "."))))) (unless (or (featurep 'xemacs) (< emacs-major-version 23)) (require 'bookmark-w3m)) (require 'w3m-fb) (require 'w3m-hist) (require 'timezone) (require 'image-mode nil t) ;; Add-on programs: (eval-and-compile (autoload 'w3m-bookmark-view "w3m-bookmark" "Display the bookmark" t) (autoload 'w3m-bookmark-view-new-session "w3m-bookmark" "Display the bookmark on a new session" t) (autoload 'w3m-bookmark-add-this-url "w3m-bookmark" "Add a link under point to the bookmark." t) (autoload 'w3m-bookmark-add-current-url "w3m-bookmark" "Add a url of the current page to the bookmark." t) (autoload 'w3m-bookmark-add-all-urls "w3m-bookmark" "Add urls of all pages being visited to the bookmark." t) (autoload 'w3m-bookmark-add "w3m-bookmark" "Add URL to bookmark.") (autoload 'w3m-search "w3m-search" "Search a word using search engines." t) (autoload 'w3m-search-new-session "w3m-search" "Search a word using search engines in a new session." t) (autoload 'w3m-search-uri-replace "w3m-search") (autoload 'w3m-weather "w3m-weather" "Display a weather report." t) (autoload 'w3m-about-weather "w3m-weather") (autoload 'w3m-antenna "w3m-antenna" "Report changes of web sites." t) (autoload 'w3m-antenna-add-current-url "w3m-antenna" "Add a link address of the current page to the antenna database." t) (autoload 'w3m-about-antenna "w3m-antenna") (autoload 'w3m-dtree "w3m-dtree" "Display a directory tree." t) (autoload 'w3m-about-dtree "w3m-dtree") (autoload 'w3m-namazu "w3m-namazu" "Search files with Namazu." t) (autoload 'w3m-about-namazu "w3m-namazu") (autoload 'w3m-perldoc "w3m-perldoc" "View Perl documents" t) (autoload 'w3m-about-perldoc "w3m-perldoc") (autoload 'w3m-fontify-forms "w3m-form") (autoload 'w3m-fontify-textareas "w3m-form") (autoload 'w3m-form-textarea-file-cleanup "w3m-form") (autoload 'w3m-form-textarea-files-remove "w3m-form") (autoload 'w3m-form-kill-buffer "w3m-form") (autoload 'w3m-form-set-number "w3m-form") (autoload 'w3m-form-expand-form "w3m-form") (autoload 'w3m-form-unexpand-form "w3m-form") (autoload 'w3m-form-make-form-data "w3m-form") (autoload 'w3m-filter "w3m-filter") (autoload 'w3m-toggle-filtering "w3m-filter" "Toggle whether web pages will have their html modified by w3m's \ filters before being rendered." t) (autoload 'w3m-setup-tab-menu "w3m-tabmenu") (autoload 'w3m-setup-bookmark-menu "w3m-bookmark") (autoload 'w3m-switch-buffer "w3m-tabmenu") (autoload 'w3m-cookie-set "w3m-cookie") (autoload 'w3m-cookie-get "w3m-cookie") (autoload 'w3m-cookie "w3m-cookie") (autoload 'w3m-about-cookie "w3m-cookie") (autoload 'w3m-cookie-shutdown "w3m-cookie" nil t) (autoload 'report-emacs-w3m-bug "w3m-bug" nil t) (autoload 'w3m-replace-symbol "w3m-symbol" nil t) (autoload 'w3m-mail "w3m-mail" nil t) (autoload 'w3m-lnum-mode "w3m-lnum" nil t) (autoload 'w3m-lnum-follow "w3m-lnum" nil t) (autoload 'w3m-lnum-goto "w3m-lnum" nil t) (autoload 'w3m-lnum-universal "w3m-lnum" nil t) (autoload 'w3m-lnum-toggle-inline-image "w3m-lnum" nil t) (autoload 'w3m-lnum-view-image "w3m-lnum" nil t) (autoload 'w3m-lnum-external-view-this-url "w3m-lnum" nil t) (autoload 'w3m-lnum-edit-this-url "w3m-lnum" nil t) (autoload 'w3m-lnum-print-this-url "w3m-lnum" nil t) (autoload 'w3m-lnum-download-this-url "w3m-lnum" nil t) (autoload 'w3m-lnum-bookmark-add-this-url "w3m-lnum" nil t) (autoload 'w3m-lnum-zoom-in-image "w3m-lnum" nil t) (autoload 'w3m-lnum-zoom-out-image "w3m-lnum" nil t) (autoload 'w3m-session-select "w3m-session" "Select session from session list." t) (autoload 'w3m-session-save "w3m-session" "Save list of displayed session." t) (autoload 'w3m-setup-session-menu "w3m-session") (autoload 'w3m-session-automatic-save "w3m-session") (autoload 'w3m-session-deleted-save "w3m-session") (autoload 'w3m-session-last-autosave-session "w3m-session") (autoload 'w3m-session-goto-session "w3m-session") (autoload 'w3m-session-crash-recovery-save "w3m-session") (autoload 'w3m-session-last-crashed-session "w3m-session") (autoload 'w3m-save-buffer "w3m-save" "Save the current page and its image data locally.")) ;; Avoid byte-compile warnings. (eval-when-compile (autoload 'doc-view-mode "doc-view" nil t) (autoload 'doc-view-mode-p "doc-view") (autoload 'image-backward-hscroll "image-mode" nil t) (autoload 'image-bol "image-mode" nil t) (autoload 'image-eol "image-mode" nil t) (autoload 'image-forward-hscroll "image-mode" nil t) (autoload 'image-mode-setup-winprops "image-mode") (autoload 'image-scroll-down "image-mode" nil t) (autoload 'image-scroll-up "image-mode" nil t) (autoload 'quit-window "window" nil t) (autoload 'rfc2368-parse-mailto-url "rfc2368") (autoload 'widget-convert-button "wid-edit") (autoload 'widget-forward "wid-edit" nil t) (autoload 'widget-get "wid-edit") (autoload 'zone-call "zone") (unless (fboundp 'char-to-int) (defalias 'char-to-int 'identity)) (defvar bidi-paragraph-direction) (defvar doc-view-mode-map) (defvar w3m-bookmark-mode) (defvar w3m-bookmark-menu-items) (defvar w3m-bookmark-menu-items-pre) (defvar w3m-tab-menubar-make-items-preitems) (defvar w3m-session-menu-items-pre) (defvar w3m-session-menu-items)) (defconst emacs-w3m-version (eval-when-compile (let ((rev "$Revision: 1.1695 $")) (and (string-match "\\.\\([0-9]+\\) \\$\\'" rev) (setq rev (- (string-to-number (match-string 1 rev)) 1136)) (format "1.4.%d" (+ rev 50))))) "Version number of this package.") (defgroup w3m nil "Emacs-w3m - the web browser of choice." :group 'hypermedia) (defgroup w3m-face nil "Faces used for emacs-w3m." :group 'w3m :prefix "w3m-") (defcustom w3m-command nil "*Name of the executable file of the w3m command. You normally don't have to specify the value, since emacs-w3m looks for the existing commands in order of w3m, w3mmee and w3m-m17n in the `exec-path' directories in order if it is nil in the beginning. If you want to use the other w3m command, specify the value of this variable explicitly in the .emacs file or customize the value and save it. In this case, you need to restart Emacs and emacs-w3m. That is, there is currently no way to apply the changing of the w3m command to all the emacs-w3m programs safely after loading the w3m.elc module." :group 'w3m :type '(radio (const :format "Not specified " nil) (string :format "Command: %v\n"))) (defcustom w3m-display-ins-del 'auto "*Value of `display_ins_del' option." :group 'w3m :type '(radio (const :format "Delect automatically" auto) (const :format "Use fontify" fontify) (const :format "Use tag" tag) (const :format "No have option" nil))) (defvar w3m-type nil "Type of the w3m command. The valid values include `w3m', `w3mmee', and `w3m-m17n'.") (defvar w3m-compile-options nil "Compile options that the w3m command was built with.") (defvar w3m-version nil "Version string of the w3m command.") ;; Set w3m-command, w3m-type, w3m-version and w3m-compile-options (if noninteractive ;; Don't call the external command when compiling. (unless w3m-command (setq w3m-command "w3m")) (when (or (null w3m-command) (null w3m-type) (null w3m-version) (null w3m-compile-options)) (let ((command (or w3m-command (w3m-which-command "w3m") (w3m-which-command "w3mmee") (w3m-which-command "w3m-m17n")))) (when command (setq w3m-command command) (with-temp-buffer (call-process command nil t nil "-version") (goto-char (point-min)) (when (re-search-forward "version \\(w3m/0\\.[3-9]\ \\(?:\\.[0-9\\]\\)*\\(?:rc[0-9]+\\)?\ \\(?:-stable\\|\\(?:\\+cvs\\(?:-[0-9]+\\.[0-9]+\\)?\\)\\)?\ \\(?:-inu\\|\\(-m17n\\|\\(\\+mee\\)\\)\\)?[^,]*\\)" nil t) (setq w3m-version (match-string 1)) (setq w3m-type (cond ((match-beginning 3) 'w3mmee) ((match-beginning 2) 'w3m-m17n) ((match-beginning 1) 'w3m) (t 'other)))) (when (re-search-forward "options +" nil t) (setq w3m-compile-options (or (split-string (buffer-substring (match-end 0) (point-at-eol)) ",") (list nil))) (when (member "m17n" w3m-compile-options) (setq w3m-type 'w3m-m17n)))))))) (when (not (stringp w3m-command)) (error "\ Install w3m command in `exec-path' or set `w3m-command' variable correctly")) (defcustom w3m-user-agent (concat "Emacs-w3m/" emacs-w3m-version " " w3m-version) "String used for the User-Agent field. See also `w3m-add-user-agent'." :group 'w3m :type 'string) (defcustom w3m-add-user-agent t "Non-nil means add the User-Agent field to the request header. The value of `w3m-user-agent' is used for the field body." :group 'w3m :type 'boolean) (defcustom w3m-language (if (and (boundp 'current-language-environment) ;; In XEmacs 21.5 it may be the one like "Japanese (UTF-8)". (string-match "\\`Japanese" (symbol-value 'current-language-environment))) "Japanese") "*Your preferred language used in emacs-w3m sessions." :group 'w3m :type '(radio (const :format "%v " "Japanese") (const :tag "Other" nil)) :get (lambda (symbol) (let ((value (format "%s" (default-value symbol))) (case-fold-search t)) (prog1 (setq value (if (string-match "\\`japan" value) "Japanese")) (custom-set-default symbol value)))) :set (lambda (symbol value) (custom-set-default symbol (if (equal value "Japanese") "Japanese")))) (defcustom w3m-command-arguments (if (eq w3m-type 'w3mmee) '("-o" "concurrent=0" "-F") nil) "*List of the default arguments passed to the w3m command. See also `w3m-command-arguments-alist'." :group 'w3m :type '(repeat (string :format "Argument: %v\n"))) (defcustom w3m-command-arguments-alist nil "*Alist of regexps matching urls and additional arguments passed to w3m. A typical usage of this variable is to specify whether to use the proxy server for the particular hosts. The first match made will be used. Here is an example of how to set this variable: \(setq w3m-command-arguments-alist '(;; Don't use the proxy server to visit local web pages. (\"^http://\\\\(?:[^/]*\\\\.\\\\)*your-company\\\\.com\\\\(?:/\\\\|$\\\\)\" \"-no-proxy\") ;; Use the proxy server to visit any foreign urls. (\"\" \"-o\" \"http_proxy=http://proxy.your-company.com:8080/\"))) Where the first element matches the url that the scheme is \"http\" and the hostname is either \"your-company.com\" or a name ended with \".your-company.com\", and the proxy server is not used for those hosts. If you are a novice on the regexps, you can use the `w3m-no-proxy-domains' variable instead." :group 'w3m :type '(repeat (cons :format "%v" :indent 4 (regexp :format "%t: %v\n") (repeat :tag "Arguments passed to w3m command" (string :format "Arg: %v\n"))))) (defcustom w3m-no-proxy-domains nil "*List of domain names with which emacs-w3m will not use a proxy server. Each element should be exactly a domain name which means the latter common part of the host names, not a regexp." :group 'w3m :type '(repeat (string :format "Domain name: %v\n"))) (defcustom w3m-command-environment (delq nil (list (if (eq w3m-type 'w3mmee) (cons "W3MLANG" "ja_JP.kterm")) (if (eq system-type 'windows-nt) (cons "CYGWIN" "binmode")) (cons "LC_ALL" "C"))) "*Alist of environment variables for subprocesses to inherit." :group 'w3m :type '(repeat (cons :format "%v" :indent 4 (string :format "Name: %v\n") (string :format " Value: %v\n")))) (defcustom w3m-fill-column -1 "*Integer used as the value for `fill-column' in emacs-w3m buffers. If it is positive, pages will be displayed within the columns of that number. If it is zero or negative, the number of columns which subtracted that number from the window width is applied to the maximum width of pages. Note that XEmacs does not always obey this setting." :group 'w3m :type 'integer) (defcustom w3m-mailto-url-function nil "*Function used to handle the `mailto' urls. Function is called with one argument, just a url. If it is nil, a function specified by the `mail-user-agent' variable will be used for composing mail messages." :group 'w3m :type '(radio (const :tag "Not specified" nil) (function :format "%t: %v\n"))) (defcustom w3m-mailto-url-popup-function-alist '((cmail-mail-mode . pop-to-buffer) (mail-mode . pop-to-buffer) (message-mode . pop-to-buffer) (mew-draft-mode . pop-to-buffer) (mh-letter-mode . pop-to-buffer) (wl-draft-mode . pop-to-buffer)) "*Alist of (MAJOR-MODE . FUNCTION) pairs used to pop to a mail buffer up. If a user clicks on a `mailto' url and a mail buffer is composed by `mail-user-agent' with the MAJOR-MODE, FUNCTION will be called with a mail buffer as an argument. Note that the variables `display-buffer-alist' (or `special-display-buffer-names' and `special-display-regexps' for old Emacsen), `same-window-buffer-names' and `same-window-regexps' will be bound to nil while popping to a buffer up." :group 'w3m :type '(repeat (cons :format "%v" :indent 11 (symbol :format "Major-mode: %v\n") (function :format "%t: %v\n")))) (defcustom w3m-use-mule-ucs (and (eq w3m-type 'w3m) (featurep 'un-define)) "*Non-nil means use the multi-script support with Mule-UCS." :group 'w3m :type 'boolean :require 'w3m-ucs) (when w3m-use-mule-ucs (condition-case nil (require 'w3m-ucs) (error (setq w3m-use-mule-ucs nil)))) (defcustom w3m-use-ange-ftp nil "*Non-nil means that `ange-ftp' or `efs' is used to access FTP servers." :group 'w3m :type 'boolean) (defcustom w3m-doc-view-content-types (condition-case nil (delq nil (mapcar (lambda (type) (if (doc-view-mode-p type) (format "application/%s" type))) '(dvi postscript pdf))) (error nil)) "List of content types for which to use `doc-view-mode' to view contents. This overrides `w3m-content-type-alist'." :group 'w3m :type '(repeat (string :tag "Type" :value "application/"))) (defcustom w3m-imitate-widget-button '(eq major-mode 'gnus-article-mode) "*If non-nil, imitate the widget buttons on link (anchor) buttons. It is useful for moving about in a Gnus article buffer using TAB key. It can also be any Lisp form that should return a boolean value." :group 'w3m :type 'sexp) (defcustom w3m-treat-image-size t "*Non-nil means let w3m mind the ratio of the size of images and text. If it is non-nil, the w3m command will make a halfdump which reserves rectangle spaces in which images will be put, and also `alt' texts will be truncated or padded with spaces so that their display width will be the same as the width of images. See also `w3m-pixels-per-character' and `w3m-pixels-per-line'. Those values will be passed to the w3m command in order to compute columns and lines which images occupy." :group 'w3m :type 'boolean) (defcustom w3m-pixels-per-line 64 "*Integer used for the `-ppl' argument of the w3m command. If nil, the height of the default face is used. It is valid only when `w3m-treat-image-size' is non-nil. Note that a small value may not induce a good result. If you want to use emacs-w3m in a character terminal and make `w3m-treat-image-size' effective, you need to set this variable properly." :group 'w3m :type '(choice (const :tag "Auto Detect" nil) (integer :tag "Specify Pixels"))) (defcustom w3m-pixels-per-character nil "*Integer used for the `-ppc' argument of the w3m command. If nil, the width of the default face is used. It is valid only when `w3m-treat-image-size' is non-nil. If you want to use emacs-w3m in a character terminal and make `w3m-treat-image-size' effective, you need to set this variable properly." :group 'w3m :type '(radio (const :tag "Auto Detect" nil) (integer :format "Specify Pixels: %v\n"))) (defcustom w3m-image-default-background nil "Color name used as transparent color of image. Nil means to use the background color of the Emacs frame. Note that this value is effective only to xbm and monochrome pbm images in Emacs 22 and greater." :group 'w3m :type '(radio (string :format "Color: %v\n" :match (lambda (widget value) (and (stringp value) (> (length value) 0)))) (const :tag "Use the background color of the Emacs frame" nil) (const :tag "Null string" ""))) (defvar w3m-accept-japanese-characters (and (not noninteractive) (featurep 'mule) (or (memq w3m-type '(w3mmee w3m-m17n)) ;; Examine whether the w3m command specified by `w3m-command' ;; uses `euc-japan' for the internal character set. (let ((str (eval-when-compile (format (concat "" "" "%s\n") (string 27 36 66 52 65 59 122 27 40 66))))) (with-temp-buffer (set-buffer-multibyte nil) (insert str) (let ((coding-system-for-write 'binary) (coding-system-for-read 'binary) (default-process-coding-system (cons 'binary 'binary))) (call-process-region (point-min) (point-max) w3m-command t t nil "-T" "text/html" "-halfdump") (goto-char (point-min)) (and (re-search-forward (string ?\264 ?\301 ?\273 ?\372) nil t) t)))))) "Non-nil means that the w3m command accepts Japanese characters.") (defcustom w3m-coding-system (if (featurep 'mule) (if (eq w3m-type 'w3mmee) 'iso-2022-7bit-ss2 'iso-2022-7bit) 'iso-8859-1) "*Default coding system used to communicate with the w3m command." :group 'w3m :type 'coding-system) (defcustom w3m-terminal-coding-system (if w3m-accept-japanese-characters 'euc-japan 'iso-8859-1) "*Default coding system used when writing to w3m processes. It is just a default value to set process' coding system initially. \(This variable name is analogically derived from the behavior of the w3m command which accepts data from Emacs just like reads from the terminal.)" :group 'w3m :type 'coding-system) (defcustom w3m-output-coding-system (cond ((not (featurep 'mule)) 'iso-8859-1) ((eq w3m-type 'w3mmee) 'ctext) ((eq w3m-type 'w3m-m17n) (if (and (w3m-find-coding-system 'utf-8) (not (and (equal "Japanese" w3m-language) (featurep 'w3m-ems) (= emacs-major-version 21)))) 'utf-8 'iso-2022-7bit-ss2)) (w3m-accept-japanese-characters 'w3m-euc-japan) (t 'w3m-iso-latin-1)) "*Coding system used when reading from w3m processes." :group 'w3m :type 'coding-system) (defcustom w3m-input-coding-system (if (memq w3m-type '(w3mmee w3m-m17n)) w3m-output-coding-system (if w3m-accept-japanese-characters (if w3m-use-mule-ucs 'w3m-euc-japan-mule-ucs (if (featurep 'w3m-ems) 'w3m-euc-japan 'euc-japan)) (if w3m-use-mule-ucs 'w3m-iso-latin-1-mule-ucs (if (featurep 'w3m-ems) 'w3m-iso-latin-1 'iso-8859-1)))) "*Coding system used when writing to w3m processes. It overrides `coding-system-for-write' if it is not `binary'. Otherwise, the value of the `w3m-current-coding-system' variable is used instead." :group 'w3m :type 'coding-system) (defcustom w3m-file-coding-system (if (featurep 'mule) 'iso-2022-7bit 'iso-8859-1) "*Coding system used when writing configuration files. This value will be referred to by the `w3m-save-list' function." :group 'w3m :type 'coding-system) (defvar w3m-file-coding-system-for-read nil "*Coding system used when reading configuration files. It is strongly recommended that you do not set this variable if there is no particular reason. The value will be referred to by the `w3m-load-list' function.") (defcustom w3m-file-name-coding-system (if (memq system-type '(windows-nt OS/2 emx)) 'shift_jis 'euc-japan) "*Coding system used to convert pathnames when emacs-w3m accesses files." :group 'w3m :type 'coding-system) (defcustom w3m-default-coding-system (if (equal "Japanese" w3m-language) 'shift_jis 'iso-8859-1) "*Default coding system used to encode url strings and post-data." :group 'w3m :type 'coding-system) (defcustom w3m-coding-system-priority-list (if (equal "Japanese" w3m-language) '(shift_jis)) "*Coding systems in order of priority used for emacs-w3m sessions." :group 'w3m :type '(repeat (coding-system :format "%t: %v\n"))) (defcustom w3m-url-coding-system-alist '(("\\`https?://\\(?:[^./?#]+\\.\\)+google\\(?:\\.[^./?#]+\\)+/" . (lambda (url) (if (string-match "&ie=\\([^&]+\\)" url) (w3m-charset-to-coding-system (match-string 1 url))))) (nil . utf-8)) "Alist of url regexps and coding systems used to encode url to retrieve. The form looks like: ((\"REGEXP\" . CODING) (\"REGEXP\" . CODING)...(nil . CODING)) Where REGEXP is a regular expression that matches a url. REGEXP nil means any url; element of which the car is nil, that is the default, has to be the last item of this alist. CODING is a coding system used to encode a url that REGEXP matches. CODING nil means using the coding system corresponding to a charset used to encode the current page. CODING may also be a function that takes one argument URL and returns a coding system. If the example.com site requires a browser to use `shift_jis' to encode url for example, you can add it to this variable as follows: \(add-to-list 'w3m-url-coding-system-alist '(\"\\\\`https?://\\\\(?:[^./?#]+\\\\.\\\\)*example\\\\.com/\" . shift_jis))" :group 'w3m :type '(repeat (cons :format "%v" :indent 2 (radio :format "%v" (const :format "Any " nil) regexp) (radio :format "%v" (const :format "Page's coding system " nil) coding-system)))) (defcustom w3m-key-binding nil "*Type of key binding set used in emacs-w3m sessions. The valid values include `info' which provides Info-like keys, and nil which provides Lynx-like keys." :group 'w3m :type '(choice (const :tag "Use Info-like key mapping." info) (const :tag "Use Lynx-like key mapping." nil)) ;; Since the following form won't be byte-compiled, you developers ;; should never use CL macros like `caaaar', `when', `unless' ... :set (lambda (symbol value) (prog1 (custom-set-default symbol value) (if (or noninteractive ;; Loading w3m.elc is just in progress... (not (featurep 'w3m))) nil (if (and;; Gnus binds `w3m-mode-map' for compiling. (boundp 'w3m-mode-map) (boundp 'w3m-info-like-map) (boundp 'w3m-lynx-like-map)) ;; It won't be bound at the first time. (eval '(setq w3m-mode-map (if (eq value 'info) w3m-info-like-map w3m-lynx-like-map) w3m-minor-mode-map (w3m-make-minor-mode-keymap)))) (let ((buffers (buffer-list))) (save-current-buffer (while buffers (set-buffer (car buffers)) (if (eq major-mode 'w3m-mode) (condition-case nil (progn (use-local-map (symbol-value 'w3m-mode-map)) (w3m-setup-toolbar) (w3m-setup-menu)) (error))) (setq buffers (cdr buffers))))))))) (defcustom w3m-use-cygdrive (eq system-type 'windows-nt) "*If non-nil, use the /cygdrive/ rule when performing `expand-file-name'." :group 'w3m :type 'boolean) (eval-and-compile (defconst w3m-treat-drive-letter (memq system-type '(windows-nt OS/2 emx)) "Say whether the system uses drive letters.")) (defcustom w3m-profile-directory (concat "~/." (file-name-sans-extension (file-name-nondirectory w3m-command))) "*Directory where emacs-w3m config files are loaded from or saved to." :group 'w3m :type 'directory) (defcustom w3m-init-file "~/.emacs-w3m" "*Your emacs-w3m startup file name. If a file with the `.el' or `.elc' suffixes exists, it will be read instead. Nil means no init file will be loaded. Note: This file is used as the startup configuration *NOT* for the w3m command but for emacs-w3m. In order to modify configurations for the w3m command, edit the file named \"~/.w3m/config\" normally." :group 'w3m :type '(radio file (const :format "None " nil))) (defcustom w3m-default-save-directory (concat "~/." (file-name-sans-extension (file-name-nondirectory w3m-command))) "*Default directory where downloaded files will be saved to." :group 'w3m :type 'directory) (defcustom w3m-external-view-temp-directory w3m-profile-directory "Directory where files are saved for the external file viewer." :group 'w3m :type 'directory) (defcustom w3m-default-directory nil "*Directory used as the current directory in emacs-w3m buffers. The valid values include a string specifying an existing directory, a symbol of which the value specifies an existing directory, a function which takes a url as an argument and returns a directory, and nil. If the specified directory does not exist or it is nil, the value of `w3m-profile-directory' is used. Note that there is an exception: if a page visits a local file or visits a remote file using ftp, the directory in which the file exists is used as the current directory instead." :group 'w3m :type '(radio (directory :format "%{%t%}: %v\n" :value "~/") (symbol :format "%{%t%}: %v\n" :match (lambda (widget value) value) :value default-directory) (function :format "%{%t%}: %v\n") (const nil))) (defcustom w3m-accept-languages (let ((file (expand-file-name "config" w3m-profile-directory))) (or (when (file-readable-p file) (with-temp-buffer (insert-file-contents file) (goto-char (point-min)) (when (re-search-forward "^accept_language[\t ]+\\(.+\\)$" nil t) (delete "" (split-string (match-string 1) "[ \t\r\f\n]*,[ \t\r\f\n]*"))))) (when (string= w3m-language "Japanese") '("ja" "en")))) "*List of acceptable languages in descending order of priority. The default value is set according to the accept_language entry of the w3m configuration file (normally \"~/.w3m/config\")." :group 'w3m :type '(repeat (string :format "Lang: %v\n"))) (defcustom w3m-delete-duplicated-empty-lines t "*Non-nil means display two or more continuous empty lines into single." :group 'w3m :type 'boolean) (defvar w3m-display-inline-images nil "Internal variable controls whether to show images in emacs-w3m buffers. This variable is buffer-local which defaults to the value of `w3m-default-display-inline-images'. Don't set it directly; modify the `w3m-default-display-inline-images' variable or use the\ `\\\\[w3m-toggle-inline-images]' command to change the appearance of images. See also `w3m-toggle-inline-images-permanently'.") (make-variable-buffer-local 'w3m-display-inline-images) (defcustom w3m-default-display-inline-images nil "*Non-nil means display images inline in emacs-w3m buffers. You can toggle the visibility of images by the\ `\\\\[w3m-toggle-inline-images]' command. See also `w3m-toggle-inline-images-permanently'." :group 'w3m :type 'boolean) (defcustom w3m-toggle-inline-images-permanently t "*Non-nil means let the visibility of images continue permanently. The visibility of images is initialized according to `w3m-default-display-inline-images' at the first time, and except that it may be toggled by the `\\\\[w3m-toggle-inline-images]'\ command, it does not change hereafter, if it is non-nil. Otherwise, whether images are visible is initialized according to `w3m-default-display-inline-images' whenever you visit a new page or reload the current page in an emacs-w3m buffer." :group 'w3m :type 'boolean) (defcustom w3m-icon-directory (let (dir) (or (catch 'found-dir (let* ((path (locate-library "w3m")) (paths (if path (cons (file-name-directory path) load-path) load-path))) (while paths (setq path (car paths) paths (cdr paths)) (if path (progn (if (file-directory-p (setq dir (expand-file-name "../../etc/images/w3m/" path))) (throw 'found-dir dir)) (if (file-directory-p (setq dir (expand-file-name "../etc/images/w3m/" path))) (throw 'found-dir dir)) (if (file-directory-p (setq dir (expand-file-name "../../etc/w3m/icons/" path))) (throw 'found-dir dir)) (if (file-directory-p (setq dir (expand-file-name "../etc/w3m/icons/" path))) (throw 'found-dir dir))))))) (and (fboundp 'locate-data-directory) (or (locate-data-directory "images/w3m") (locate-data-directory "w3m"))) (and (file-directory-p (setq dir (expand-file-name "images/w3m/" data-directory))) dir) (and (file-directory-p (setq dir (expand-file-name "w3m/icons/" data-directory))) dir))) "*Directory where emacs-w3m should find icon files." :group 'w3m :type '(radio (const :tag "Not specified") (directory :format "%t: %v\n"))) (defcustom w3m-broken-proxy-cache nil "*Set it to t if the proxy server seems not to work properly in caching. Note that this may be the double-edged sword; setting it to t will likely be harmful if the proxy server sends bad requests (e.g., not including the Host header, see RFC2616 section 14.23) to foreign servers when the w3m command specifies the \"no-cache\" directive. Also note that it may not be effective if you are using old w3m command." :group 'w3m :type 'boolean) (defcustom w3m-quick-start t "*Non-nil means let emacs-w3m start quickly w/o requiring confirmation. When you invoke the `w3m' command, it attempts to visit the page of a string like url around the cursor or the value of `w3m-home-page'. You won't be asked for the confirmation then if this value is non-nil. Otherwise, you will be prompted for that url with the editing form." :group 'w3m :type 'boolean) (defcustom w3m-home-page (or (getenv "HTTP_HOME") (getenv "WWW_HOME") "about:") "*This variable specifies the url string to open when emacs-w3m starts. Don't say HP, which is the abbreviated name of a certain company. ;-)" :group 'w3m :type '(radio :convert-widget w3m-widget-type-convert-widget `(,@(if (getenv "HTTP_HOME") `((const :format "HTTP_HOME: \"%v\"\n" ,(getenv "HTTP_HOME")))) ,@(if (getenv "WWW_HOME") `((const :format "WWW_HOME: \"%v\"\n" (getenv "WWW_HOME")))) (const :tag "About emacs-w3m" "about:") (const :tag "Blank page" "about:blank") (string :format "URL: %v\n")))) (defcustom w3m-arrived-file (expand-file-name ".arrived" w3m-profile-directory) "*Name of the file to keep the arrived URLs database." :group 'w3m :type 'file) (defcustom w3m-keep-arrived-urls 500 "*Maximum number of URLs which the arrived URLs database keeps." :group 'w3m :type 'integer) (defcustom w3m-prefer-cache nil "*Non-nil means that cached contents are used without checking headers." :group 'w3m :type 'boolean) (defcustom w3m-keep-cache-size 300 "*Maximum number of pages to be cached in emacs-w3m." :group 'w3m :type 'integer) (defcustom w3m-follow-redirection 9 "*Maximum number of redirections which emacs-w3m honors and follows. If nil, redirections are followed by the w3m command. Don't set it to nil if you allow to use cookies (i.e., you have set `w3m-use-cookies' to non-nil) since cookies may be shared among many redirected pages." :group 'w3m :type '(radio (const :format "Ignore redirections " nil) integer)) (defcustom w3m-redirect-with-get t "*If non-nil, use the GET method after redirection. It controls how emacs-w3m works when a server responds the code 301 or 302. Here is an extract from RFC2616: Note: RFC 1945 and RFC 2068 specify that the client is not allowed to change the method on the redirected request. However, most existing user agent implementations treat 302 as if it were a 303 response, performing a GET on the Location field-value regardless of the original request method." :group 'w3m :type 'boolean) (defcustom w3m-resize-image-scale 50 "*Number of steps in percent used when resizing images." :group 'w3m :type 'integer) (defface w3m-anchor '((((class color) (background light)) (:foreground "blue")) (((class color) (background dark)) (:foreground "cyan")) (t (:underline t))) "Face used for displaying anchors." :group 'w3m-face) ;; backward-compatibility alias (put 'w3m-anchor-face 'face-alias 'w3m-anchor) (defface w3m-arrived-anchor '((((class color) (background light)) (:foreground "navy")) (((class color) (background dark)) (:foreground "LightSkyBlue")) (t (:underline t))) "Face used for displaying anchors which have already arrived." :group 'w3m-face) ;; backward-compatibility alias (put 'w3m-arrived-anchor-face 'face-alias 'w3m-arrived-anchor) (defface w3m-current-anchor '((t (:underline t :bold t))) "Face used to highlight the current anchor." :group 'w3m-face) ;; backward-compatibility alias (put 'w3m-current-anchor-face 'face-alias 'w3m-current-anchor) (defface w3m-image '((((class color) (background light)) (:foreground "ForestGreen")) (((class color) (background dark)) (:foreground "PaleGreen")) (t (:underline t))) "Face used for displaying alternate strings of images." :group 'w3m-face) ;; backward-compatibility alias (put 'w3m-image-face 'face-alias 'w3m-image) (defface w3m-image-anchor '((((class color) (background light)) (:background "light yellow")) (((class color) (background dark)) (:background "dark green")) (t (:underline t))) "Face used for displaying alternate strings of images which are in anchors." :group 'w3m-face) ;; backward-compatibility alias (put 'w3m-image-anchor-face 'face-alias 'w3m-image-anchor) (defface w3m-history-current-url ;; The following strange code compounds the attributes of the ;; `secondary-selection' face and the `w3m-arrived-anchor' face, ;; and generates the new attributes for this face. (let ((base 'secondary-selection) (fn (if (featurep 'xemacs) 'face-custom-attributes-get 'custom-face-attributes-get));; What a perverseness it is. ;; Both `face-custom-attributes-get' in XEmacs and ;; `custom-face-attributes-get' in CUSTOM 1.9962 attempt to ;; require `font' in Emacs/w3 and `cl' arbitrarily. :-/ (features (cons 'font features)) base-attributes attributes attribute) (setq base-attributes (funcall fn base nil) attributes (funcall fn 'w3m-arrived-anchor nil)) (while base-attributes (setq attribute (car base-attributes)) (unless (memq attribute '(:foreground :underline)) (setq attributes (plist-put attributes attribute (cadr base-attributes)))) (setq base-attributes (cddr base-attributes))) (list (list t attributes))) "Face used to highlight the current url in the \"about://history/\" page." :group 'w3m-face) ;; backward-compatibility alias (put 'w3m-history-current-url-face 'face-alias 'w3m-history-current-url) (defface w3m-bold '((t (:bold t))) "Face used for displaying bold text." :group 'w3m-face) ;; backward-compatibility alias (put 'w3m-bold-face 'face-alias 'w3m-bold) (defface w3m-italic '((((type nil)) (:underline t)) (t (:italic t))) "Face used for displaying italic text. By default it will be a underline face on a non-window system." :group 'w3m-face) ;; backward-compatibility alias (put 'w3m-italic-face 'face-alias 'w3m-italic) (defface w3m-underline '((t (:underline t))) "Face used for displaying underlined text." :group 'w3m-face) ;; backward-compatibility alias (put 'w3m-underline-face 'face-alias 'w3m-underline) (defface w3m-strike-through `((((class color)) ,(if (featurep 'xemacs) '(:strikethru t) '(:strike-through t))) (t (:underline t))) "Face used for displaying strike-through text." :group 'w3m-face) ;; backward-compatibility alias (put 'w3m-strike-through-face 'face-alias 'w3m-strike-through) (defface w3m-insert '((((class color) (background light)) (:foreground "purple")) (((class color) (background dark)) (:foreground "orchid")) (t (:underline t))) "Face used for displaying insert text." :group 'w3m-face) ;; backward-compatibility alias (put 'w3m-insert-face 'face-alias 'w3m-insert) (defcustom w3m-mode-hook nil "*Hook run after `w3m-mode' initialization. This hook is evaluated by the `w3m-mode' function." :group 'w3m :type 'hook) (defcustom w3m-fontify-before-hook nil "*Hook run when starting to fontify emacs-w3m buffers. This hook is evaluated by the `w3m-fontify' function." :group 'w3m :type 'hook) (defcustom w3m-fontify-after-hook nil "*Hook run after fontifying emacs-w3m buffers. This hook is evaluated by the `w3m-fontify' function." :group 'w3m :type 'hook) (defcustom w3m-display-hook '(w3m-move-point-for-localcgi w3m-history-highlight-current-url) "*Hook run after displaying pages in emacs-w3m buffers. Each function is called with a url string as the argument. This hook is evaluated by the `w3m-goto-url' function." :group 'w3m :type 'hook :initialize 'w3m-custom-hook-initialize) (defcustom w3m-after-cursor-move-hook '(w3m-highlight-current-anchor w3m-show-form-hint w3m-print-this-url w3m-auto-show) "*Hook run each time after the cursor moves in emacs-w3m buffers. This hook is called by the `w3m-check-current-position' function by way of `post-command-hook'." :group 'w3m :type 'hook :initialize 'w3m-custom-hook-initialize) (defcustom w3m-delete-buffer-hook '(w3m-pack-buffer-numbers) "*Hook run when every emacs-w3m buffer is deleted." :group 'w3m :type 'hook :initialize 'w3m-custom-hook-initialize) (defcustom w3m-select-buffer-hook nil "*Hook run when a different emacs-w3m buffer is selected." :group 'w3m :type 'hook) (defcustom w3m-async-exec t "*Non-nil means execute the w3m command asynchronously in Emacs process." :group 'w3m :type 'boolean) ;; As far as we know, Emacs 21 under Mac OS X[1] and XEmacs under ;; Solaris[2] won't run the asynchronous operations correctly when ;; both `w3m-async-exec' and `w3m-process-connection-type' are non-nil; ;; [1]the final kilobyte or so might get lost from raw data downloaded ;; from a web site; [2]XEmacs hangs up. (defcustom w3m-process-connection-type (not (or (and (memq system-type '(darwin macos)) (let ((ver (shell-command-to-string "uname -r"))) (and (string-match "^\\([0-9]+\\)\\." ver) (< (string-to-number (match-string 1 ver)) 7)))) (and (featurep 'xemacs) (string-match "solaris" system-configuration)))) "*Value for `process-connection-type' used when communicating with w3m." :group 'w3m :type 'boolean) (defcustom w3m-async-exec-with-many-urls ;; XEmacs 21.5 tends to freeze when retrieving many urls at a time. :-< (not (and (featurep 'xemacs) (not (featurep 'sxemacs)) (= emacs-major-version 21) (= emacs-minor-version 5))) "Non-nil means allow retrieving many urls asynchronously. The value affects how emacs-w3m will work with group:* urls and the `w3m-session-select' feature. If it is nil, the asynchronous operation is inhibited in those cases even if `w3m-async-exec' is non-nil." :group 'w3m :type 'boolean) (defcustom w3m-default-content-type "text/html" "*Default value assumed as the content type of local files." :group 'w3m :type 'string) (require 'mailcap) (mailcap-parse-mailcaps nil t) (mailcap-parse-mimetypes nil t) (defvar w3m-content-type-alist (let ((additions '(("text/sgml" "\\.sgml?\\'" nil "text/plain") ("text/xml" "\\.xml\\'" nil "text/plain") ("text/x-markdown" "\\.md\\'" nil w3m-prepare-markdown-content) ("application/xml" "\\.xml\\'" nil w3m-detect-xml-type) ("application/rdf+xml" "\\.rdf\\'" nil "text/plain") ("application/rss+xml" "\\.rss\\'" nil "text/plain") ("application/xhtml+xml" nil nil "text/html") ("application/x-bzip2" "\\.bz2\\'" nil nil nil) ("application/x-gzip" "\\.gz\\'" nil nil nil))) (extensions (copy-sequence mailcap-mime-extensions)) elem ext type exts tem viewer rest) ;; items w/ file extensions (while (setq elem (pop extensions)) (setq ext (car elem) type (cdr elem)) (unless (zerop (length ext)) (setq exts (list ext)) (while (setq tem (rassoc type extensions)) (unless (or (zerop (length (car tem))) (member (car tem) exts)) (push (car tem) exts)) (setq extensions (delq tem extensions))) (setq viewer (mailcap-mime-info type)) (push (list type (concat (if (cdr exts) (regexp-opt exts) (regexp-quote ext)) "\\'") (when (stringp viewer) viewer) nil) rest))) ;; items w/o file extension (dolist (major mailcap-mime-data) (dolist (minor (cdr major)) (unless (string-match "\\`\\.\\*\\'" (car minor)) (setq type (cdr (assq 'type (cdr minor))) viewer (cdr (assq 'viewer (cdr minor)))) (or (string-match "/\\*\\'" type) (assoc type rest) (push (list type nil (when (stringp viewer) viewer) nil) rest))))) ;; convert viewers (dolist (elem rest) (when (setq viewer (car (cdr (cdr elem)))) (dolist (v (prog1 (split-string viewer) (setq viewer nil))) (push (cond ((string-equal "%s" v) 'file) ((string-equal "%u" v) 'url) (t v)) viewer)) (setcar (cdr (cdr elem)) (nreverse viewer)))) ;; addition (dolist (elem additions) (if (setq tem (assoc (car elem) rest)) (setcdr tem (cdr elem)) ;; overkill? (push elem rest))) (nreverse rest)) "*Alist of content types, regexps, commands to view, and filters. Each element is a list which consists of the following data: 1. Content type. 2. Regexp matching a url or a file name. 3. Method to view contents. The following three types may be used: a. Lisp function which takes the url to view as an argument. b. (\"COMMAND\" [ARG...]) -- where \"COMMAND\" is the external command and ARG's are the arguments passed to the command if any. The symbols `file' and `url' that appear in ARG's will be replaced respectively with the name of a temporary file which contains the contents and the string of the url to view. c. nil which means to download the url into the local file. 4. Content type that overrides the one specified by `1. Content type'. Valid values include: a. Lisp function that takes three arguments URL, CONTENT-TYPE, and CHARSET, and returns a content type. b. String that specifies a content type. c. nil that means not to override the content type.") ;; FIXME: we need to rearrange the complicated and redundant relation of ;; `w3m-encoding-type-alist', `w3m-decoder-alist', and `w3m-encoding-alist'. (defcustom w3m-encoding-type-alist '(("\\.gz\\'" . "gzip") ("\\.bz2?\\'" . "bzip")) "*Alist of file suffixes and content encoding types." :group 'w3m :type '(repeat (cons :format "%v" :indent 14 (string :format "Regexp of Suffixes: %v\n") (string :format "Encoding Type: %v\n")))) (defcustom w3m-decoder-alist `((gzip "gzip" ("-d")) ;; Don't use "gunzip" and "bunzip2" (bzip "bzip2" ("-d")) ;; for broken OS and implementations. (deflate ,(if (not noninteractive) (let ((exec-path (let ((prefix (file-name-directory (directory-file-name (file-name-directory (w3m-which-command w3m-command)))))) (list (expand-file-name "libexec/w3m" prefix) (expand-file-name "lib/w3m" prefix))))) (w3m-which-command "inflate"))) nil)) "Alist of encoding types, decoder commands, and arguments." :group 'w3m :type '(repeat (group :indent 4 (radio :format "Encoding: %v" (const :format "%v " gzip) (const :format "%v " bzip) (const deflate)) (string :format "Command: %v\n") (repeat :tag "Arguments" :extra-offset 2 (string :format "%v\n"))))) (defcustom w3m-charset-coding-system-alist (let ((rest '((us_ascii . raw-text) (us-ascii . raw-text) (gb2312 . cn-gb-2312) (cn-gb . cn-gb-2312) (iso-2022-jp-2 . iso-2022-7bit-ss2) (iso-2022-jp-3 . iso-2022-7bit-ss2) (tis-620 . tis620) (windows-874 . tis-620) (cp874 . tis-620) (x-ctext . ctext) (unknown . undecided) (x-unknown . undecided) (windows-1250 . cp1250) (windows-1251 . cp1251) (windows-1252 . cp1252) (windows-1253 . cp1253) (windows-1254 . cp1254) (windows-1255 . cp1255) (windows-1256 . cp1256) (windows-1257 . cp1257) (windows-1258 . cp1258) (euc-jp . euc-japan) (shift-jis . shift_jis) (shift_jis . shift_jis) (sjis . shift_jis) (x-euc-jp . euc-japan) (x-shift-jis . shift_jis) (x-shift_jis . shift_jis) (x-sjis . shift_jis))) dest) (while rest (or (w3m-find-coding-system (car (car rest))) (setq dest (cons (car rest) dest))) (setq rest (cdr rest))) dest) "Alist of MIME charsets and coding systems. Both charsets and coding systems must be symbols." :group 'w3m :type '(repeat (cons :format "%v" :indent 2 (symbol :format "%t: %v\n") (coding-system :format "%t: %v\n")))) (defcustom w3m-correct-charset-alist '(("windows-874" . "tis-620") ("cp874" . "tis-620") ("cp1250" . "windows-1250") ("cp1251" . "windows-1251") ("cp1252" . "windows-1252") ("cp1253" . "windows-1253") ("cp1254" . "windows-1254") ("cp1255" . "windows-1255") ("cp1256" . "windows-1256") ("cp1257" . "windows-1257") ("cp1258" . "windows-1258") ("shift-jis" . "shift_jis") ("sjis" . "shift_jis") ("x-euc-jp" . "euc-jp") ("x-shift-jis" . "shift_jis") ("x-shift_jis" . "shift_jis") ("x-sjis" . "shift_jis")) "Alist of MIME charsets; strange ones and standard ones." :group 'w3m :type '(repeat (cons :format "%v" :indent 11 (string :format "From: %v\n") (string :format "To: %v\n")))) (defcustom w3m-horizontal-scroll-columns 10 "*Number of steps in columns used when scrolling a window horizontally." :group 'w3m :type 'integer) (defcustom w3m-horizontal-shift-columns 2 "*Number of steps in columns used when shifting a window horizontally. The term `shifting' means a fine level scrolling." :group 'w3m :type 'integer) (defcustom w3m-view-recenter 1 "Recenter window contents when going to an anchor. An integer is passed to `recenter', for instance the default 1 means put the anchor on the second line of the screen. t means `recenter' with no arguments, which puts it in the middle of the screen. nil means don't recenter, let the display follow point in the usual way." :group 'w3m ;; radio items in the same order as in the docstring, and `integer' first ;; because it's the default :type '(radio (integer :format "%{%t%}: %v\n" :value 1 :size 1) (const :format "%t\n" t) (const :format "%t\n" nil))) (defcustom w3m-clear-display-while-reading t "If non-nil, clear the display while reading a new page." :group 'w3m :type 'boolean) (defcustom w3m-use-form t "*Non-nil means make it possible to use form extensions. (EXPERIMENTAL)" :group 'w3m :type 'boolean :require 'w3m-form) (defcustom w3m-submit-form-safety-check nil "Non-nil means ask you for confirmation when submitting a form." :group 'w3m :type 'boolean) (defcustom w3m-use-cookies t "*Non-nil means enable emacs-w3m to use cookies. (EXPERIMENTAL)" :group 'w3m :type 'boolean) (defcustom w3m-use-filter t "*Non-nil means use filter programs to convert web contents. See also `w3m-filter-configuration'." :group 'w3m :type 'boolean :require 'w3m-filter) (defcustom w3m-use-symbol (when (and (featurep 'mule) (eq w3m-type 'w3m-m17n)) (if (eq w3m-output-coding-system 'utf-8) (and (w3m-mule-unicode-p) (or (featurep 'xemacs) (< emacs-major-version 23)) 'w3m-device-on-window-system-p) t)) "*Non-nil means replace symbols that the <_SYMBOL> tags lead into. It is meaningful only when the w3m-m17n command is used and (X)Emacs handles unicode charsets." :group 'w3m :type 'boolean :require 'w3m-symbol) (defcustom w3m-edit-function 'find-file "*Function used for editing local files. It is used when either `w3m-edit-current-url' or `w3m-edit-this-url' is invoked for local pages." :group 'w3m :type '(radio (const :tag "Edit it in the current window" find-file) (const :tag "Edit it in another window" find-file-other-window) (const :tag "Edit it in another frame" find-file-other-frame) (const :tag "View it in another window" view-file-other-window) (function :format "Other function: %v\n" :value view-file))) (defcustom w3m-edit-function-alist '(("\\`[^?]+/hiki\\.cgi\\?" . hiki-edit-url)) "*Alist of functions used for editing pages. This option is referred to decide which function should be used to edit a specified page, when either `w3m-edit-current-url' or `w3m-edit-this-url' is invoked. When no suitable function is found from this alist, `w3m-edit-function' is used." :group 'w3m :type '(repeat (cons :format "%v" :indent 3 (regexp :format "URL: %v\n") (function)))) (defcustom w3m-url-local-directory-alist (when (boundp 'yahtml-path-url-alist) (mapcar (lambda (pair) (cons (cdr pair) (car pair))) (symbol-value 'yahtml-path-url-alist))) "*Alist of URLs and local directories. If directory names of a given URL and the car of an element are the same, emacs-w3m assumes that the file exists in the local directory where the cdr of an element points to. The default value will be set to a value of the `yahtml-path-url-alist' variable which exchanged the car and the cdr in each element if it is available." :type '(repeat (cons :format "%v" :indent 3 (string :format "URL: %v\n") (directory :format "%t: %v\n"))) :group 'w3m) (defcustom w3m-track-mouse t "*Whether to track the mouse and message the url under the mouse. See also `show-help-function' if you are using GNU Emacs. A tip for XEmacs users: You can also use the `balloon-help' feature by the `M-x balloon-help-mode' command with arg 1. If the window manager decorates the balloon-help frame, and that is not to your taste, you may strip it off with the following directives: For ol[v]wm use this in .Xdefaults: olvwm.NoDecor: balloon-help or olwm.MinimalDecor: balloon-help For fvwm version 1 use this in your .fvwmrc: NoTitle balloon-help or Style \"balloon-help\" NoTitle, NoHandles, BorderWidth 0 For twm use this in your .twmrc: NoTitle { \"balloon-help\" } See the balloon-help.el file for more information." :group 'w3m :type 'boolean) (defcustom w3m-use-title-buffer-name nil "Non-nil means use name of buffer included current title." :group 'w3m :type 'boolean) (defcustom w3m-use-japanese-menu (and (equal "Japanese" w3m-language) ;; Emacs 21, XEmacs 21.4 and SXEmacs don't seem to support ;; non-ASCII text in the popup menu. (not (featurep 'sxemacs)) (if (featurep 'xemacs) (or (> emacs-major-version 21) (and (= emacs-major-version 21) (>= emacs-minor-version 5))) (or (>= emacs-major-version 22) (featurep 'meadow)))) "Non-nil means use Japanese characters for Menu if possible." :group 'w3m :type 'boolean) (defcustom w3m-menu-on-forefront nil "Non-nil means place the emacs-w3m menus on the forefront of the menu bar." :group 'w3m :type 'boolean :set (lambda (symbol value) (prog1 (custom-set-default symbol value) (unless noninteractive (w3m-menu-on-forefront value))))) (defcustom w3m-use-tab t "Non-nil means make emacs-w3m a tab browser. It makes it possible to show all emacs-w3m buffers in a single window with the tabs line, and you can choose one by clicking a mouse on it. See also `w3m-use-tab-menubar'." :group 'w3m :type 'boolean) (defcustom w3m-add-tab-number nil "Non-nil means put sequential number to a title on tab." :group 'w3m :type 'boolean) (defcustom w3m-use-tab-menubar t "Non-nil means use the TAB pull-down menu in the menubar. It makes it possible to show all emacs-w3m buffers in a single window, and you can choose one by clicking a mouse on it. This feature requires that Emacs has been built to be able to display multilingual text in the menubar if you often visit web sites written in non-ascii text. See also `w3m-use-tab'." :group 'w3m :type 'boolean) (defcustom w3m-new-session-url "about:blank" "*Default url to be opened in a tab or a session which is created newly." :group 'w3m :type '(radio :convert-widget w3m-widget-type-convert-widget `((const :tag "About emacs-w3m" "about:") (const :tag "Blank page" "about:blank") (const :tag "Bookmark" "about://bookmark/") (const :tag ,(format "Home page (%s)" w3m-home-page) ,w3m-home-page) (string :format "URL: %v\n" :value "http://emacs-w3m.namazu.org")))) (defcustom w3m-make-new-session nil "*Non-nil means making new emacs-w3m buffers when visiting new pages. If it is non-nil and there are already emacs-w3m buffers, the `w3m' command makes a new emacs-w3m buffer if a user specifies a url string in the minibuffer, and the `w3m-safe-view-this-url' command also makes a new buffer if a user invokes it in a buffer not being running the `w3m-mode'." :group 'w3m :type 'boolean) (defcustom w3m-use-favicon t "*Non-nil means show favicon images if they are available. It will be set to nil automatically if ImageMagick's `convert' program does not support the ico format." :get (lambda (symbol) (and (not noninteractive) (default-value symbol) (w3m-favicon-usable-p))) :set (lambda (symbol value) (custom-set-default symbol (and (not noninteractive) value (w3m-favicon-usable-p)))) :group 'w3m :type 'boolean) (defcustom w3m-show-graphic-icons-in-mode-line t "Non-nil means show graphic status indicators in the mode-line. If it is nil, also the favicon won't be shown in the mode-line even if `w3m-use-favicon' is non-nil." :set (lambda (symbol value) (prog1 (custom-set-default symbol value) (if (and (not noninteractive) ;; Make sure it is not the first time. (featurep 'w3m) (fboundp 'w3m-initialize-graphic-icons)) (w3m-initialize-graphic-icons)))) :group 'w3m :type 'boolean) (defcustom w3m-show-graphic-icons-in-header-line t "Non-nil means show graphic status indicators in the header-line. If it is nil, also the favicon won't be shown in the header-line even if `w3m-use-favicon' is non-nil. This variable is currently meaningless under XEmacs." :group 'w3m :type 'boolean) (defcustom w3m-pop-up-windows t "Non-nil means split the windows when a new emacs-w3m session is created. This variable is similar to `pop-up-windows' and quite overridden by `w3m-pop-up-frames' as if `pop-up-frames' influences. Furthermore, if `w3m-use-tab' is non-nil or there is the buffers selection window (for the `w3m-select-buffer' feature), this variable is ignored when creating the second or more emacs-w3m session." :group 'w3m :type 'boolean) (defcustom w3m-pop-up-frames nil "Non-nil means pop to a new frame up for an emacs-w3m session. This variable is similar to `pop-up-frames' and does override `w3m-pop-up-windows'. If `w3m-use-tab' is non-nil or there is the buffers selection window (for the `w3m-select-buffer' feature), this variable is ignored when creating the second or more emacs-w3m session." :group 'w3m :type 'boolean) (defcustom w3m-view-this-url-new-session-in-background nil "*Obsolete." :group 'w3m :type 'boolean) (defcustom w3m-new-session-in-background w3m-view-this-url-new-session-in-background "*Say whether not to focus on a new tab or a new session in target. It influences only when a new emacs-w3m buffer is created." :group 'w3m :type 'boolean) (defcustom w3m-popup-frame-parameters nil "Alist of frame parameters used when creating a new emacs-w3m frame. It allows not only the alist form but also XEmacs's plist form." :group 'w3m :type '(choice (group :inline t :tag "Frame Parameters (Emacs)" (repeat :inline t :tag "Frame Parameters (Emacs)" (cons :format "%v" :indent 3 (symbol :format "Parameter: %v\n") (sexp :format "%t: %v\n")))) (group :inline t :tag "Frame Plist (XEmacs)" (repeat :inline t :tag "Frame Plist (XEmacs)" (group :indent 2 :inline t (symbol :format "Property: %v\n") (sexp :format "%t: %v\n")))))) (defcustom w3m-auto-show t "*Non-nil means provide the ability to horizontally scroll the window. Automatic horizontal scrolling is made when the point gets away from both ends of the window, but nothing occurs if `truncate-lines' is set to nil. This feature works with the specially made program in emacs-w3m; usual `auto-hscroll-mode', `automatic-hscrolling', `auto-show-mode' or `hscroll-mode' will all be invalidated in emacs-w3m buffers." :group 'w3m :type 'boolean) (defcustom w3m-horizontal-scroll-division 4 "*Integer used by the program making the point certainly visible. The cursor definitely does not go missing even when it has been driven out of the window while wandering around anchors and forms in an emacs-w3m buffer. Suppose that the value of this variable is N. When the point is outside the left of the window, emacs-w3m scrolls the window so that the point may be displayed on the position within 1/N of the width of the window from the left. Similarly, when the point is outside the right of the window, emacs-w3m scrolls the window so that the point may be displayed on the position of 1/N of the width of the window from the right. This feature doesn't work if `w3m-auto-show' is nil. The value must be a larger integer than 1." :group 'w3m :type 'integer :set (lambda (symbol value) (custom-set-default symbol (if (and (integerp value) (> value 1)) value 4)))) (defcustom w3m-show-error-information t "*Non-nil means show an error information as a web page. Page is made when the foreign server doesn't respond to a request to retrieve data." :group 'w3m :type 'boolean) (defcustom w3m-use-refresh t "*Non-nil means honor the REFRESH attribute in META tags. Emacs-w3m arbitrarily takes you to a url specified by that attribute except for search results of Google[1]. See also `w3m-refresh-minimum-interval'. [1] URL `https://productforums.google.com/forum/#!topic/websearch/hpzglVb9B5M'" :group 'w3m :type 'boolean) (defcustom w3m-refresh-minimum-interval 5 "Number of seconds used to override the meta refresh a page specifies. If the meta refresh seconds the page specifies is less than this value, this will be used instead of that." :group 'w3m :type 'integer) (defcustom w3m-mbconv-command "mbconv" "*Name of the \"mbconv\" command provided by the \"libmoe\" package. The \"libmoe\" package is used when you use the w3mmee command instead of the w3m command. See also `w3m-command'." :group 'w3m :type 'string) (defcustom w3m-markdown-converter (cond ((w3m-which-command "markdown") '("markdown")) ((w3m-which-command "grip") '("grip" "--quiet" "--title" "" "--export" "-"))) "*List of COMMAND which convert markdown formed files into HTML format and its ARGUMENTS." :group 'w3m :type '(cons (string :format "Command: %v\n") (repeat (string :format "Arguments:\n%v\n")))) (defcustom w3m-local-find-file-regexps (cons nil (concat "\\." (regexp-opt (append '("htm" "html" "shtm" "shtml" "xhtm" "xhtml" "txt") (and w3m-markdown-converter '("md")) (and (w3m-image-type-available-p 'jpeg) '("jpeg" "jpg")) (and (w3m-image-type-available-p 'gif) '("gif")) (and (w3m-image-type-available-p 'png) '("png")) (and (w3m-image-type-available-p 'xbm) '("xbm")) (and (w3m-image-type-available-p 'xpm) '("xpm"))) t) ;; with surrounding parens (for old Emacsen). "\\'")) "*Cons of two regexps matching and not matching with local file names. If a url of the `file:' scheme in which you entered matches the first form and does not match the latter form, it will be opened by the function specified by the `w3m-local-find-file-function' variable. Nil for the regexp matches any file names. For instance, the value `(nil . \"\\\\.[sx]?html?\\\\'\")' allows \"file:///some/where/w3m.el\", not \"file:///any/where/index.html\", to open by the function specified by `w3m-local-find-file-function'. The latter will be opened as a normal web page. Furthermore, if you would like to view some types of contents in the local system using the viewers specified by the `w3m-content-type-alist' variable, you can add regexps matching those file names to the second element of this variable. For example: \(setq w3m-local-find-file-regexps '(nil . \"\\\\.\\\\(?:[sx]?html?\\\\|dvi\\\\|ps\\\\|pdf\\\\)\\\\'\")) It is effective only when the `w3m-local-find-file-function' variable is set properly." :group 'w3m :type '(cons (radio :tag "Match" (const :format "All " nil) (regexp :format "%t: %v\n")) (radio :tag "Nomatch" (const :format "All " nil) (regexp :format "%t: %v\n")))) (defcustom w3m-local-find-file-function '(if (w3m-popup-frame-p) 'find-file-other-frame 'find-file-other-window) "*Function used to open local files. If a url of the `file:' scheme in which you entered agrees with the rule of the `w3m-local-find-file-regexps' variable (which see), it is used to open the file. Function should take one argument, the string naming the local file. It can also be any Lisp form returning a function. Set this to nil if you want to always use emacs-w3m to see local files." :group 'w3m :type 'sexp) (defcustom w3m-local-directory-view-method 'w3m-cgi "*Symbol of the method to view a local directory tree. The valid values include `w3m-cgi' using the CGI program specified by the `w3m-dirlist-cgi-program' variable (which see), and `w3m-dtree' using the w3m-dtree Lisp module." :group 'w3m :type '(radio (const :format "Dirlist CGI " w3m-cgi) (const :tag "Directory tree" w3m-dtree))) (defcustom w3m-dirlist-cgi-program (cond ((eq system-type 'windows-nt) "c:/usr/local/lib/w3m/dirlist.cgi") ((memq system-type '(OS/2 emx)) (expand-file-name "dirlist.cmd" (getenv "W3M_LIB_DIR"))) (t nil)) "*Name of the CGI program to list a local directory. If it is nil, the dirlist.cgi module of the w3m command will be used." :group 'w3m :type `(radio (const :tag "w3m internal CGI" nil) (file :format "path of 'dirlist.cgi': %v\n" :value ,(if (not noninteractive) (expand-file-name (concat "../lib/" (file-name-nondirectory w3m-command) "/dirlist.cgi") (file-name-directory (w3m-which-command w3m-command))))))) (defcustom w3m-add-referer (if (boundp 'w3m-add-referer-regexps) (symbol-value 'w3m-add-referer-regexps) (cons "\\`http:" "\\`http://\\(?:localhost\\|127\\.0\\.0\\.1\\)/")) "*Rule of sending referers. There are five choices as the valid values of this option. \(1\) nil: this means that emacs-w3m never send referers. \(2\) t: this means that emacs-w3m always send referers. \(3\) lambda: this means that emacs-w3m send referers only when both the current page and the target page are provided by the same server. \(4\) a cons cell keeping two regular expressions: this means that emacs-w3m send referers when the url of the current page matches the first regular expression and does not match the second regular expression. Nil for the regexp matches any url. \(5\) a function: emacs-w3m send referers when this function which has two arguments, URL and REFERER, returns non-nil. If you become nervous about leak of your private WEB browsing history, set `nil' or `lambda' to this option. When your computer belongs to a secret network, you may set a pair of regular expressions to inhibit sending referers which will disclose your private informations, as follows: \(setq w3m-add-referer '(\"\\\\`http:\" . \"\\\\`http://\\\\(?:[^./]+\\\\.\\\\)*example\\\\.net/\")\) " :group 'w3m :type '(choice (const :tag "Never send referers" nil) (const :tag "Always send referers" t) (const :tag "Send referers when accessing the same server" lambda) (cons :tag "Send referers when URI matches:" (list :inline t :format "%v" (radio :indent 2 :sample-face underline :tag "Allow" (regexp :format "%t: %v\n") (const :tag "Don't allow all" nil)) (radio :indent 2 :sample-face underline :tag "Don't allow" (regexp :format "%t: %v\n") (const :tag "Allow all" nil)))) (function :tag "Send referers when your function returns non-nil"))) (defcustom w3m-touch-command (w3m-which-command "touch") "*Name of the executable file of the touch command. Note that the command is required to be able to modify file's timestamp with the `-t' option." :group 'w3m :type 'string) (defcustom w3m-puny-utf-16be (cond ((w3m-find-coding-system 'utf-16-be-no-signature) 'utf-16-be-no-signature) ((w3m-find-coding-system 'utf-16be) 'utf-16be) (t nil)) "*Coding system for PUNY coding. if nil, don't use PUNY code." :group 'w3m :type '(radio (coding-system :tag "UTF-16BE without BOM") (const "Don't use" nil))) (defcustom w3m-uri-replace-alist '(("\\`gg:" w3m-search-uri-replace "google") ("\\`ya:" w3m-search-uri-replace "yahoo") ("\\`bts:" w3m-search-uri-replace "debian-bts") ("\\`dpkg:" w3m-search-uri-replace "debian-pkg") ("\\`alc:" w3m-search-uri-replace "alc") ("\\`urn:ietf:rfc:\\([0-9]+\\)" w3m-pattern-uri-replace "http://www.ietf.org/rfc/rfc\\1.txt")) "*Alist of regexps matching URIs, and some types of replacements. It can be used universally to replace URI strings in the local rule to the valid forms in the Internet. Each element looks like the `(REGEXP FUNCTION OPTIONS...)' form. FUNCTION takes one or more arguments, a uri and OPTIONS. You can use the grouping constructs \"\\\\(...\\\\)\" in REGEXP, and they can be referred by the \"\\N\" forms in a replacement (which is one of OPTIONS). Here are some predefined functions which can be used for those ways: `w3m-pattern-uri-replace' Replace a URI using PATTERN (which is just an OPTION). It is allowed that PATTERN contains the \"\\N\" forms in the same manner of `replace-match'. `w3m-search-uri-replace' Generate the valid forms to query words to some specified search engines. For example, the element (\"\\\\`gg:\" w3m-search-uri-replace \"google\") makes it possible to replace the URI \"gg:emacs\" to the form to query the word \"emacs\" to the Google site.\ " :group 'w3m :type '(repeat :convert-widget w3m-widget-type-convert-widget `((choice :format "%[Value Menu%] %v" :tag "Replacing URI with" (list :indent 4 :tag "Replacement Using Pattern" (regexp :format "%t: %v\n") (function-item :format "" w3m-pattern-uri-replace) (string :format "Pattern: %v\n")) (list :format "%t:\n%v" :indent 4 :tag "Quick Search" (regexp :format "Prefix URI %t: %v\n" :value "") (function-item :format "" w3m-search-uri-replace) (string :format "Quick Search Engine: %v\n" :value "")) ,@(progn (require 'w3m-search) (mapcar (lambda (elem) (let* ((engine (car elem)) (prefix (mapconcat 'identity (split-string (downcase engine)) "-"))) `(list :format "Quick Search:\n%v" :indent 4 :tag ,(concat "Quick Search: " prefix) (regexp :tag "Prefix URL Regexp" ,(concat "\\`" (regexp-quote prefix) ":")) (function-item :format "" w3m-search-uri-replace) (string :tag "Quick Search Engine" ,engine)))) w3m-search-engine-alist)) (list :indent 4 :tag "User Defined Function" (regexp :format "%t: %v\n") (function :format "%t: %v\n" ;; Fix a bug in Emacs versions prior to 22. :value-to-internal (lambda (widget value) (if (stringp value) (if (string-match "\\`\".*\"\\'" value) (substring value 1 -1) value) (prin1-to-string value)))) (repeat :extra-offset 2 :tag "Options" (sexp :format "%t: %v\n"))))))) (defcustom w3m-relationship-estimate-rules `((w3m-relationship-simple-estimate "\\`https?://\\(?:www\\|blogsearch\\|groups\\|news\\|images\\)\ \\.google\\.[^/]+/\\(?:\\(?:blog\\|code\\)?search\\|groups\\|news\\|images\ \\|cse\\?cx=\\|custom\\?\\(?:q\\|hl\\)=\\)" ,(concat "]+?href=" w3m-html-string-regexp "[^>]*>[\t\n ]*" "\\(?:\\(?:]*>[\t\n ]*\\)*]+>Next" "\\|\\(?:]*>[\t\n ]*\\)*\\(?:\\)?" "\\(?:$B2<0lJG(B\\|下一頁" "\\|$B]+?href=" w3m-html-string-regexp "[^>]*>[\t\n ]*" "\\(?:\\(?:]*>[\t\n ]*\\)*]+>Previous" "\\|\\(?:]*>[\t\n ]*\\)*\\(?:\\)?" "\\(?:$B>e0lJG(B\\|上一頁" "\\|$BA0$X(B\\|前へ" "\\|$(C@L@|(B\\|이전\\)[\t\n ]*<\\)") nil nil) (w3m-relationship-simple-estimate "\\`https?://www\\.google\\.[^/]+/gwt/n\\?u=" ,(concat "]+?href=" w3m-html-string-regexp "[ \t\n]+accesskey=\"3\">") ,(concat "]+?href=" w3m-html-string-regexp "[ \t\n]+accesskey=\"1\">") nil nil) (w3m-relationship-simple-estimate "\\`http://beta\\.search\\.yahoo\\.co\\.jp/" ,(concat "$B") ,(concat "$BA0$N%Z!<%8(B") nil nil) (w3m-relationship-simple-estimate "\\`http://freshmeat\\.net/\\(search\\|browse\\)/" ,(concat "\\[»\\]") ,(concat "\\[«\\]") nil nil) (w3m-relationship-oddmuse-estimate) (w3m-relationship-magicpoint-estimate) (w3m-relationship-slashdot-estimate) (w3m-relationship-alc-estimate)) "*Rules to estimate relationships between a retrieved page and others." :group 'w3m :type '(repeat (choice :format "%[Value Menu%] %v" (list :tag "Estimate relationships from anchors matching" :indent 1 (const :format "Function: %v\n" w3m-relationship-simple-estimate) (regexp :tag "URL") (regexp :tag "Next") (regexp :tag "Prev") (radio :format "Start: %v" (const :format "%v " nil) regexp) (radio :format "Contents: %v" (const :format "%v " nil) regexp)) (list :tag "Estimate with a user defined function" :indent 1 function (repeat :tag "Args" :extra-offset 1 (sexp :format "%v")))))) (defcustom w3m-enable-feeling-searchy t "Non-nil enables you to enter any words as well as a url when prompted. In that case, emacs-w3m uses the default search engine to search for the words." :group 'w3m :type 'boolean) (defconst w3m-entity-table (let ((table (make-hash-table :test 'equal))) (dolist (entity '(("nbsp" . " ") ("gt" . ">") ("lt" . "<") ("amp" . "&") ("quot" . "\"") ("apos" . "'") ("circ" . "^") ("tilde" . "~"))) (puthash (car entity) (cdr entity) table)) (dolist (entity '(;("nbsp" . 160) ("iexcl" . 161) ("cent" . 162) ("pound" . 163) ("curren" . 164) ("yen" . 165) ("brvbar" . 166) ("sect" . 167) ("uml" . 168) ("copy" . 169) ("ordf" . 170) ("laquo" . 171) ("not" . 172) ("shy" . 173) ("reg" . 174) ("macr" . 175) ("deg" . 176) ("plusmn" . 177) ("sup2" . 178) ("sup3" . 179) ("acute" . 180) ("micro" . 181) ("para" . 182) ("middot" . 183) ("cedil" . 184) ("sup1" . 185) ("ordm" . 186) ("raquo" . 187) ("frac14" . 188) ("frac12" . 189) ("frac34" . 190) ("iquest" . 191) ("Agrave" . 192) ("Aacute" . 193) ("Acirc" . 194) ("Atilde" . 195) ("Auml" . 196) ("Aring" . 197) ("AElig" . 198) ("Ccedil" . 199) ("Egrave" . 200) ("Eacute" . 201) ("Ecirc" . 202) ("Euml" . 203) ("Igrave" . 204) ("Iacute" . 205) ("Icirc" . 206) ("Iuml" . 207) ("ETH" . 208) ("Ntilde" . 209) ("Ograve" . 210) ("Oacute" . 211) ("Ocirc" . 212) ("Otilde" . 213) ("Ouml" . 214) ("times" . 215) ("Oslash" . 216) ("Ugrave" . 217) ("Uacute" . 218) ("Ucirc" . 219) ("Uuml" . 220) ("Yacute" . 221) ("THORN" . 222) ("szlig" . 223) ("agrave" . 224) ("aacute" . 225) ("acirc" . 226) ("atilde" . 227) ("auml" . 228) ("aring" . 229) ("aelig" . 230) ("ccedil" . 231) ("egrave" . 232) ("eacute" . 233) ("ecirc" . 234) ("euml" . 235) ("igrave" . 236) ("iacute" . 237) ("icirc" . 238) ("iuml" . 239) ("eth" . 240) ("ntilde" . 241) ("ograve" . 242) ("oacute" . 243) ("ocirc" . 244) ("otilde" . 245) ("ouml" . 246) ("divide" . 247) ("oslash" . 248) ("ugrave" . 249) ("uacute" . 250) ("ucirc" . 251) ("uuml" . 252) ("yacute" . 253) ("thorn" . 254) ("yuml" . 255))) (puthash (car entity) (char-to-string (make-char 'latin-iso8859-1 (cdr entity))) table)) (dolist (entity '(("Alpha" . 65) ("Beta" . 66) ("Gamma" . 67) ("Delta" . 68) ("Epsilon" . 69) ("Zeta" . 70) ("Eta" . 71) ("Theta" . 72) ("Iota" . 73) ("Kappa" . 74) ("Lambda" . 75) ("Mu" . 76) ("Nu" . 77) ("Xi" . 78) ("Omicron" . 79) ("Pi" . 80) ("Rho" . 81) ; No ("Sigmaf" . 82) ("Sigma" . 83) ("Tau" . 84) ("Upsilon" . 85) ("Phi" . 86) ("Chi" . 87) ("Psi" . 88) ("Omega" . 89) ("alpha" . 97) ("beta" . 98) ("gamma" . 99) ("delta" . 100) ("epsilon" . 101) ("zeta" . 102) ("eta" . 103) ("theta" . 104) ("iota" . 105) ("kappa" . 106) ("lambda" . 107) ("mu" . 108) ("nu" . 109) ("xi" . 110) ("omicron" . 111) ("pi" . 112) ("rho" . 113) ("sigmaf" . 114) ("sigma" . 115) ("tau" . 116) ("upsilon" . 117) ("phi" . 118) ("chi" . 119) ("psi" . 120) ("omega" . 121))) (puthash (car entity) (char-to-string (make-char 'greek-iso8859-7 (cdr entity))) table)) (when (w3m-mule-unicode-p) (let ((latin-extended-a '((32 . (("OElig" . 114) ("oelig" . 115))) (33 . (("Scaron" . 32) ("scaron" . 33) ("Yuml" . 56))))) (latin-extended-b '((33 . (("fnof" . 82))))) ;;(spacing-modifier-letters '(36 . (("circ" . 120) ("tilde" . 124)))) (general-punctuation '((114 . (("ensp" . 98) ("emsp" . 99) ("thinsp" . 105) ("zwnj" . 108) ("zwj" . 109) ("lrm" . 110) ("rlm" . 111) ("ndash" . 115) ("mdash" . 116) ("lsquo" . 120) ("rsquo" . 121) ("sbquo" . 122) ("ldquo" . 124) ("rdquo" . 125) ("bdquo" . 126))) (115 . (("dagger" . 32) ("Dagger" . 33) ("permil" . 48) ("lsaquo" . 57) ("rsaquo" . 58) ("bull" . 34) ("hellip" . 38) ("prime" . 50) ("Prime" . 51) ("oline" . 62) ("frasl" . 68))) (116 . (("euro" . 76))))) (greek '((39 . (("thetasym" . 81) ("upsih" . 82) ("piv" . 86))))) (letterlike-symbols '((117 . (("weierp" . 88) ("image" . 81) ("real" . 92) ("trade" . 98) ("alefsym" . 117))))) (arrows '((118 . (("larr" . 112) ("uarr" . 113) ("rarr" . 114) ("darr" . 115) ("harr" . 116))) (119 . (("crarr" . 53) ("lArr" . 80) ("uArr" . 81) ("rArr" . 81) ("dArr" . 83) ("hArr" . 84))))) (mathematical-operators '((120 . (("forall" . 32) ("part" . 34) ("exist" . 35) ("empty" . 37) ("nabla" . 39) ("isin" . 40) ("notin" . 41) ("ni" . 43) ("prod" . 47) ("sum" . 49) ("minus" . 50) ("lowast" . 55) ("radic" . 58) ("prop" . 61) ("infin" . 62) ("ang" . 64) ("and" . 71) ("or" . 72) ("cap" . 73) ("cup" . 74) ("int" . 75) ("there4" . 84) ("sim" . 92) ("cong" . 101) ("asymp" . 104))) (121 . (("ne" . 32) ("equiv" . 33) ("le" . 36) ("ge" . 37) ("sub" . 66) ("sup" . 67) ("nsub" . 68) ("sube" . 70) ("supe" . 71) ("oplus" . 85) ("otimes" . 87) ("perp" . 101))) (122 . (("sdot" . 37))))) (miscellaneous-technical '((122 . (("lceil" . 104) ("rceil" . 105) ("lfloor" . 106) ("rfloor" . 107))) (123 . (("lang" . 41) ("rang" . 42))))) (suit '(("loz" . (34 . 42)) ("spades" . (35 . 96)) ("clubs" . (35 . 99)) ("hearts" . (35 . 101)) ("diams" . (35 . 102))))) (dolist (entities `(,@latin-extended-a ,@latin-extended-b ,@general-punctuation ,@greek ,@letterlike-symbols ,@arrows ,@mathematical-operators ,@miscellaneous-technical)) (let ((code1 (car entities))) (dolist (entity (cdr entities)) (puthash (car entity) (char-to-string (make-char 'mule-unicode-0100-24ff code1 (cdr entity))) table)))) (dolist (entity suit) (puthash (car entity) (char-to-string (make-char 'mule-unicode-2500-33ff (car (cdr entity)) (cdr (cdr entity)))) table)))) table) "Table of html character entities and values.") (defvar w3m-extra-numeric-character-reference (mapcar (lambda (item) (cons (car item) (string (w3m-ucs-to-char (cdr item))))) '((?\C-m . #x20) ;; [emacs-w3m:12378] (#x80 . #x20AC) (#x82 . #x201A) (#x83 . #x0192) (#x84 . #x201E) (#x85 . #x2026) (#x86 . #x2020) (#x87 . #x2021) (#x88 . #x02C6) (#x89 . #x2030) (#x8A . #x0160) (#x8B . #x2039) (#x8C . #x0152) (#x8E . #x017D) (#x91 . #x2018) (#x92 . #x2019) (#x93 . #x201C) (#x94 . #x201D) (#x95 . #x2022) (#x96 . #x2013) (#x97 . #x2014) (#x98 . #x02DC) (#x99 . #x2122) (#x9A . #x0161) (#x9B . #x203A) (#x9C . #x0153) (#x9E . #x017E) (#x9F . #x0178))) "*Alist of (numeric . string) pairs for numeric character reference other than ISO 10646.") (defconst w3m-entity-reverse-table (let ((table (make-hash-table :test 'equal))) (maphash (lambda (key val) (puthash val key table)) w3m-entity-table) table) "Revision table of html character entities and values.") (defconst w3m-entity-regexp (let (buf) (maphash (lambda (key val) (push key buf)) w3m-entity-table) (concat "&\\(" (let ((max-specpdl-size (* 1024 1024))) ;; For old Emacsen. (regexp-opt buf)) "\\|#\\(?:[xX][0-9a-fA-F]+\\|[0-9]+\\)\\)\\(\\'\\|[^0-9a-zA-Z]\\)")) "Regexp matching html character entities.") (defconst w3m-encoding-alist (eval-when-compile (apply 'nconc (mapcar (lambda (elem) (mapcar (lambda (x) (cons x (car elem))) (cdr elem))) '((gzip . ("gzip" "x-gzip" "compress" "x-compress")) (bzip . ("x-bzip" "bzip" "bzip2")) (deflate . ("x-deflate" "deflate")))))) "Alist of content encoding types and decoder symbols. Decoders are specified by `w3m-decoder-alist' (which see).") (defconst w3m-emacs-w3m-icon "\ R0lGODlhUwAOAPIAAFUq/H8AvwC/AP8AAAAAv79/Af///wAAACH/C05FVFNDQVBFMi4wAwEA AAAh+QQAIQD/ACwAAAAAUwAOAAADxmi63P4wykmrvXiWvbP/4NIpY2ieUFlSQRssrRG7DGET DQEAzL5PAoEiSCo0RoOBIblkKmKyV/RFsymsBqzh99vyvBKiYbQaG5vKZFoZfUqhUO0C2613 gUJzsVhy+tkuNG2DWjd0Xw0+iEGMYgJGHWVjbH8KTlAMcThZm1iHEYwakKMOlU2WgFKZUp6d m3YKdwtiEmRnfZS5qG5Ub6yuVzg+C1xfAES0EbZ7u6fOTlOqrcFzxcSyjRXLqGoLptAo4eLj 5OUNCQAh+QQAIQD/ACwAAAAAUwAOAAADImi63P4wykmrvTjrzbv/YCiOZGmeaKqubOu+cCzP dG3fagIAIfkEACEA/wAsAAAAAFMADgAAAz5outz+MMpJq7046827/2AYBWSwkAZaimyFpiZs rm0tvXj82rxT0rmekLE7xYZIRVF5TA5XQWfyJ61ar9hsAgAh+QQAIQD/ACwAAAAAUwAOAAAD Vmi63P4wykmrvTjrzbv/YBgFZLCQBloyREs0rxiiqVmba6voBi//tKCN5lsUf7OSUEGM9VxO ZNLR3MV4R6mHxqg+rVrpavktZ8MgpfHKNqLf8Lh8XkkAACH5BAAhAP8ALAAAAABTAA4AAANw aLrc/jDKSau9OOvNu/9gGAVksJAGWjJESzQEADCyLGJoaurm2io/Q9BgsxFnx5slx9zlhoug cWpULktNxfMFdHGrtJq1kmNsu2jhFznulE+7oHytoLY1q6w6/RPXZ1N3F1hRXHNRRWx+goyN jo+QCQAh+QQAIQD/ACwAAAAAUwAOAAADhWi63P4wykmrvTjrzbv/YBgFZLCQBloyREs0BAAw sjwJgoKHaGr6plVLMTQUDTYbcraU7ESKnvTXOy6KyqzyloMCV77o7+jCMhu1M2797EJ7jOrL OC+aI2tvBX4a1/8KWoFnC096EitTRIB0S2dJTAA7hocjYI2YZJALNQxslaChoqOkDgkAIfkE ACEA/wAsAAAAAFMADgAAA6doutz+MMpJq714lr2z/+DSKWNonlBZUkEbLK0RuwxhEw0BAMy+ TwKBIkgqNFaSmOy1fNFsCqhBavj9qjyshGgYIZERpZippC6k1/QVKOwa3UVw2DVWlHHRG37d 8y2CgFwCRh1gbxVKDHd5jFN7WQ+AGoSUJokwTFKajwpqDlwSXm9yLDNkmXibWJBWWQBEoBGi RSB0Z6m4Z60Lfn+SFLMowsPExcbFCQAh+QQAIQD/ACwAAAAAUwAOAAADxmi63P4wykmrvXiW vbP/4NIpY2ieUFlSQRssrRG7DGETDQEAzL5PAoEiSCo0RoOBIblkKmKyV/RFsymsBqzh99vy vBKiYbQaG5vKZFoZfUqhUO0C2613gUJzsVhy+tkuNG2DWjd0Xw0+iEGMYgJGHWVjbH8KTlAM cThZm1iHEYwakKMOlU2WgFKZUp6dm3YKdwtiEmRnfZS5qG5Ub6yuVzg+C1xfAES0EbZ7u6fO TlOqrcFzxcSyjRXLqGoLptAo4eLj5OUNCQA7" "A small image to be displayed in the about: page. It is encoded in the optimized interlaced endlessly animated gif format and base64. Emacs can display only the 1st frame of an animation, but XEmacs can fully display it with the help of the gifsicle program.") (defcustom w3m-process-modeline-format " loaded: %s" "*Format used when displaying the progress of the external w3m process. It shows a percentage of the data loaded from the web server." :group 'w3m :type '(choice (string :tag "Format") function)) (defcustom w3m-ignored-image-url-regexp nil "*Regexp matching image urls which you don't want to view. It is effective even if `w3m-display-inline-images' is non-nil. For instance, the value \"^https?://www\\.google\\.com/\" conceals Google's logo and navigation images, but display YouTube's thumbnail." :group 'w3m :type '(radio (const :format "Accept any image\n" nil) (regexp :format "URL regexp: %v\n"))) (defvar w3m-modeline-process-status-on "" "Modeline control for displaying the status when the process is running. The value will be modified for displaying the graphic icon.") (defvar w3m-modeline-image-status-on "[IMG]" "Modeline control to display the status when inline images are turned on. The value will be modified for displaying the graphic icon.") (defvar w3m-modeline-status-off "[ - ]" "Modeline control for displaying the status for the default. The value will be modified for displaying the graphic icon.") (defvar w3m-modeline-ssl-image-status-on "[IMG(SSL)]" "Modeline control for displaying the status when images and SSL are on. The value will be modified for displaying the graphic icon.") (defvar w3m-modeline-ssl-status-off "[SSL]" "Modeline control for displaying the status when SSL is turned on. The value will be modified for displaying the graphic icon.") (defvar w3m-modeline-separator " / " "String used to separate a status and a title in the modeline.") (defvar w3m-modeline-favicon nil "Modeline control for displaying a favicon. This variable will be made buffer-local.") (defvar w3m-favicon-image nil "Favicon image of the page. This variable will be made buffer-local") (defvar w3m-current-process nil "Flag used to say whether the external process is running in the buffer. This variable will be made buffer-local.") (make-variable-buffer-local 'w3m-current-process) (defvar w3m-refresh-timer nil "Variable used to keep a timer object for refreshing a page. It will be supplied by the REFRESH attribute in the META tag, and made buffer-local in each emacs-w3m buffer.") (make-variable-buffer-local 'w3m-refresh-timer) (defvar w3m-mail-user-agents '(gnus-user-agent message-user-agent mew-user-agent vm-user-agent wl-user-agent) "List of mail user agents that `w3m-mail' supports. See also w3m-mail.el.") (defvar w3m-current-base-url nil "URL specified by tag in element of the page source.") (defvar w3m-current-forms nil "Variable used to keep forms data for the current emacs-w3m buffer.") (defvar w3m-current-coding-system nil "Coding system used when decoding the current emacs-w3m buffer.") (defvar w3m-current-content-charset nil "Content charset of the page specified by the server or the META tag.") (defvar w3m-icon-data nil "Cons of icon data and its image-type for the current emacs-w3m buffer. It is used for favicon data. The type is often `ico'.") (defvar w3m-next-url nil "URL as the next document in the author-defined sequence.") (defvar w3m-previous-url nil "URL as the previous document in the author-defined sequence.") (defvar w3m-start-url nil "URL as the first document in the author-defined sequence.") (defvar w3m-contents-url nil "URL as the table of contents for the current page.") (defvar w3m-max-anchor-sequence nil "Maximum number of the anchor sequence in the current page.") (defvar w3m-current-refresh nil "Cons of number of seconds and a url specified by the REFRESH attribute.") (defvar w3m-current-ssl nil "SSL certification indicator for the current emacs-w3m buffer.") (defvar w3m-name-anchor-from-hist nil "List of the points of where `w3m-search-name-anchor' come from.") (make-variable-buffer-local 'w3m-current-url) (make-variable-buffer-local 'w3m-current-base-url) (make-variable-buffer-local 'w3m-current-title) (make-variable-buffer-local 'w3m-current-forms) (make-variable-buffer-local 'w3m-current-coding-system) (make-variable-buffer-local 'w3m-current-content-charset) (make-variable-buffer-local 'w3m-icon-data) (make-variable-buffer-local 'w3m-next-url) (make-variable-buffer-local 'w3m-previous-url) (make-variable-buffer-local 'w3m-start-url) (make-variable-buffer-local 'w3m-contents-url) (make-variable-buffer-local 'w3m-max-anchor-sequence) (make-variable-buffer-local 'w3m-current-refresh) (make-variable-buffer-local 'w3m-current-ssl) (make-variable-buffer-local 'w3m-name-anchor-from-hist) (defun w3m-clear-local-variables () (setq w3m-current-url nil w3m-current-base-url nil w3m-current-title nil w3m-current-coding-system nil w3m-current-content-charset nil w3m-icon-data nil w3m-next-url nil w3m-previous-url nil w3m-start-url nil w3m-contents-url nil w3m-max-anchor-sequence nil w3m-current-refresh nil w3m-current-ssl nil w3m-name-anchor-from-hist nil)) (defun w3m-copy-local-variables (from-buffer) (let (url base title cs char icon next prev start toc hseq refresh ssl) (with-current-buffer from-buffer (setq url w3m-current-url base w3m-current-base-url title w3m-current-title cs w3m-current-coding-system char w3m-current-content-charset icon w3m-icon-data next w3m-next-url prev w3m-previous-url start w3m-start-url toc w3m-contents-url hseq w3m-max-anchor-sequence refresh w3m-current-refresh ssl w3m-current-ssl)) (setq w3m-current-url url w3m-current-base-url base w3m-current-title title w3m-current-coding-system cs w3m-current-content-charset char w3m-icon-data icon w3m-next-url next w3m-previous-url prev w3m-start-url start w3m-contents-url toc w3m-max-anchor-sequence hseq w3m-current-refresh refresh w3m-current-ssl ssl))) (defcustom w3m-verbose nil "If non-nil, `w3m-message' will log echo messages in *Messages* buffer. Echo messages will be displayed no matter what this variable is unless `w3m-message-silent' is not temprarily bound to a non-nil value." :group 'w3m :type 'boolean) (defvar w3m-safe-url-regexp nil "Regexp matching urls which are considered to be safe. The nil value means all urls are considered to be safe. Note: The value, that might be bound to a certain value while rendering contents, will be held by the `w3m-safe-url-regexp' text property that is set over the rendered contents in a buffer. So, programs that use the value to test whether a url of a link in a buffer is safe should use the value of the text property, not the value of this variable. See the function definitions of `w3m-toggle-inline-image', `w3m-toggle-inline-images', `w3m-safe-view-this-url', and `w3m-mouse-safe-view-this-url'.") (defvar w3m-current-buffer nil) (defvar w3m-cache-buffer nil) (defvar w3m-cache-articles nil) (defvar w3m-cache-hashtb nil) (defvar w3m-input-url-history nil) (defvar w3m-http-status-alist '((400 . "Bad Request") (401 . "Unauthorized") (402 . "Payment Required") (403 . "Forbidden") (404 . "Not Found") (405 . "Method Not Allowed") (406 . "Not Acceptable") (407 . "Proxy Authentication Required") (408 . "Request Time-out") (409 . "Conflict") (410 . "Gone") (411 . "Length Required") (412 . "Precondition Failed") (413 . "Request Entity Too Large") (414 . "Request-URI Too Large") (415 . "Unsupported Media Type") (500 . "Internal Server Error") (501 . "Not Implemented") (502 . "Bad Gateway") (503 . "Service Unavailable") (504 . "Gateway Time-out") (505 . "HTTP Version not supported")) "Alist of HTTP status codes.") (defvar w3m-http-status nil) (defconst w3m-arrived-db-size 1023) (defvar w3m-arrived-db nil "Hash table, the arrived URLs database. The name of each symbol represents a url, the arrival time in the Emacs style (a list of three integers) is stored as the value, and informations including a title, a modification time, a content charset and a content type are stored as the properties of the symbol. The nil value means it has not been initialized.") (defvar w3m-arrived-setup-functions nil "Hook functions run after setting up the arrived URLs database.") (defvar w3m-arrived-shutdown-functions nil "Hook functions run after saving the arrived URLs database.") (defconst w3m-image-type-alist '(("image/jpeg" . jpeg) ("image/gif" . gif) ("image/png" . png) ("image/tiff" . tiff) ("image/x-xbm" . xbm) ("image/x-xpm" . xpm)) "Alist of content types and image types defined as the Emacs's features.") (defconst w3m-toolbar-buttons '("back" "parent" "forward" "reload" "open" "home" "search" "image" "copy" "weather" "antenna" "save" "history" "db-history") "List of prefix strings for the toolbar buttons.") (defconst w3m-toolbar (if (equal "Japanese" w3m-language) (let ((a (decode-coding-string "\e$B%\"\e(B" 'iso-2022-jp))) ;; $B%"(B `([w3m-toolbar-back-icon w3m-view-previous-page (w3m-history-previous-link-available-p) "$BA0$N%Z!<%8$KLa$k(B"] [w3m-toolbar-parent-icon w3m-view-parent-page (w3m-parent-page-available-p) "$B>e$N%G%#%l%/%H%j$X0\F0$9$k(B"] [w3m-toolbar-forward-icon w3m-view-next-page (w3m-history-next-link-available-p) "$Be$r8!:w(B"] [w3m-toolbar-image-icon w3m-toggle-inline-images t "$B2hA|$NI=<($r%H%0%k$9$k(B"] [w3m-toolbar-copy-icon w3m-copy-buffer t "$B$3$N%;%C%7%g%s$N%3%T!<$r:n$k(B"] [w3m-toolbar-weather-icon w3m-weather t "$BE75$M=Js$r8+$k(B"] [w3m-toolbar-antenna-icon w3m-antenna t ,(concat a "$B%s%F%J$Ge$N3,AX$K0\F0$9$k(B" "Up to Parent Page") w3m-view-parent-page (w3m-parent-page-available-p)] "----" ;; separator [,(w3m-make-menu-item "$B8=:_$N%Z!<%8$r(B browse-url $B$G3+$/(B" "Open The Current Page using browse-url") w3m-view-url-with-browse-url w3m-current-url] [,(w3m-make-menu-item "$B$3$N%j%s%/$r(B browse-url $B$G3+$/(B" "Open This Link using browse-url") w3m-view-url-with-browse-url (or (w3m-anchor) (w3m-image))] [,(w3m-make-menu-item "$B$3$N%Z!<%8$N%=!<%9$r%3%^%s%I$KAw$k(B..." "Pipe Page Source to Command...") w3m-pipe-source w3m-current-url] "----" ;; separator (,(w3m-make-menu-item "$B:FI=<((B" "Redisplay") [,(w3m-make-menu-item "$B$3$N%Z!<%8$r:Fe$N3,AX$K0\F0$9$k(B" "Up to Parent Page") w3m-view-parent-page (w3m-parent-page-available-p)] "----" ;; separator [,(w3m-make-menu-item "$B$3$N%Z!<%8$r:F= (- n) (length list)) (copy-sequence list) (nthcdr (+ (length list) n) (copy-sequence list))) ;; N is positive, extract the first items (if (>= n (length list)) (copy-sequence list) (nreverse (nthcdr (- (length list) n) (reverse list))))) (copy-sequence list))) (defun w3m-load-list (file &optional coding-system) "Read an emacs-w3m data file FILE and return contents as a list. It is used for loading `w3m-arrived-file', `w3m-cookie-file', `w3m-favicon-cache-file' and `w3m-antenna-file' (which see). CODING-SYSTEM is used to read FILE which defaults to the value of `w3m-file-coding-system-for-read'." (when (and (file-readable-p file) ;; XEmacs 21.4 might crash when inserting a directory. (not (file-directory-p file))) (with-temp-buffer (when (condition-case nil (let ((coding-system-for-read (or coding-system w3m-file-coding-system-for-read))) (insert-file-contents file)) (error (message "Error while loading %s" file) nil)) ;; point is not always moved to the beginning of the buffer ;; after `insert-file-contents' is done. (goto-char (point-min)) (condition-case err (read (current-buffer)) (error (message "Error while reading %s; %s" file (error-message-string err)) nil)))))) (defun w3m-save-list (file list &optional coding-system escape-ctl-chars) "Save a LIST form into the emacs-w3m data file FILE. Contents will be encoded with CODING-SYSTEM which defaults to the value of `w3m-file-coding-system'. Optional ESCAPE-CTL-CHARS if it is non-nil, control chars will be represented with ^ as `cat -v' does." (when (and list (file-writable-p file)) (with-temp-buffer (let ((coding-system-for-write (or coding-system w3m-file-coding-system)) (standard-output (current-buffer)) (print-fn (if escape-ctl-chars 'w3m-prin1 'prin1)) element print-length print-level) (insert (format "\ ;;; %s -*- mode: emacs-lisp%s -*- ;; This file is generated automatically by emacs-w3m v%s. " (file-name-nondirectory file) (if coding-system-for-write (format "; coding: %s" coding-system-for-write) "") emacs-w3m-version)) (insert "(") (while list (setq element (car list) list (cdr list)) (if (consp element) (progn (insert "(") (funcall print-fn (car element)) (insert "\n") (while (setq element (cdr element)) (insert " ") (funcall print-fn (car element)) (insert "\n")) (backward-delete-char 1) (insert ")\n ")) (funcall print-fn element) (insert "\n"))) (skip-chars-backward "\n ") (delete-region (point) (point-max)) (insert ")\n") (let ((mode (and (file-exists-p file) (file-modes file)))) (write-region (point-min) (point-max) file nil 'nomsg) (when mode (set-file-modes file mode))))))) (defun w3m-url-coding-system (url) "Return coding system suitable to URL to retrieve." (let ((alist w3m-url-coding-system-alist) (case-fold-search t) elt coding) (while alist (setq elt (pop alist)) (if (or (not (car elt)) (and (stringp (car elt)) (string-match (car elt) url))) (setq coding (cdr elt) alist nil))) (when (functionp coding) (setq coding (funcall coding url))) (or coding w3m-current-coding-system (cdr (assq nil w3m-url-coding-system-alist)) w3m-default-coding-system))) (defun w3m-url-encode-string (str &optional coding encode-space) (apply (function concat) (mapcar (lambda (ch) (cond ((eq ch ?\n) ; newline "%0D%0A") ((string-match "[-a-zA-Z0-9_.]" (char-to-string ch)) ; xxx? (char-to-string ch)) ; printable ((and (char-equal ch ?\x20); space encode-space) "+") (t (format "%%%02X" ch)))) ; escape (encode-coding-string (or str "") (or coding (w3m-url-coding-system str)))))) (defun w3m-url-encode-string-2 (str) "Encode `(' and `)', apt to be misidentified as boundaries." (w3m-replace-in-string (w3m-replace-in-string str "(" "%28") ")" "%29")) (defun w3m-url-decode-string (str &optional coding regexp) (or regexp (setq regexp "%\\(?:\\([0-9a-f][0-9a-f]\\)\\|0d%0a\\)")) (let ((start 0) (case-fold-search t)) (with-temp-buffer (set-buffer-multibyte nil) (while (string-match regexp str start) (insert (substring str start (match-beginning 0)) (if (match-beginning 1) (string-to-number (match-string 1 str) 16) ?\n)) (setq start (match-end 0))) (insert (substring str start)) (decode-coding-string (buffer-string) (or (if (listp coding) (w3m-detect-coding-region (point-min) (point-max) coding) coding) w3m-default-coding-system w3m-coding-system 'iso-2022-7bit))))) (defun w3m-url-readable-string (url) "Return a readable string for a given encoded URL." (when (stringp url) (setq url (w3m-puny-decode-url url)) (if (string-match "[^\000-\177]" url) url (w3m-url-decode-string url (w3m-url-coding-system url))))) (defun w3m-url-transfer-encode-string (url &optional coding) "Encode non-ascii characters in URL into the sequence of escaped octets. Optional CODING is a coding system, that defaults to the one determined according to URL and `w3m-url-coding-system-alist', used to encode URL. This function is designed for conversion for safe transmission of URL, i.e., it handles only non-ASCII characters that can not be transmitted safely through the network. For the other general purpose, you should use `w3m-url-encode-string' instead." (setq url (w3m-puny-encode-url url)) (unless coding (setq coding (w3m-url-coding-system url))) (let ((start 0) buf) (while (string-match "[^\x21-\x7e]+" url start) (setq buf (cons (apply 'concat (mapcar (lambda (c) (format "%%%02X" c)) (encode-coding-string (match-string 0 url) coding))) (cons (substring url start (match-beginning 0)) buf)) start (match-end 0))) (apply 'concat (nreverse (cons (substring url start) buf))))) ;;; HTML character entity handling: (defun w3m-entity-value (name) "Get a char corresponding to NAME from the html char entities database. The database is kept in `w3m-entity-table'." ;; Return a value of the specified entity, or nil if it is unknown. (or (gethash name w3m-entity-table) (and (eq (aref name 0) ?#) (let ((num (if (memq (aref name 1) '(?X ?x)) (string-to-number (substring name 2) 16) (string-to-number (substring name 1))))) (or (cdr (assq num w3m-extra-numeric-character-reference)) (string (w3m-ucs-to-char num))))))) (defun w3m-fontify-bold () "Fontify bold text in the buffer containing halfdump." (goto-char (point-min)) (while (search-forward "" nil t) (let ((start (match-beginning 0))) (delete-region start (match-end 0)) (when (re-search-forward "" nil t) (delete-region (match-beginning 0) (match-end 0)) (w3m-add-face-property start (match-beginning 0) 'w3m-bold))))) (defun w3m-fontify-italic () "Fontify italic text in the buffer containing halfdump." (goto-char (point-min)) (while (search-forward "" nil t) (let ((start (match-beginning 0))) (delete-region start (match-end 0)) (when (re-search-forward "" nil t) (delete-region (match-beginning 0) (match-end 0)) (w3m-add-face-property start (match-beginning 0) 'w3m-italic))))) (defun w3m-fontify-underline () "Fontify underline text in the buffer containing halfdump." (goto-char (point-min)) (while (search-forward "" nil t) (let ((start (match-beginning 0))) (delete-region start (match-end 0)) (when (re-search-forward "" nil t) (delete-region (match-beginning 0) (match-end 0)) (w3m-add-face-property start (match-beginning 0) 'w3m-underline))))) (defun w3m-fontify-strike-through () "Fontify strike-through text in the buffer containing halfdump." (goto-char (point-min)) (cond ((and (eq w3m-display-ins-del 'fontify) (w3m-device-on-window-system-p)) (while (search-forward "" nil t) (let ((start (match-beginning 0))) (delete-region start (match-end 0)) (when (re-search-forward "" nil t) (delete-region (match-beginning 0) (match-end 0)) (w3m-add-face-property start (match-beginning 0) 'w3m-strike-through))))) ((w3m-device-on-window-system-p) (while (re-search-forward (concat "\\(?:\\(?::\\(?:\\(?:DEL\\|S\\)]\\)\\|" "\\[\\(?:\\(?:DEL\\|S\\):\\)\\)\\)") nil t) (w3m-add-face-property (match-beginning 0) (match-end 0) 'w3m-strike-through))))) (defun w3m-fontify-insert () "Fontify insert text in the buffer containing halfdump." (goto-char (point-min)) (cond ((and (eq w3m-display-ins-del 'fontify) (w3m-device-on-window-system-p)) (while (search-forward "" nil t) (let ((start (match-beginning 0))) (delete-region start (match-end 0)) (when (re-search-forward "" nil t) (delete-region (match-beginning 0) (match-end 0)) (w3m-add-face-property start (match-beginning 0) 'w3m-insert))))) ((w3m-device-on-window-system-p) (while (re-search-forward "\\(?:\\(?::INS]\\|\\[INS:\\)\\)" nil t) (w3m-add-face-property (match-beginning 0) (match-end 0) 'w3m-insert))))) (defun w3m-decode-anchor-string (str) ;; FIXME: This is a quite ad-hoc function to process encoded url string. ;; More discussion about timing &-sequence decode is required. The ;; following article (written in Japanese) is the origin of this issue: ;; ;; [emacs-w3m:00150] ;; ;; Takaaki MORIYAMA wrote in the article that the string "&" which ;; is replaced from "&" and embedded in the w3m's halfdump should be ;; restored into "&" some time. (let ((start 0) (buf)) (while (string-match "\\(&\\)\\|\\([\t\r\f\n]+\\)" str start) (setq buf (cons (if (match-beginning 1) "&" " ") (cons (substring str start (match-beginning 0)) buf)) start (match-end 0))) (apply (function concat) (nreverse (cons (substring str start) buf))))) (defun w3m-image-type (content-type) "Return an image type which corresponds to CONTENT-TYPE." (cdr (assoc content-type w3m-image-type-alist))) (defun w3m-imitate-widget-button () "Return a boolean value corresponding to the variable of the same name." (if (listp w3m-imitate-widget-button) (condition-case nil (eval w3m-imitate-widget-button) (error nil)) (and w3m-imitate-widget-button t))) (defun w3m-fontify-anchors () "Fontify anchor tags in the buffer which contains halfdump." (let ((help (w3m-make-help-echo w3m-balloon-help)) (balloon (w3m-make-balloon-help w3m-balloon-help)) prenames start end bhhref) (goto-char (point-min)) (setq w3m-max-anchor-sequence 0) ;; reset max-hseq (while (re-search-forward "<_id[ \t\r\f\n]+" nil t) (setq start (match-beginning 0)) (setq prenames (get-text-property start 'w3m-name-anchor)) (w3m-parse-attributes (id) (delete-region start (point)) (w3m-add-text-properties start (point-max) (list 'w3m-name-anchor (cons (w3m-decode-entities-string id) prenames))))) (goto-char (point-min)) (while (re-search-forward "\\)" nil t) (setq end (match-beginning 0)) (delete-region (match-beginning 1) (match-end 1)) (setq href (w3m-expand-url href)) (unless (w3m-url-local-p href) (w3m-string-match-url-components href) (setq href (if (match-beginning 8) (let ((tmp (match-string 9 href))) (concat (w3m-url-transfer-encode-string (substring href 0 (match-beginning 8))) "#" tmp)) (w3m-url-transfer-encode-string href)))) (setq hseq (or (and (null hseq) 0) (abs hseq))) (setq w3m-max-anchor-sequence (max hseq w3m-max-anchor-sequence)) (w3m-add-face-property start end (if (w3m-arrived-p href) 'w3m-arrived-anchor 'w3m-anchor)) (if title (progn (setq title (w3m-decode-entities-string title)) (setq bhhref (concat (w3m-decode-anchor-string title) "\n" (w3m-url-readable-string href)))) (setq bhhref (w3m-url-readable-string href))) (w3m-add-text-properties start end (list 'w3m-href-anchor href 'w3m-balloon-help bhhref 'w3m-anchor-title title 'mouse-face 'highlight 'w3m-anchor-sequence hseq 'help-echo help 'balloon-help balloon 'keymap w3m-link-map)) (when (w3m-imitate-widget-button) (require 'wid-edit) (let ((widget-button-face (if (w3m-arrived-p href) 'w3m-arrived-anchor 'w3m-anchor)) (widget-mouse-face 'highlight) w) (setq w (widget-convert-button 'default start end :button-keymap nil :help-echo href)) (w3m-static-unless (featurep 'xemacs) (overlay-put (widget-get w :button-overlay) 'evaporate t)))) (when name (w3m-add-text-properties start (point-max) (list 'w3m-name-anchor2 (cons (w3m-decode-entities-string name) prenames)))))) (name (w3m-add-text-properties start (point-max) (list 'w3m-name-anchor2 (cons (w3m-decode-entities-string name) prenames))))))) (when w3m-icon-data (setq w3m-icon-data (cons (and (car w3m-icon-data) (w3m-expand-url (car w3m-icon-data))) (or (w3m-image-type (cdr w3m-icon-data)) 'ico)))) (when w3m-next-url (setq w3m-next-url (w3m-expand-url w3m-next-url))) (when w3m-previous-url (setq w3m-previous-url (w3m-expand-url w3m-previous-url))) (when w3m-start-url (setq w3m-start-url (w3m-expand-url w3m-start-url))) (when w3m-contents-url (setq w3m-contents-url (w3m-expand-url w3m-contents-url))))) (eval-and-compile (unless (featurep 'xemacs) (defun w3m-setup-menu () "Define menubar buttons for Emacsen." (w3m-menu-on-forefront w3m-menu-on-forefront t) (unless (keymapp (lookup-key w3m-mode-map [menu-bar w3m])) (let ((map (make-sparse-keymap (car w3m-menubar)))) (define-key w3m-mode-map [menu-bar] (make-sparse-keymap)) (w3m-setup-session-menu) (when w3m-use-tab-menubar (w3m-setup-tab-menu)) (w3m-setup-bookmark-menu) (define-key w3m-mode-map [menu-bar w3m] (cons (car w3m-menubar) map)) (require 'easymenu) (easy-menu-define w3m-mode-menu w3m-mode-map "w3m menu item" w3m-menubar) (easy-menu-add w3m-mode-menu)) (let ((map (make-sparse-keymap))) (easy-menu-define w3m-rmouse-menu map "w3m rmouse menu item" w3m-rmouse-menubar)))))) (defun w3m-fontify-images () "Fontify img_alt strings of images in the buffer containing halfdump." (goto-char (point-min)) (let ((balloon (w3m-make-balloon-help w3m-balloon-help)) upper start end help src1) (while (re-search-forward "<\\(img_alt\\)[^>]+>" nil t) (setq upper (string= (match-string 1) "IMG_ALT") start (match-beginning 0) end (match-end 0)) (goto-char (match-end 1)) (w3m-parse-attributes (src (width :integer) (height :integer) title usemap) (delete-region start end) (setq src (w3m-expand-url (w3m-decode-anchor-string src))) ;; Use the identical Lisp object for a string used as the value of ;; the `w3m-image' property. A long title string will be chopped in ;; w3m's halfdump; since it makes `next-single-property-change' not ;; work properly, XEmacs didn't display images in shimbun articles. (if (equal src src1) (setq src src1) (setq src1 src)) (when (search-forward "" nil t) (delete-region (setq end (match-beginning 0)) (match-end 0)) (setq help (get-text-property start 'w3m-balloon-help)) (cond ((and help title) (setq help (format "%s\nalt: %s\nimg: %s" help title src))) (help (setq help (format "%s\nimg: %s" help src))) (title (setq help (format "alt: %s\nimg: %s" title src))) (t (setq help (format "img: %s" src)))) (w3m-add-text-properties start end (list 'w3m-image src 'w3m-image-size (when (or width height) (cons width height)) 'w3m-image-alt title 'w3m-balloon-help help 'w3m-image-usemap usemap 'w3m-image-status 'off 'w3m-image-redundant upper 'keymap w3m-link-map)) (unless (w3m-action start) ;; No need to use `w3m-add-text-properties' here. (w3m-add-face-property start end (if (w3m-anchor start) 'w3m-image-anchor 'w3m-image)) (unless (w3m-anchor start) (add-text-properties start end (list 'mouse-face 'highlight 'help-echo help 'balloon-help balloon))))))))) (defvar w3m-idle-images-show-timer nil) (defvar w3m-idle-images-show-list nil) (defvar w3m-idle-images-show-interval 1) (defun w3m-idle-images-show () (let ((repeat t) (onbuffer (member (current-buffer) (w3m-list-buffers)))) (while (and repeat w3m-idle-images-show-list) (let* ((item (or (and onbuffer (or (get-text-property (point) 'w3m-idle-image-item) (let* ((prev (previous-single-property-change (point) 'w3m-idle-image-item)) (next (next-single-property-change (point) 'w3m-idle-image-item)) (prev-diff (and prev (abs (- (point) prev)))) (next-diff (and next (abs (- (point) next))))) (cond ((and prev next) (get-text-property (if (< prev-diff next-diff) prev next) 'w3m-idle-image-item)) (prev (get-text-property prev 'w3m-idle-image-item)) (next (get-text-property next 'w3m-idle-image-item)) (t nil))))) (car (last w3m-idle-images-show-list)))) (start (nth 0 item)) (end (nth 1 item)) (iurl (nth 2 item)) (url (nth 3 item)) (no-cache (nth 4 item)) (size (nth 5 item))) (setq w3m-idle-images-show-list (delete item w3m-idle-images-show-list)) (if (buffer-live-p (marker-buffer start)) (with-current-buffer (marker-buffer start) (save-restriction (widen) (let ((inhibit-read-only t)) (remove-text-properties start end '(w3m-idle-image-item)) (set-buffer-modified-p nil)) (w3m-process-with-null-handler (lexical-let ((start start) (end end) (iurl iurl) (url url)) (w3m-process-do (image (let ((w3m-current-buffer (current-buffer)) (w3m-message-silent t)) (w3m-create-image iurl no-cache url size handler))) (when (buffer-live-p (marker-buffer start)) (with-current-buffer (marker-buffer start) (save-restriction (widen) (if image (when (equal url w3m-current-url) (let ((inhibit-read-only t)) (w3m-insert-image start end image iurl)) ;; Redisplay (when w3m-force-redisplay (sit-for 0))) (let ((inhibit-read-only t)) (w3m-add-text-properties start end '(w3m-image-status off)))) (set-buffer-modified-p nil)) (set-marker start nil) (set-marker end nil)))))))) (set-marker start nil) (set-marker end nil) (w3m-idle-images-show-unqueue (marker-buffer start)))) (setq repeat (sit-for 0.1 t))) (if w3m-idle-images-show-list (when (input-pending-p) (cancel-timer w3m-idle-images-show-timer) (setq w3m-idle-images-show-timer (run-with-idle-timer w3m-idle-images-show-interval t 'w3m-idle-images-show))) (cancel-timer w3m-idle-images-show-timer) (setq w3m-idle-images-show-timer nil)))) (defun w3m-idle-images-show-unqueue (buffer) (when w3m-idle-images-show-timer (cancel-timer w3m-idle-images-show-timer) (setq w3m-idle-images-show-timer nil) (setq w3m-idle-images-show-list (delq nil (mapcar (lambda (x) (and (not (eq buffer (marker-buffer (nth 0 x)))) x)) w3m-idle-images-show-list))) (when w3m-idle-images-show-list (setq w3m-idle-images-show-timer (run-with-idle-timer w3m-idle-images-show-interval t 'w3m-idle-images-show))))) (defcustom w3m-confirm-leaving-secure-page t "If non-nil, you'll be asked for confirmation when leaving secure pages. This option controls whether the confirmation is made also when retrieving data (typically images) in a secure page from non-secure pages. It is STRONGLY recommended to set non-nil value to this option. You MUST understand what you want to do completely before switching off this option." :group 'w3m :type 'boolean) (defvar w3m-image-no-idle-timer nil) (defun w3m-toggle-inline-images-internal (status &optional no-cache url begin-pos end-pos safe-regexp) "Toggle displaying of inline images on current buffer. STATUS is current image status. If NO-CACHE is non-nil, cache is not used. If URL is specified, only the image with URL is toggled." (let ((cur-point (point)) (inhibit-read-only t) (end (or begin-pos (point-min))) (allow-non-secure-images (not w3m-confirm-leaving-secure-page)) start iurl image size) (unless end-pos (setq end-pos (point-max))) (save-excursion (if (equal status 'off) (while (< (setq start (if (w3m-image end) end (next-single-property-change end 'w3m-image nil end-pos))) end-pos) (setq end (or (next-single-property-change start 'w3m-image) (point-max)) iurl (w3m-image start) size (get-text-property start 'w3m-image-size)) (when (and (or (and (not url) (or (not w3m-ignored-image-url-regexp) (not (string-match w3m-ignored-image-url-regexp iurl)))) ;; URL is specified and is same as the image URL. (string= url iurl)) (not (eq (get-text-property start 'w3m-image-status) 'on))) (w3m-add-text-properties start end '(w3m-image-status on)) (if (get-text-property start 'w3m-image-redundant) (progn ;; Insert a dummy string instead of a redundant image. (setq image (make-string (string-width (buffer-substring start end)) ? )) (w3m-add-text-properties start end '(invisible t)) (goto-char end) (w3m-add-text-properties end (progn (insert image) (point)) '(w3m-image-dummy t w3m-image "dummy")) (setq end (point))) (goto-char cur-point) (when (and (w3m-url-valid iurl) (or (null safe-regexp) (string-match safe-regexp iurl)) (not (and (not (w3m-url-local-p w3m-current-url)) (w3m-url-local-p iurl))) (or (not w3m-current-ssl) (string-match "\\`\\(?:ht\\|f\\)tps://" iurl) allow-non-secure-images (and (prog1 (y-or-n-p "\ You are retrieving non-secure image(s). Continue? ") (message nil)) (setq allow-non-secure-images t)))) (if (or w3m-image-no-idle-timer (and (null (and size w3m-resize-images)) (or (string-match "\\`\\(?:cid\\|data\\):" iurl) (w3m-url-local-p iurl) (w3m-cache-available-p iurl)))) (w3m-process-with-null-handler (lexical-let ((start (set-marker (make-marker) start)) (end (set-marker (make-marker) end)) (iurl iurl) (url w3m-current-url)) (w3m-process-do (image (let ((w3m-current-buffer (current-buffer))) (w3m-create-image iurl no-cache w3m-current-url size handler))) (when (buffer-live-p (marker-buffer start)) (with-current-buffer (marker-buffer start) (if image (when (equal url w3m-current-url) (let ((inhibit-read-only t)) (w3m-insert-image start end image iurl)) ;; Redisplay (when w3m-force-redisplay (sit-for 0))) (let ((inhibit-read-only t)) (w3m-add-text-properties start end '(w3m-image-status off)))) (set-buffer-modified-p nil))) (set-marker start nil) (set-marker end nil)))) (let ((item (list (set-marker (make-marker) start) (set-marker (make-marker) end) (w3m-url-transfer-encode-string iurl) w3m-current-url no-cache size))) (setq w3m-idle-images-show-list (cons item w3m-idle-images-show-list)) (w3m-add-text-properties start end `(w3m-idle-image-item ,item)) (unless w3m-idle-images-show-timer (setq w3m-idle-images-show-timer (run-with-idle-timer w3m-idle-images-show-interval t 'w3m-idle-images-show))))))))) ;; Remove. (while (< (setq start (if (w3m-image end) end (next-single-property-change end 'w3m-image nil end-pos))) end-pos) (setq end (or (next-single-property-change start 'w3m-image) (point-max)) iurl (w3m-image start)) ;; IMAGE-ALT-STRING DUMMY-STRING ;; <--------w3m-image----------> ;; <---redundant--><---dummy---> ;; <---invisible--> (when (and (or (not url) ;; URL is specified and is not same as the image URL. (string= url iurl)) (not (eq (get-text-property start 'w3m-image-status) 'off))) (cond ((get-text-property start 'w3m-image-redundant) ;; Remove invisible property. (put-text-property start end 'invisible nil)) ((get-text-property start 'w3m-image-dummy) ;; Remove dummy string. (delete-region start end) (setq end start)) (t (w3m-remove-image start end))) (w3m-add-text-properties start end '(w3m-image-status off w3m-idle-image-item nil)))) (set-buffer-modified-p nil))))) (defun w3m-toggle-inline-image (&optional force no-cache) "Toggle the visibility of an image under point or images in the region. If FORCE is non-nil, displaying an image is forced. If NO-CACHE is non-nil, cached data will not be used." (interactive "P") (unless (w3m-display-graphic-p) (error "Can't display images in this environment")) (let (toggle-list begin end) (if (w3m-region-active-p) (let ((p (region-beginning)) iurl) (setq begin (region-beginning) end (region-end)) (w3m-deactivate-region) (while (< p end) (setq p (next-single-property-change p 'w3m-image nil end)) (when (and (< p end) (setq iurl (w3m-image p)) (not (assoc iurl toggle-list))) (setq toggle-list (cons (cons iurl p) toggle-list))))) (setq toggle-list (and (w3m-image) `(,(cons (w3m-image) (point)))))) (if toggle-list (dolist (x toggle-list) (let* ((url (car x)) (pos (cdr x)) (status (get-text-property pos 'w3m-image-status)) safe-regexp) (if (and (get-text-property pos 'w3m-image-scale) (equal status 'off)) (w3m-zoom-in-image 0) (if (w3m-url-valid url) (if (eq status 'on) (progn (if force (setq status 'off)) (w3m-toggle-inline-images-internal status no-cache url (or begin (point-min)) (or end (point-max)))) (setq safe-regexp (get-text-property (point) 'w3m-safe-url-regexp)) (if (or force (not safe-regexp) (string-match safe-regexp url)) (w3m-toggle-inline-images-internal status no-cache url (or begin (point-min)) (or end (point-max))) (when (w3m-interactive-p) (w3m-message "This image is considered to be unsafe;\ use the prefix arg to force display")))))))) (if begin (w3m-message "No images in region") (w3m-message "No image at point"))))) (defun w3m-turnoff-inline-images () "Turn off to display all images in the buffer or in the region." (interactive) (w3m-toggle-inline-images 'turnoff)) (defun w3m-toggle-inline-images (&optional force no-cache) "Toggle the visibility of all images in the buffer or in the region. If FORCE is neither nil nor `turnoff', displaying images is forced. The value `turnoff' is special; it turns displaying images off anyway. If NO-CACHE is non-nil, cached data will not be used. Note that the status of whether images are visible is kept hereafter even in new sessions if the `w3m-toggle-inline-images-permanently' variable is non-nil (default=t)." (interactive "P") (unless (w3m-display-graphic-p) (error "Can't display images in this environment")) (let ((status (cond ((eq force 'turnoff) t) (force nil) (t w3m-display-inline-images))) (safe-p t) beg end safe-regexp pos url) (if (w3m-region-active-p) (progn (setq beg (region-beginning) end (region-end)) (w3m-deactivate-region)) (setq beg (point-min) end (point-max))) (unless status (when (setq safe-regexp (get-text-property (point) 'w3m-safe-url-regexp)) ;; Scan the buffer for searching for an insecure image url. (setq pos beg) (setq safe-p (catch 'done (when (setq url (get-text-property pos 'w3m-image)) (unless (string-match safe-regexp url) (throw 'done nil)) (setq pos (next-single-property-change pos 'w3m-image))) (while (< pos end) (when (and (setq pos (next-single-property-change pos 'w3m-image nil end)) (setq url (get-text-property pos 'w3m-image))) (unless (string-match safe-regexp url) (throw 'done nil))) (setq pos (next-single-property-change pos 'w3m-image nil end))) t)))) (if (or force status (not safe-regexp) safe-p) (progn (unwind-protect (w3m-toggle-inline-images-internal (if status 'on 'off) no-cache nil beg end (unless (w3m-interactive-p) safe-regexp)) (setq w3m-display-inline-images (not status)) (when status (w3m-process-stop (current-buffer)) (w3m-idle-images-show-unqueue (current-buffer))) (force-mode-line-update))) (w3m-message "There are some images considered unsafe;\ use the prefix arg to force display")))) (defun w3m-resize-inline-image-internal (url rate) "Resize an inline image on the cursor position. URL is a url of an image. RATE is a number of percent used when resizing an image." (let* ((inhibit-read-only t) (start (point)) (end (or (next-single-property-change start 'w3m-image) (point-max))) (iurl (w3m-image start)) (size (get-text-property start 'w3m-image-size)) (iscale (or (get-text-property start 'w3m-image-scale) '100)) (allow-non-secure-images (not w3m-confirm-leaving-secure-page)) scale image) (w3m-add-text-properties start end '(w3m-image-status on)) (setq scale (* iscale rate 0.01)) (w3m-add-text-properties start end (list 'w3m-image-scale scale)) (setq scale (round scale)) (if (get-text-property start 'w3m-image-redundant) (progn ;; Insert a dummy string instead of a redundant image. (setq image (make-string (string-width (buffer-substring start end)) ? )) (w3m-add-text-properties start end '(invisible t)) (w3m-add-text-properties (point) (progn (insert image) (point)) '(w3m-image-dummy t w3m-image "dummy"))) (when (and (w3m-url-valid iurl) (or (not w3m-current-ssl) (string-match "\\`\\(?:ht\\|f\\)tps://" iurl) allow-non-secure-images (and (prog1 (y-or-n-p "\ You are retrieving non-secure image(s). Continue? ") (message nil)) (setq allow-non-secure-images t)))) (w3m-process-with-null-handler (lexical-let ((start (set-marker (make-marker) start)) (end (set-marker (make-marker) end)) (iurl iurl) (rate scale) (url w3m-current-url)) (w3m-process-do (image (let ((w3m-current-buffer (current-buffer))) (w3m-create-resized-image iurl rate w3m-current-url size handler))) (when (buffer-live-p (marker-buffer start)) (with-current-buffer (marker-buffer start) (if image (when (equal url w3m-current-url) (let ((inhibit-read-only t)) (w3m-static-when (featurep 'xemacs) (w3m-remove-image start end)) (w3m-insert-image start end image iurl) (w3m-image-animate image)) ;; Redisplay (when w3m-force-redisplay (sit-for 0))) (let ((inhibit-read-only t)) (w3m-add-text-properties start end '(w3m-image-status off)))) (set-buffer-modified-p nil)) (set-marker start nil) (set-marker end nil))))))))) (defun w3m-resize-image-interactive (image &optional rate changed-rate) "Interactively resize IMAGE. If RATE is not given, use `w3m-resize-image-scale'. CHANGED-RATE is currently changed rate / 100." (let ((char (w3m-static-if (featurep 'xemacs) (progn (message "Resize: [+ =] enlarge [-] shrink [0] original [q] quit") (read-char-exclusive)) (read-char-exclusive (propertize "Resize: [+ =] enlarge [-] shrink [0] original [q] quit" 'face 'w3m-lnum-minibuffer-prompt)))) (changed-rate (or changed-rate 1))) (w3m-static-if (featurep 'xemacs) (setq char (char-octet char))) (while (memq char '(?+ ?- ?= ?0)) (cond ((memq char '(?+ ?=)) (let ((percent (+ 100 (or rate w3m-resize-image-scale)))) (w3m-resize-inline-image-internal image percent) (setq changed-rate (* changed-rate (/ percent 100.0))))) ((eq char ?-) (let ((percent (/ 10000.0 (+ 100 (if rate (if (> rate 99) 99 rate) w3m-resize-image-scale))))) (w3m-resize-inline-image-internal image percent) (setq changed-rate (* changed-rate (/ percent 100.0))))) ((eq char ?0) (w3m-resize-inline-image-internal image (/ 100.0 changed-rate)) (setq changed-rate 1))) (setq char (w3m-static-if (featurep 'xemacs) (progn (message "Resize: [+ =] enlarge [-] shrink [0] original [q] quit") (read-char-exclusive)) (read-char-exclusive (propertize "Resize: [+ =] enlarge [-] shrink [0] original [q] quit" 'face 'w3m-lnum-minibuffer-prompt)))) (w3m-static-if (featurep 'xemacs) (setq char (char-octet char)))))) (defun w3m-zoom-in-image (&optional rate) "Zoom in an image on the point. Numeric prefix specifies how many percent the image is enlarged by \(30 means enlarging the image by 130%). The default is the value of the `w3m-resize-image-scale' variable." (interactive "P") (unless (w3m-display-graphic-p) (error "Can't display images in this environment")) (unless (w3m-imagick-convert-program-available-p) (error "ImageMagick's `convert' program is required")) (let ((url (w3m-image))) (if url (w3m-resize-inline-image-internal url (+ 100 (or rate w3m-resize-image-scale))) (w3m-message "No image at point")))) (defun w3m-zoom-out-image (&optional rate) "Zoom out an image on the point. Numeric prefix specifies how many percent the image is shrunk by. The default is the value of the `w3m-resize-image-scale' variable. The shrink percentage is interpreted as if the current image size is 100+percent and it is to be reduced back to 100. This is the inverse of `w3m-zoom-in-image' so zooming in then back out gives the original again." (interactive "P") (unless (w3m-display-graphic-p) (error "Can't display images in this environment")) (unless (w3m-imagick-convert-program-available-p) (error "ImageMagick's `convert' program is required")) (let ((url (w3m-image))) (if url (w3m-resize-inline-image-internal url (/ 10000.0 (+ 100 (or rate w3m-resize-image-scale)))) (w3m-message "No image at point")))) (defun w3m-decode-entities (&optional keep-properties) "Decode entities in the current buffer. If optional KEEP-PROPERTIES is non-nil, text property is reserved." (save-excursion (goto-char (point-min)) ;; Character entity references are case-sensitive. ;; cf. http://www.w3.org/TR/1999/REC-html401-19991224/charset.html#h-5.3.2 (let (case-fold-search start fid prop value) (while (re-search-forward w3m-entity-regexp nil t) (setq start (match-beginning 0) fid (get-text-property start 'w3m-form-field-id)) (unless (and fid (save-match-data (string-match "/type=\\(?:text\\|select\\)/name=[^/]+/" fid))) (when keep-properties (setq prop (text-properties-at start))) (unless (eq (char-after (match-end 1)) ?\;) (goto-char (match-end 1))) ;; Note that `w3m-entity-value' breaks `match-data' at the 1st ;; time in XEmacs because of the autoloading unicode.elc for ;; the `ucs-to-char' function. (when (setq value (w3m-entity-value (match-string 1))) (delete-region start (point)) (insert value)) (when prop (w3m-add-text-properties start (point) prop))))))) (defun w3m-decode-entities-string (str) "Decode entities in the string STR." (save-match-data ;; Character entity references are case-sensitive. ;; cf. http://www.w3.org/TR/1999/REC-html401-19991224/charset.html#h-5.3.2 (let ((case-fold-search) (pos 0) (buf)) (while (string-match w3m-entity-regexp str pos) (setq buf (cons (or (w3m-entity-value (match-string 1 str)) (match-string 1 str)) (cons (substring str pos (match-beginning 0)) buf)) pos (if (eq (aref str (match-end 1)) ?\;) (match-end 0) (match-end 1)))) (if buf (apply 'concat (nreverse (cons (substring str pos) buf))) str)))) (defun w3m-encode-specials-string (str) "Encode special characters in the string STR." (let ((pos 0) (buf)) (while (string-match "[<>&]" str pos) (setq buf (cons ";" (cons (gethash (match-string 0 str) w3m-entity-reverse-table) (cons "&" (cons (substring str pos (match-beginning 0)) buf)))) pos (match-end 0))) (if buf (apply 'concat (nreverse (cons (substring str pos) buf))) str))) (defun w3m-fontify () "Fontify the current buffer." (let ((case-fold-search t) (inhibit-read-only t)) (w3m-message "Fontifying...") (run-hooks 'w3m-fontify-before-hook) ;; Remove hidden anchors like " ". (goto-char (point-min)) (while (re-search-forward "]+>[\t\n ]*" nil t) (delete-region (match-beginning 0) (match-end 0))) ;; Delete tag (goto-char (point-min)) (if (search-forward "" nil t) (delete-region start (match-end 0)) (goto-char (point-min)))) ;; Delete extra title tag. (let (start) (and (search-forward "" nil t) (setq start (match-beginning 0)) (search-forward "" nil t) (delete-region start (match-end 0)))) (w3m-fontify-bold) (w3m-fontify-italic) (w3m-fontify-strike-through) (w3m-fontify-insert) (w3m-fontify-underline) (when w3m-use-symbol (w3m-replace-symbol)) (w3m-fontify-anchors) (when w3m-use-form (w3m-fontify-forms)) (w3m-fontify-images) ;; Remove other markups. (goto-char (point-min)) (while (re-search-forward "]*>" nil t) (let* ((start (match-beginning 0)) (fid (get-text-property start 'w3m-form-field-id))) (if (and fid (string-match "/type=text\\(?:area\\)?/" fid)) (goto-char (1+ start)) (delete-region start (match-end 0))))) ;; Decode escaped characters (entities). (w3m-decode-entities 'reserve-prop) (when w3m-use-form (w3m-fontify-textareas)) (goto-char (point-min)) (when w3m-delete-duplicated-empty-lines (while (re-search-forward "^[ \t]*\n\\(?:[ \t]*\n\\)+" nil t) (delete-region (match-beginning 0) (1- (match-end 0))))) ;; FIXME: The code above reduces number of empty lines but one line ;; remains. While such empty lines might have been inserted for ;; making sure of rooms for displaying images, they all should be ;; removed since they are useless for emacs-w3m. However, currently ;; we don't have a proper way to identify whether they were inserted ;; intentionally by the author or not. So, we decided to remove only ;; that one at the beginning of the buffer though it is unwillingness. (goto-char (point-min)) (skip-chars-forward "\t\n $B!!(B") (delete-region (point-min) (point-at-bol)) (w3m-header-line-insert) (put-text-property (point-min) (point-max) 'w3m-safe-url-regexp w3m-safe-url-regexp) (w3m-message "Fontifying...done") (run-hooks 'w3m-fontify-after-hook))) (defun w3m-refontify-anchor (&optional buff) "Refontify anchors as they have already arrived. It replaces the faces on the arrived anchors from `w3m-anchor' to `w3m-arrived-anchor'." (with-current-buffer (or buff (current-buffer)) (let (prop) (when (and (eq major-mode 'w3m-mode) (get-text-property (point) 'w3m-anchor-sequence) (setq prop (get-text-property (point) 'face)) (listp prop) (member 'w3m-anchor prop)) (let ((start) (end (next-single-property-change (point) 'w3m-anchor-sequence)) (inhibit-read-only t)) (when (and end (setq start (previous-single-property-change end 'w3m-anchor-sequence)) (w3m-arrived-p (get-text-property (point) 'w3m-href-anchor))) (w3m-remove-face-property start end 'w3m-anchor) (w3m-remove-face-property start end 'w3m-arrived-anchor) (w3m-add-face-property start end 'w3m-arrived-anchor)) (set-buffer-modified-p nil)))))) (defun w3m-url-completion (url predicate flag) "Completion function for URL." (if (string-match "\\`\\(?:file:\\|[/~]\\|\\.\\.?/\\|[a-zA-Z]:\\)" url) (if (eq flag 'lambda) (file-exists-p (w3m-url-to-file-name url)) (let* ((partial (expand-file-name (cond ((string-match "\\`file:[^/]" url) (substring url 5)) ((string-match "/\\(~\\)" url) (substring url (match-beginning 1))) (t (w3m-url-to-file-name url))))) (collection (let ((dir (file-name-directory partial))) (mapcar (lambda (f) (list (w3m-expand-file-name-as-url f dir))) (file-name-all-completions (file-name-nondirectory partial) dir))))) (setq partial (if (string-match "/\\.\\'" url) (concat (file-name-as-directory (w3m-expand-file-name-as-url partial)) ".") (w3m-expand-file-name-as-url partial))) (cond ((not flag) (try-completion partial collection predicate)) ((eq flag t) (all-completions partial collection predicate))))) (cond ((not flag) (try-completion url w3m-arrived-db)) ((eq flag t) (all-completions url w3m-arrived-db)) ((eq flag 'lambda) (if (w3m-arrived-p url) t nil))))) (defun w3m-shr-url-at-point () "Return a url that shr.el provides at point." (w3m-get-text-property-around 'shr-url)) (defun w3m-header-line-url () "Return w3m-current-url if point stays at header line." (let ((faces (get-text-property (point) 'face))) (when (and (eq major-mode 'w3m-mode) (listp faces) (or (memq 'w3m-header-line-location-title faces) (memq 'w3m-header-line-location-content faces)) w3m-current-url) w3m-current-url))) (eval-and-compile (autoload 'ffap-url-at-point "ffap") (cond ((featurep 'emacs) (defun w3m-url-at-point () (or (w3m-shr-url-at-point) (w3m-header-line-url) (ffap-url-at-point)))) ((featurep 'mule) (defun w3m-url-at-point () "\ Like `ffap-url-at-point', except that text props will be stripped and iso646 characters are unified into ascii characters." (or (w3m-header-line-url) (let ((left (buffer-substring-no-properties (point-at-bol) (point))) (right (buffer-substring-no-properties (point) (point-at-eol))) (regexp (format "[%c-%c]" (make-char 'latin-jisx0201 33) (make-char 'latin-jisx0201 126))) (diff (- (char-to-int (make-char 'latin-jisx0201 33)) 33)) index) (while (setq index (string-match regexp left)) (aset left index (- (aref left index) diff))) (while (setq index (string-match regexp right)) (aset right index (- (aref right index) diff))) (with-temp-buffer (insert right) (goto-char (point-min)) (insert left) (ffap-url-at-point)))))) (t (defun w3m-url-at-point () "Like `ffap-url-at-point', except that text props will be stripped." (or (w3m-header-line-url) (unless (fboundp 'ffap-url-at-point) ;; It is necessary to bind `ffap-xemacs'. (load "ffap" nil t)) (let (ffap-xemacs) (ffap-url-at-point))))))) (defvar ffap-url-regexp) (eval-after-load "ffap" '(progn ;; Under XEmacs, `ffap-url-regexp' won't match to https urls. (if (and ffap-url-regexp (not (string-match ffap-url-regexp "https://foo")) (string-match "\\((\\|\\\\|\\)\\(http\\)\\(\\\\|\\|\\\\)\\)" ffap-url-regexp)) (setq ffap-url-regexp (replace-match "\\1\\2s?\\3" nil nil ffap-url-regexp))) ;; Add nntp:. (if (and ffap-url-regexp (not (string-match ffap-url-regexp "nntp://bar")) (string-match "\\(\\\\(news\\\\(post\\\\)\\?:\\)\\(\\\\|\\)" ffap-url-regexp)) (setq ffap-url-regexp (replace-match "\\1\\\\|nntp:\\2" nil nil ffap-url-regexp))))) (defun w3m-active-region-or-url-at-point (&optional default-to) "Return an active region or a url around the cursor. In Transient Mark mode, deactivate the mark. If DEFAULT-TO is `never', only return a url found in the specified region if any. If it is nil, default to a url that an anchor at the point points to. If it is neither `never' nor nil, default to a url of the current page as the last resort." (if (w3m-region-active-p) (prog1 (let ((string (buffer-substring-no-properties (region-beginning) (region-end)))) (with-temp-buffer (insert string) (skip-chars-backward "\t\n\f\r $B!!(B") (delete-region (point) (point-max)) (goto-char (point-min)) (skip-chars-forward "\t\n\f\r $B!!(B") (delete-region (point-min) (point)) (while (re-search-forward "\ \\(?:[\t\f\r $B!!(B]+\n[\t\f\r $B!!(B]*\\|[\t\f\r $B!!(B]*\n[\t\f\r $B!!(B]+\\)+" nil t) (delete-region (match-beginning 0) (match-end 0))) (buffer-string))) (w3m-deactivate-region)) (unless (eq default-to 'never) (or (w3m-anchor) (unless w3m-display-inline-images (w3m-image)) (w3m-url-at-point) (and default-to (stringp w3m-current-url) (if (string-match "\\`about://\\(?:header\\|source\\)/" w3m-current-url) (substring w3m-current-url (match-end 0)) (let ((name (or (car (get-text-property (point) 'w3m-name-anchor)) (car (get-text-property (point) 'w3m-name-anchor2))))) (if name (concat w3m-current-url "#" name) w3m-current-url)))))))) (declare-function w3m-search-do-search "w3m-search") (defvar w3m-search-default-engine) (defun w3m-canonicalize-url (url &optional feeling-searchy) "Fix URL that does not look like a valid url. For a query that neither has a scheme part nor is an existing local file, return a search url for the default search engine. Also fix URL that fails to have put a separator following a domain name." (if (string-match "\\`\\(https?://[-.0-9a-z]+\\)\\([#?].*\\)" url) (concat (match-string 1 url) "/" (match-string 2 url)) (let (replaced) (cond ((and (setq replaced (ignore-errors (w3m-uri-replace url))) (not (string= url replaced))) replaced) ((file-exists-p url) (concat "file://" (expand-file-name url))) ((progn (w3m-string-match-url-components url) (match-beginning 1)) url) (feeling-searchy (require 'w3m-search) (w3m-search-do-search (lambda (url &rest rest) url) w3m-search-default-engine url)) (t (concat "https://" url)))))) (defcustom w3m-input-url-provide-initial-content nil "Provide an initial minibuffer content (if any) when entering a url. A url string is not worth editing in most cases since a url thing is generally a list of arbitrary letters, not a human readable one. So, we provide no initial content when prompting you for a url by default. But sometimes there will be a case to be convenient if you can modify the url string of [1]the link under the cursor or of [2]the current page. In that case, you can type the `M-n' key [1]once or [2]twice to fill the minibuffer with an initial content if you use Emacs 23 and up. Otherwise, set this variable to a non-nil value to always provide an initial content." :group 'w3m :type 'boolean) (defun w3m-input-url-default-add-completions () "Use the current url string (if any) as the next history by default. This function is used as `minibuffer-default-add-function'." (w3m-static-when (fboundp 'minibuffer-default-add-completions) (let* ((to-add (with-current-buffer (window-buffer (minibuffer-selected-window)) (or (w3m-active-region-or-url-at-point) w3m-current-url))) (def minibuffer-default) (all (all-completions "" minibuffer-completion-table minibuffer-completion-predicate)) (add2 (if (listp to-add) to-add (list to-add))) (def2 (if (listp def) def (list def)))) (append def2 add2 (delete def2 (delete def (delete add2 (delete to-add all)))))))) (defun w3m-input-url (&optional prompt initial default quick-start feeling-searchy no-initial) "Read a url from the minibuffer, prompting with string PROMPT." (let ((url ;; Check whether the region is active. (w3m-active-region-or-url-at-point 'never))) (w3m-arrived-setup) (cond ((null initial) (when (setq initial (or url (when (or w3m-input-url-provide-initial-content (not no-initial)) (w3m-active-region-or-url-at-point t)))) (if (string-match "\\`about:" initial) (setq initial nil) (unless (string-match "[^\000-\177]" initial) (setq initial (w3m-url-decode-string initial (or (w3m-url-coding-system initial) w3m-current-coding-system) "%\\([2-9a-f][0-9a-f]\\)")))))) ((string= initial "") (setq initial nil))) (when initial (setq initial (w3m-puny-decode-url initial))) (cond ((null default) (setq default (or url (w3m-active-region-or-url-at-point) w3m-home-page))) ((string= default "") (setq default nil))) (if (and quick-start default (not initial)) default (unless w3m-enable-feeling-searchy (setq feeling-searchy nil)) (setq url (let ((minibuffer-setup-hook (append minibuffer-setup-hook (list (lambda () (set (make-local-variable 'minibuffer-default-add-function) 'w3m-input-url-default-add-completions) (beginning-of-line) (if (looking-at "[a-z]+:\\(?:/+\\)?") (goto-char (match-end 0))))))) (keymap (copy-keymap w3m-url-completion-map)) (minibuffer-completion-table 'w3m-url-completion) (minibuffer-completion-predicate nil) (minibuffer-completion-confirm nil)) (set-keymap-parent keymap minibuffer-local-completion-map) (read-from-minibuffer (if prompt (if default (progn (when (string-match " *: *\\'" prompt) (setq prompt (substring prompt 0 (match-beginning 0)))) (concat prompt " (default " (cond ((equal default "about:blank") "BLANK") ((equal default w3m-home-page) "HOME") ((equal default w3m-current-url) "CURRENT") (t default)) "): ")) prompt) (if default (format "URL %s(default %s): " (if feeling-searchy "or Keyword " "") (if (stringp default) (cond ((string= default "about:blank") "BLANK") ((string= default w3m-home-page) "HOME") (t default)) (prin1-to-string default))) (if feeling-searchy "URL or Keyword: " "URL: "))) initial keymap nil 'w3m-input-url-history default))) (if (string-equal url "") (or default "") (if (stringp url) (progn ;; remove duplication (setq w3m-input-url-history (cons url (delete url w3m-input-url-history))) (w3m-canonicalize-url url feeling-searchy)) ;; It may be `popup'. url))))) ;;; Cache: (defun w3m-cache-setup () "Initialize the variables for managing the cache." (unless (and (bufferp w3m-cache-buffer) (buffer-live-p w3m-cache-buffer)) (with-current-buffer (w3m-get-buffer-create " *w3m cache*") (buffer-disable-undo) (set-buffer-multibyte nil) (setq buffer-read-only t w3m-cache-buffer (current-buffer) w3m-cache-hashtb (make-vector 1021 0))))) (defun w3m-cache-shutdown () "Clear all the variables managing the cache, and the cache itself." (when (buffer-live-p w3m-cache-buffer) (kill-buffer w3m-cache-buffer)) (setq w3m-cache-hashtb nil w3m-cache-articles nil)) (defun w3m-cache-header-delete-variable-part (header) (let (buf flag) (dolist (line (split-string header "\n+")) (if (string-match "\\`\\(?:Date\\|Server\\|W3m-[^:]+\\):" line) (setq flag t) (unless (and flag (string-match "\\`[ \t]" line)) (setq flag nil) (push line buf)))) (mapconcat (function identity) (nreverse buf) "\n"))) (defun w3m-cache-header (url header &optional overwrite) "Store HEADER into the cache so that it corresponds to URL. If OVERWRITE is non-nil, it forces the storing even if there has already been the data corresponding to URL in the cache." (w3m-cache-setup) (setq url (w3m-w3m-canonicalize-url url)) (let ((ident (intern url w3m-cache-hashtb))) (if (boundp ident) (if (and (not overwrite) (string= (w3m-cache-header-delete-variable-part header) (w3m-cache-header-delete-variable-part (symbol-value ident)))) (symbol-value ident) (w3m-cache-remove url) (set ident header)) (set ident header)))) (defun w3m-cache-request-header (url) "Return the header string of URL when it is stored in the cache." (w3m-cache-setup) (let ((ident (intern (w3m-w3m-canonicalize-url url) w3m-cache-hashtb))) (and (boundp ident) (symbol-value ident)))) (defun w3m-cache-remove-oldest () (with-current-buffer w3m-cache-buffer (goto-char (point-min)) (unless (zerop (buffer-size)) (let ((ident (get-text-property (point) 'w3m-cache)) (inhibit-read-only t)) ;; Remove the ident from the list of articles. (when ident (setq w3m-cache-articles (delq ident w3m-cache-articles))) ;; Delete the article itself. (delete-region (point) (next-single-property-change (1+ (point)) 'w3m-cache nil (point-max))))))) (defun w3m-cache-remove (url) "Remove the data coresponding to URL from the cache." (w3m-cache-setup) (let ((ident (intern url w3m-cache-hashtb)) beg end) (when (memq ident w3m-cache-articles) ;; It was in the cache. (with-current-buffer w3m-cache-buffer (let ((inhibit-read-only t)) (when (setq beg (text-property-any (point-min) (point-max) 'w3m-cache ident)) ;; Find the end (i. e., the beginning of the next article). (setq end (next-single-property-change (1+ beg) 'w3m-cache (current-buffer) (point-max))) (delete-region beg end))) (setq w3m-cache-articles (delq ident w3m-cache-articles)))))) (defun w3m-cache-contents (url buffer) "Store the contents of URL into the cache. The contents are assumed to be in BUFFER. Return a symbol which identifies the data in the cache." (w3m-cache-setup) (setq url (w3m-w3m-canonicalize-url url)) (let ((ident (intern url w3m-cache-hashtb))) (w3m-cache-remove url) ;; Remove the oldest article, if necessary. (and (numberp w3m-keep-cache-size) (>= (length w3m-cache-articles) w3m-keep-cache-size) (w3m-cache-remove-oldest)) ;; Insert the new article. (with-current-buffer w3m-cache-buffer (let ((inhibit-read-only t)) (goto-char (point-max)) (let ((b (point))) (insert-buffer-substring buffer) ;; Tag the beginning of the article with the ident. (when (> (point-max) b) (w3m-add-text-properties b (1+ b) (list 'w3m-cache ident)) (setq w3m-cache-articles (cons ident w3m-cache-articles)) ident)))))) (defun w3m-cache-request-contents (url &optional buffer) "Insert contents of URL into BUFFER. Return t if the contents are found in the cache, otherwise nil. When BUFFER is nil, all contents will be inserted in the current buffer." (w3m-cache-setup) (let ((ident (intern (w3m-w3m-canonicalize-url url) w3m-cache-hashtb))) (when (memq ident w3m-cache-articles) ;; It was in the cache. (let (beg end) (with-current-buffer w3m-cache-buffer (if (setq beg (text-property-any (point-min) (point-max) 'w3m-cache ident)) ;; Find the end (i.e., the beginning of the next article). (setq end (next-single-property-change (1+ beg) 'w3m-cache (current-buffer) (point-max))) ;; It wasn't in the cache after all. (setq w3m-cache-articles (delq ident w3m-cache-articles)))) (and beg end (with-current-buffer (or buffer (current-buffer)) (let ((inhibit-read-only t)) (insert-buffer-substring w3m-cache-buffer beg end)) t)))))) ;; FIXME: we need to check whether contents were updated in remote servers. (defun w3m-cache-available-p (url) "Return non-nil if a content of URL has already been cached." (w3m-cache-setup) (when (stringp url) (let ((ident (intern (w3m-w3m-canonicalize-url url) w3m-cache-hashtb))) (and (memq ident w3m-cache-articles) (or w3m-prefer-cache (save-match-data (let ((case-fold-search t) (head (and (boundp ident) (symbol-value ident))) time expire) (cond ((and (string-match "^\\(?:date\\|etag\\):[ \t]" head) (or (string-match "^pragma:[ \t]+no-cache\n" head) (string-match "^cache-control:\\(?:[^\n]+\\)?[ \t,]\\(?:no-cache\\|max-age=0\\)[,\n]" head))) nil) ((and (string-match "^date:[ \t]\\([^\n]+\\)\n" head) (setq time (match-string 1 head)) (setq time (w3m-time-parse-string time)) (string-match "^cache-control:\\(?:[^\n]+\\)?[ \t,]max-age=\\([1-9][0-9]*\\)" head) (setq expire (string-to-number (match-string 1 head)))) (setq time (decode-time time)) (setcar time (+ (car time) expire)) ;; Work around too large integer. (when (floatp (car time)) (setcar time (eval '(lsh -1 -1)))) (setq expire (apply 'encode-time time)) (w3m-time-newer-p expire (current-time))) ((and (string-match "^expires:[ \t]+\\([^\n]+\\)\n" head) (setq expire (match-string 1 head)) (setq expire (w3m-time-parse-string expire))) (w3m-time-newer-p expire (current-time))) (t ;; Adhoc heuristic rule: pages with neither ;; Last-Modified header and ETag header are treated as ;; dynamically-generated pages. (string-match "^\\(?:last-modified\\|etag\\):" head)))))) ident)))) (defun w3m-read-file-name (&optional prompt dir default existing) (unless prompt (setq prompt (if (and default (not (string-equal default ""))) (format "Save to (%s): " default) "Save to: "))) (setq dir (file-name-as-directory (or dir w3m-default-save-directory))) (let ((default-directory dir) (file (read-file-name prompt dir nil existing default))) (if (not (file-directory-p file)) (setq w3m-default-save-directory (or (file-name-directory file) w3m-default-save-directory)) (setq w3m-default-save-directory file) (if default (setq file (expand-file-name default file)))) (expand-file-name file))) ;;; Handling character sets: (defun w3m-charset-to-coding-system (charset) "Return a coding system which is most suitable to CHARSET. CHARSET is a symbol whose name is MIME charset. This function is imported from mcharset.el." (if (stringp charset) (setq charset (intern (downcase charset)))) (let ((cs (assq charset w3m-charset-coding-system-alist))) (w3m-find-coding-system (if cs (cdr cs) charset)))) (defun w3m-coding-system-to-charset (coding-system) "Return the MIME charset corresponding to CODING-SYSTEM." (when coding-system (w3m-static-if (featurep 'xemacs) (when (or (fboundp 'coding-system-to-mime-charset) (progn (require 'mcharset) (fboundp 'coding-system-to-mime-charset))) (defalias 'w3m-coding-system-to-charset 'coding-system-to-mime-charset) (w3m-coding-system-to-charset coding-system)) (or (coding-system-get coding-system :mime-charset) (coding-system-get coding-system 'mime-charset))))) ;; FIXME: we need to investigate the kind of Content-Charsets being ;; actually possible. (defun w3m-read-content-charset (prompt &optional default) "Read a content charset from the minibuffer, prompting with string PROMPT. The second argument DEFAULT is the default value, which is used as the value to return if the user enters the empty string." (let ((charset (completing-read prompt (nconc (mapcar (lambda (c) (cons (symbol-name c) c)) (coding-system-list)) (mapcar (lambda (c) (cons (symbol-name (car c)) c)) w3m-charset-coding-system-alist)) nil t))) (if (string= "" charset) default charset))) ;;; Handling encoding of contents: (defun w3m-decode-encoded-contents (encoding) "Decode encoded contents in the current buffer. Return t if successful. This function supports the encoding types gzip, bzip, and deflate." (let ((x (and (stringp encoding) (assoc (downcase encoding) w3m-encoding-alist)))) (if (and (eq (cdr x) 'gzip) (fboundp 'zlib-available-p) (zlib-available-p)) (zlib-decompress-region (point-min) (point-max)) (or (not (and x (setq x (cdr (assq (cdr x) w3m-decoder-alist))))) (let ((coding-system-for-write 'binary) (coding-system-for-read 'binary) (default-process-coding-system (cons 'binary 'binary))) (w3m-process-with-environment w3m-command-environment (zerop (apply 'call-process-region (point-min) (point-max) (w3m-which-command (car x)) t '(t nil) nil (cadr x))))))))) (defmacro w3m-correct-charset (charset) `(or (and ,charset (stringp ,charset) (cdr (assoc (downcase ,charset) w3m-correct-charset-alist))) ,charset)) (defun w3m-detect-meta-charset () (let ((case-fold-search t)) (goto-char (point-min)) (catch 'found (while (re-search-forward "\\(" nil t) (delete-region beg (point)))))) (defun w3m-remove-invisible-image-alt () "Remove alt=\"whitespace\" attributes in img tags. Such attributes not only obscure them but also might make images not be displayed especially in shimbun articles." (goto-char (point-min)) (let ((case-fold-search t) start end) (while (and (re-search-forward "\\(" nil t)) (progn (setq end (match-beginning 0)) (goto-char start) (re-search-forward "[\t\n\f\r ]+alt=\"[\t\n\f\r ]*\"" end t))) (delete-region (match-beginning 0) (match-end 0))))) (defun w3m-check-header-tags () "Process header tags (,) in the current buffer." (let ((case-fold-search t) tag) (goto-char (point-min)) (when (re-search-forward "]*\\)?>" nil t) (save-restriction (narrow-to-region (point-min) (point)) (goto-char (point-min)) (while (re-search-forward "<\\(link\\|base\\)[ \t\r\f\n]+" nil t) (setq tag (downcase (match-string 1))) (cond ((string= tag "link") (w3m-parse-attributes ((rel :case-ignore) href type) (when rel (setq rel (split-string rel)) (cond ((member "icon" rel) (setq w3m-icon-data (cons href type))) ((member "next" rel) (setq w3m-next-url href)) ((or (member "prev" rel) (member "previous" rel)) (setq w3m-previous-url href)) ((member "start" rel) (setq w3m-start-url href)) ((member "contents" rel) (setq w3m-contents-url href)))))) ;; ought to be absolute but if not then absolutize for ;; w3m-current-base-url. Helps bad seen ;; from from archive.org circa 2015. ((string= tag "base") (w3m-parse-attributes (href) (when (< 0 (length href)) (setq w3m-current-base-url (w3m-expand-url href))))))))))) (defun w3m-check-refresh-attribute () "Get REFRESH attribute in META tags." (setq w3m-current-refresh nil) (when w3m-use-refresh (let ((case-fold-search t) (refurl w3m-current-url) sec) (goto-char (point-min)) (catch 'found (while (re-search-forward "... within ... with ...
.
is a block element that should not appear within inline elements like , however some web sites, e.g., news.google.com.tw, do so and w3m regards it as an incomplete tag that is not closed." (let ((case-fold-search t)) (goto-char (point-min)) (while (re-search-forward "]" nil t) (when (w3m-end-of-tag "div") (replace-match (concat "") t t) (goto-char (match-beginning 0)))) (goto-char (point-max)))))) (defun w3m-rendering-extract-title () "Extract the title from the halfdump and put it into the current buffer." (goto-char (point-min)) (or (when (re-search-forward "" nil t) (prog1 (w3m-decode-entities-string (mapconcat 'identity (save-match-data (split-string (match-string 1))) " ")) (delete-region (match-beginning 0) (match-end 0)))) (when (and (stringp w3m-current-url) (string-match "/\\([^/]+\\)/?\\'" w3m-current-url)) (match-string 1 w3m-current-url)) "")) (defun w3m-set-display-ins-del () (when (eq w3m-display-ins-del 'auto) (with-temp-buffer (let* ((coding-system-for-read w3m-output-coding-system) (coding-system-for-write (if (eq 'binary w3m-input-coding-system) w3m-current-coding-system w3m-input-coding-system)) (default-process-coding-system (cons coding-system-for-read coding-system-for-write)) (env (copy-sequence w3m-command-environment)) type) (setq w3m-display-ins-del nil) (w3m-process-with-environment (cons '("LANG" . "C") (delq (assoc "LANG" env) env)) (call-process (or w3m-halfdump-command w3m-command) nil t nil "-o") (goto-char (point-min)) (when (re-search-forward "display_ins_del=<\\([^>]+\\)>" nil t) (setq type (match-string 1)) (cond ((string= type "number") (setq w3m-display-ins-del 'fontify)) ((string= type "bool") (setq w3m-display-ins-del 'tag))))))))) (defun w3m-rendering-half-dump (charset) ;; `charset' is used by `w3m-w3m-expand-arguments' to generate ;; arguments for w3mmee and w3m-m17n from `w3m-halfdump-command-arguments'. (w3m-set-display-ins-del) (let* ((coding-system-for-read w3m-output-coding-system) (coding-system-for-write (if (eq 'binary w3m-input-coding-system) w3m-current-coding-system w3m-input-coding-system)) (default-process-coding-system (cons coding-system-for-read coding-system-for-write))) (w3m-process-with-environment w3m-command-environment (apply 'call-process-region (point-min) (point-max) (or w3m-halfdump-command w3m-command) t t nil (w3m-w3m-expand-arguments (append w3m-halfdump-command-arguments w3m-halfdump-command-common-arguments ;; Image size conscious rendering (when (member "image" w3m-compile-options) (if (and w3m-treat-image-size (or (w3m-display-graphic-p) (and w3m-pixels-per-line w3m-pixels-per-character))) (list "-o" "display_image=on" "-ppl" (number-to-string (or w3m-pixels-per-line (w3m-static-if (featurep 'xemacs) (font-height (face-font 'default)) (frame-char-height)))) "-ppc" (number-to-string (or w3m-pixels-per-character (w3m-static-if (featurep 'xemacs) (font-width (face-font 'default)) (frame-char-width))))) (list "-o" "display_image=off"))))))))) (defun w3m-markup-urls-nobreak () "Make things that look like urls unbreakable. This function prevents non-link long urls from being broken (w3m tries to fold them). Things in textarea won't be modified." (let ((case-fold-search t) (beg (point-min)) (regexp (eval-when-compile ;; A copy of `gnus-button-url-regexp'. (concat "\\b\\(\\(www\\.\\|\\(s?https?\\|ftp\\|file\\|gopher\\|" "nntp\\|news\\|telnet\\|wais\\|mailto\\|info\\):\\)" "\\(//[-a-z0-9_.]+:[0-9]*\\)?" (if (string-match "[[:digit:]]" "1") ;; Support POSIX? (let ((chars "-a-z0-9_=#$@~%&*+\\/[:word:]") (punct "!?:;.,")) (concat "\\(?:" ;; Match paired parentheses, e.g. in Wikipedia URLs: ;; "[" chars punct "]+" "(" "[" chars punct "]+" "[" chars "]*)" "\\(?:" "[" chars punct "]+" "[" chars "]" "\\)?" "\\|" "[" chars punct "]+" "[" chars "]" "\\)")) (concat ;; XEmacs 21.4 doesn't support POSIX. "\\([-a-z0-9_=!?#$@~%&*+\\/:;.,]\\|\\w\\)+" "\\([-a-z0-9_=#$@~%&*+\\/]\\|\\w\\)")) "\\)"))) (nd (make-marker)) st) (goto-char beg) (while beg (save-restriction (narrow-to-region beg (if (re-search-forward "[\t\n ]*\\(" nil t) (match-beginning 1)) (goto-char nd) (goto-char st) (skip-chars-backward "\t\f ") (if (string-match "<" (buffer-substring (max (- (point) 4) (point-min)) (point))) (forward-char -4) (goto-char st)) (insert "") (goto-char nd) (when (looking-at "[\t\f ]*>") (goto-char (match-end 0))) (insert ""))) (goto-char (point-max))) (setq beg (and (not (eobp)) (progn (goto-char beg) (w3m-end-of-tag "textarea"))))) (set-marker nd nil))) (defun w3m-rendering-buffer (&optional charset) "Do rendering of contents in the currenr buffer as HTML and return title." (w3m-message "Rendering...") (w3m-remove-comments) (w3m-remove-invisible-image-alt) (w3m-check-header-tags) (w3m-check-refresh-attribute) (unless (eq w3m-type 'w3m-m17n) (w3m-remove-meta-charset-tags)) (w3m-fix-illegal-blocks) (w3m-markup-urls-nobreak) (w3m-rendering-half-dump charset) (w3m-message "Rendering...done") (w3m-rendering-extract-title)) (defun w3m-retrieve-and-render (url &optional no-cache charset post-data referer handler) "Retrieve contents of URL and render them in the current buffer. It returns a `w3m-process' object and comes to an end immediately. The HANDLER function will be called when rendering is complete. When a new content is retrieved in the buffer, the HANDLER function will be called with t as an argument. Otherwise, it will be called with nil." (when (and w3m-clear-display-while-reading (get-buffer-window (current-buffer) 'visible) (not (string-match "\\`about:" url))) ;; Clear the current display while reading a new page. (set-window-hscroll nil 0) (let ((inhibit-read-only t)) (erase-buffer) (insert-char ?\n (/ (window-height) 2)) (insert-char ? (max 0 (/ (- (window-width) (length url) 11) 2))) (insert "Reading " url "...") (sit-for 0))) (unless (and w3m-current-ssl w3m-confirm-leaving-secure-page ;; Permit leaving safe pages without confirmation for ;; several safe commands. For more detail of ;; definition of safe commands, see the thread ;; beginning at [emacs-w3m:09767]. (not (or (memq this-command '(w3m w3m-goto-url w3m-redisplay-this-page w3m-reload-this-page w3m-history w3m-view-next-page w3m-view-previous-page w3m-view-header w3m-view-source)) (string-match "\\`\\(?:ht\\|f\\)tps://" url) (prog1 (y-or-n-p "You are leaving secure page. Continue? ") (message nil))))) (lexical-let ((url (w3m-url-strip-fragment url)) (charset charset) (page-buffer (current-buffer)) (arrival-time (current-time)) (silent w3m-message-silent)) (w3m-process-do-with-temp-buffer (type (progn (w3m-clear-local-variables) (w3m-retrieve url nil no-cache post-data referer handler))) (when w3m-onload-url (setq url w3m-onload-url w3m-onload-url nil)) (let ((w3m-message-silent silent)) (when (buffer-live-p page-buffer) (setq url (w3m-url-strip-authinfo url)) (if type (if (string= type "X-w3m-error/redirection") (when (w3m-show-redirection-error-information url page-buffer) (w3m-arrived-add url nil (current-time) (current-time)) (w3m-message "Cannot retrieve URL: %s" url)) (let ((modified-time (w3m-last-modified url))) (w3m-arrived-add url nil modified-time arrival-time) (unless modified-time (setf (w3m-arrived-last-modified url) nil)) (let ((real (w3m-real-url url))) (unless (string= url real) (w3m-arrived-add url nil nil arrival-time) (setf (w3m-arrived-title real) (w3m-arrived-title url)) (setf (w3m-arrived-last-modified real) (w3m-arrived-last-modified url)) (setq url real))) (prog1 (w3m-create-page url (or (w3m-arrived-content-type url) type) (or charset (w3m-arrived-content-charset url) (w3m-content-charset url)) page-buffer) (w3m-force-window-update-later page-buffer 1e-9) (unless (get-buffer-window page-buffer) (w3m-message "The content (%s) has been retrieved in %s" url (buffer-name page-buffer)))))) (when (and w3m-clear-display-while-reading (string-match "\\`file:" url)) (with-current-buffer page-buffer (let ((inhibit-read-only t)) (when (ignore-errors (require 'zone)) (sit-for 0.5) (zone-call 'zone-pgm-dissolve 1)) (erase-buffer) (insert-char ?\n (/ (window-height) 2)) (insert-char ? (max 0 (/ (- (window-width) (length url) 15) 2))) (insert "Reading " url " ") (put-text-property (point) (progn (insert "failed!") (point)) 'face 'w3m-error) (setq w3m-current-url url w3m-current-title "Fail")))) (w3m-arrived-add url nil (current-time) (current-time)) (ding) (when (eq (car w3m-current-forms) t) (setq w3m-current-forms (cdr w3m-current-forms))) (prog1 (when (and w3m-show-error-information (not (or (w3m-url-local-p url) (string-match "\\`about:" url)))) (w3m-show-error-information url charset page-buffer)) (with-current-buffer page-buffer (w3m-message "Cannot retrieve URL: %s%s" url (cond ((and w3m-process-exit-status (not (equal w3m-process-exit-status 0))) (format " (exit status: %s)" w3m-process-exit-status)) (w3m-http-status (format " (http status: %s)" w3m-http-status)) (t "")))))))))))) (defun w3m-show-error-information (url charset page-buffer) "Create and prepare the error information." (let ((case-fold-search t) (header (w3m-cache-request-header url)) exit-status http-status errmsg) (with-current-buffer page-buffer (setq exit-status w3m-process-exit-status http-status w3m-http-status)) (setq errmsg (concat "

Cannot retrieve URL: " url "

\n" (cond ((and exit-status (not (equal exit-status 0))) (format "

%s exits with the code %s

\n" w3m-command exit-status)) (http-status (format "

%s %s

\n" http-status (or (cdr (assq http-status w3m-http-status-alist)) "")))))) (if (or (null header) (string-match "\\`w3m: Can't load " header)) (progn (insert errmsg) (unless http-status (insert "\

Something seems to be wrong with URL or this system.\n") (when (string-match "\\`news:" url) (insert "\
Also verify the value of the NNTPSERVER environment variable\ that should be the address of the NNTP server.\n"))) (save-restriction (narrow-to-region (point) (point)) (when (w3m-cache-request-contents url) (w3m-decode-encoded-contents (setq charset (w3m-content-encoding url))) (goto-char (point-min)) (insert "


\n

Contents


\n")))) (goto-char (point-min)) (or (search-forward "" nil t) (search-forward "" nil t)) (unless (bolp) (insert "\n")) (insert errmsg) (save-restriction (narrow-to-region (point) (point)) (when (w3m-cache-request-contents url) (w3m-decode-encoded-contents (setq charset (w3m-content-encoding url))) (goto-char (point-min)) (insert "


\n") (goto-char (point-max)))) (unless (eobp) (insert "


\n")) (when header (or (search-forward "" nil t) (search-forward "" nil 'max)) (unless (bolp) (insert "\n")) (insert "



Header information


\n
"
		header "
\n")))) (w3m-create-page url "text/html" charset page-buffer) nil) (defun w3m-show-redirection-error-information (url page-buffer) (erase-buffer) (insert (format "\n

Cannot retrieve URL: %s



%s" (format "%s" url url) "The number of redirections has exceeded a limit. This may have
\n happened due to the server side miss-configuration. Otherwise,
\n try increasing the limit, the value of `w3m-follow-redirection'.
\n")) (w3m-create-page url "text/html" "us-ascii" page-buffer)) (defun w3m-prepare-content (url type charset) "Prepare contents in the current buffer according to TYPE. URL is assumed to be a place where the contents come from. CHARSET is passed to the filter function corresponding to TYPE if it is specified in the `w3m-content-type-alist' variable." (let ((filter (nth 3 (assoc type w3m-content-type-alist)))) (cond ; Filter function is specified. ((functionp filter) (funcall filter url type charset)) ; Equivalent type is specified. ((stringp filter) filter) ; No filter is specified. ((not filter) type) ; Failed. (t "")))) (defun w3m-prepare-markdown-content (url type charset) (if w3m-markdown-converter (let ((coding-system-for-read 'utf-8) (coding-system-for-write 'utf-8)) (w3m-decode-buffer url charset type) (apply (function call-process-region) (point-min) (point-max) (car w3m-markdown-converter) t '(t nil) nil (cdr w3m-markdown-converter)) "text/html") "text/plain")) (defun w3m-detect-xml-type (url type charset) "Check if the type of xml contents of URL is xhtml+xml. If so return \"text/html\", otherwise \"text/plain\"." (with-temp-buffer (w3m-retrieve url) (w3m-decode-buffer url charset type) (goto-char (point-min)) (setq case-fold-search t) (if (re-search-forward "<[\t\n ]*html\\(?:\\(?:[\t\n ]+[^>]+\\)?>\\|[\t\n ]*>\\)" nil t) "text/html" "text/plain"))) (defun w3m-create-text-page (url type charset page-buffer) (w3m-safe-decode-buffer url charset type) (setq w3m-current-url (if (w3m-arrived-p url) (w3m-real-url url) url) w3m-current-title (if (string= "text/html" type) (let ((title (w3m-rendering-buffer charset))) (setf (w3m-arrived-title url) title) title) (or (when (string-match "\\`about://\\(?:source\\|header\\)/" url) (w3m-arrived-title (substring url (match-end 0)))) (file-name-nondirectory (if (string-match "/\\'" url) (directory-file-name url) url))))) (let ((result-buffer (current-buffer))) (with-current-buffer page-buffer (let ((inhibit-read-only t)) (widen) (delete-region (point-min) (point-max)) (insert-buffer-substring result-buffer) (goto-char (point-min)) (w3m-copy-local-variables result-buffer) (set-buffer-file-coding-system w3m-current-coding-system) (when (string= "text/html" type) (w3m-fontify)) 'text-page)))) (defsubst w3m-image-page-displayed-p () (and (fboundp 'image-mode-setup-winprops) w3m-current-url (string-match "\\`image/" (w3m-content-type w3m-current-url)) (eq (get-text-property (point-min) 'w3m-image-status) 'on))) (defun w3m-create-image-page (url type charset page-buffer) (when (w3m-image-type-available-p (w3m-image-type type)) (with-current-buffer page-buffer (let ((inhibit-read-only t)) (w3m-clear-local-variables) (setq w3m-current-url (w3m-real-url url) w3m-current-title (file-name-nondirectory url)) (widen) (delete-region (point-min) (point-max)) (insert w3m-current-title) (w3m-add-face-property (point-min) (point-max) 'w3m-image) (w3m-add-text-properties (point-min) (point-max) (list 'w3m-image url 'mouse-face 'highlight)) (when (fboundp 'image-mode-setup-winprops) (image-mode-setup-winprops)) 'image-page)))) (defun w3m-create-page (url type charset page-buffer) ;; Select a content type. (unless (and (stringp type) (assoc type w3m-content-type-alist)) (let ((cur (current-buffer)) (mb enable-multibyte-characters) dots cont) (with-temp-buffer (rename-buffer " *Raw Contents*" t) (set-buffer-multibyte mb) (save-window-excursion (pop-to-buffer (current-buffer)) (delete-other-windows) (ding) ;; Display the raw contents briefly. (sit-for 0) (setq truncate-lines t dots (make-string (/ (- (window-width) 6) 2) ?.)) (with-current-buffer cur (cond ((< (count-lines (point-min) (point-max)) (window-height)) (setq cont (buffer-string))) ((< (window-height) 10) (goto-char (point-min)) (forward-line (max 0 (- (window-height) 2))) (setq cont (concat (buffer-substring (point-min) (point)) "\n[" dots "snip" dots "]"))) (t (goto-char (point-min)) (forward-line (/ (- (window-height) 4) 2)) (setq cont (concat (buffer-substring (point-min) (point)) "\n[" dots "snip" dots "]\n\n")) (goto-char (point-max)) (forward-line (/ (- 4 (window-height)) 2)) (setq cont (concat cont (buffer-substring (point) (point-max))))))) (insert cont) (goto-char (point-min)) (setq type (condition-case nil (completing-read (format "Content type for %s (%s): " (file-name-nondirectory url) (if (zerop (length type)) "default download or external-view" (concat "`" type "' is unknown;\ default download or external-view"))) (cons "Download_or_External-view" w3m-content-type-alist) nil t) ;; The user forced terminating the session with C-g. (quit (w3m-process-stop page-buffer) ;; Needless? (with-current-buffer page-buffer (setq w3m-current-process nil)) (keyboard-quit)))) (unless (member type '("" "Download_or_External-view")) (setf (w3m-arrived-content-type url) type)))))) (setq w3m-current-coding-system nil) ; Reset decoding status of this buffer. (setq type (w3m-prepare-content url type charset)) (w3m-safe-decode-buffer url charset type) (setq charset (or charset w3m-current-content-charset)) (when w3m-use-filter (w3m-filter url)) (w3m-relationship-estimate url) ;; Create pages. (cond ((string-match "\\`text/" type) (w3m-create-text-page url type charset page-buffer)) ((and (w3m-display-graphic-p) (string-match "\\`image/" type)) (w3m-create-image-page url type charset page-buffer)) ((and (w3m-display-graphic-p) (member type w3m-doc-view-content-types)) (with-current-buffer page-buffer (setq w3m-current-url (if (w3m-arrived-p url) (w3m-real-url url) url))) (w3m-doc-view url)) (t (with-current-buffer page-buffer (setq w3m-current-url (if (w3m-arrived-p url) (w3m-real-url url) url) w3m-current-title (file-name-nondirectory w3m-current-url)) (let ((inhibit-read-only t)) (erase-buffer) (insert (format "This display does not support %s:\n<%s>" (if (string-match "\\`image/" type) "image" type) url)) (center-region (point-min) (point)) (goto-char (point-min)) (insert-char ?\n (/ (- (window-height) 3) 2))) (goto-char (point-min)) (w3m-external-view url) 'external-view)))) (defun w3m-relationship-estimate (url) "Estimate relationships between a page and others." (save-excursion (save-match-data (catch 'estimated (dolist (rule w3m-relationship-estimate-rules) (when (apply (car rule) url (cdr rule)) (throw 'estimated t))))))) (defun w3m-relationship-simple-estimate (url regexp &optional next previous start contents) "Search relationships with given patterns when the URL of the retrieved page matches the REGEXP." (when (string-match regexp url) (w3m-relationship-search-patterns url next previous start contents))) (defun w3m-relationship-magicpoint-estimate (url) "Search relationships for pages generated by MagicPoint." (goto-char (point-max)) (when (search-backward "Generated by MagicPoint" nil t) (goto-char (point-min)) (w3m-relationship-search-patterns url (eval-when-compile (concat "\\[next>\\]")) (eval-when-compile (concat "\\[<prev\\]")) (eval-when-compile (concat "\\[<<start\\]")) (eval-when-compile (concat "\\[index\\]"))))) (defun w3m-relationship-oddmuse-estimate (url) (when (string-match "/wiki\\?search=.*" url) (goto-char (point-min)) (and (re-search-forward "href=\"\\([^\"]+\\)\">Previous" nil t) (setq w3m-previous-url (match-string 1))) (and (re-search-forward "href=\"\\([^\"]+\\)\">Next" nil t) (setq w3m-next-url (match-string 1))))) (defun w3m-relationship-slashdot-estimate (url) (goto-char (point-min)) (when (and (string-match "slashdot\\.org/\\(article\\|comments\\)\\.pl\\?" url) (search-forward "
" nil t)) (let ((min (point)) (max (save-excursion (search-forward "
" nil t)))) ;; move to the position of the current page indicator and then search ;; for the next and previous link within the current
(when (and max (re-search-forward "\\(([0-9]+)\\)" max t)) (let ((re (concat ""))) (when (save-excursion (re-search-backward re min t)) (setq w3m-previous-url (w3m-expand-url (w3m-decode-anchor-string (or (match-string 2) (match-string 3) (match-string 1)))))) (when (re-search-forward re max t) (setq w3m-next-url (w3m-expand-url (w3m-decode-anchor-string (or (match-string 2) (match-string 3) (match-string 1))))))))))) (defun w3m-relationship-alc-estimate (url) ;; use filter (when (string-match "\\`http://eow\\.alc\\.co\\.jp/[^/]+/UTF-8/" url) (when (re-search-forward (concat "$BA0$X(B") nil t) (setq w3m-previous-url (w3m-expand-url (match-string 1) url))) (when (re-search-forward (concat "$B") nil t) (setq w3m-next-url (w3m-expand-url (match-string 1) url))) (unless (or w3m-previous-url w3m-next-url) ;; no use filter (goto-char (point-min)) (when (re-search-forward "$BA0$X(B" nil t) (setq w3m-previous-url (w3m-expand-url (format "?pg=%s" (match-string 1)) url))) (when (re-search-forward "$B" nil t) (setq w3m-next-url (w3m-expand-url (format "?pg=%s" (match-string 1)) url)))))) (defun w3m-relationship-search-patterns (url next previous &optional start contents) "Search relationships with given patterns." (goto-char (point-min)) (and next (re-search-forward next nil t) (setq w3m-next-url (w3m-expand-url (w3m-decode-anchor-string (or (match-string 2) (match-string 3) (match-string 1))) url)) (goto-char (point-min))) (and previous (re-search-forward previous nil t) (setq w3m-previous-url (w3m-expand-url (w3m-decode-anchor-string (or (match-string 2) (match-string 3) (match-string 1))) url)) (goto-char (point-min))) (and start (re-search-forward start nil t) (setq w3m-start-url (w3m-expand-url (w3m-decode-anchor-string (or (match-string 2) (match-string 3) (match-string 1))) url)) (goto-char (point-min))) (and contents (re-search-forward contents nil t) (setq w3m-contents-url (w3m-expand-url (w3m-decode-anchor-string (or (match-string 2) (match-string 3) (match-string 1))) url)))) (defun w3m-search-name-anchor (name &optional quiet no-record) (interactive "sName: ") (let ((pos (point-min)) (cur-pos (point)) oname found) (catch 'found (while (not found) (while (setq pos (next-single-property-change pos 'w3m-name-anchor)) (when (member name (get-text-property pos 'w3m-name-anchor)) (goto-char pos) (when (eolp) (forward-line)) (w3m-horizontal-on-screen) (throw 'found (setq found t)))) (setq pos (point-min)) (while (setq pos (next-single-property-change pos 'w3m-name-anchor2)) (when (member name (get-text-property pos 'w3m-name-anchor2)) (goto-char pos) (when (eolp) (forward-line)) (w3m-horizontal-on-screen) (throw 'found (setq found t)))) (if oname (progn (unless quiet (message "No such anchor: %s" oname)) (throw 'found nil)) (setq pos (point-min) oname name name (w3m-url-decode-string name))))) (when (and found (not no-record) (/= (point) cur-pos)) (setq w3m-name-anchor-from-hist (append (list 1 nil (point) cur-pos) (and (integerp (car w3m-name-anchor-from-hist)) (nthcdr (1+ (car w3m-name-anchor-from-hist)) w3m-name-anchor-from-hist))))) (when found (w3m-recenter)) found)) (defun w3m-parent-page-available-p () (if (null w3m-current-url) nil (save-match-data (string-match "\\`[a-z]+://?[^/]+/." w3m-current-url)))) (defun w3m-url-savable-p () "Return non-nil if the current page is able to be saved." (and w3m-current-url (or (not (string-match "\\`\\(?:about\\|file\\):" w3m-current-url)) (string-match "\\`about://\\(?:header\\|source\\)/" w3m-current-url)))) (defun w3m-view-parent-page (&optional count) "Attempt to move to the parent directory of the page currently displayed. For instance, it will let you visit \"http://foo/bar/\" if you are currently viewing \"http://foo/bar/baz\". If COUNT is a integer, you will visit the parent directory to step up the COUNT. If COUNT is zero, you will visit the top of this site." (interactive "p") (unless (integerp count) (setq count 1)) (setq count (abs count)) (w3m-history-store-position) (cond ((and w3m-current-url (eq count 0) (string-match "\\`[a-z]+:///?[^/]+/" w3m-current-url)) (w3m-goto-url (match-string 0 w3m-current-url))) (w3m-start-url (w3m-goto-url w3m-start-url)) (w3m-contents-url (w3m-goto-url w3m-contents-url)) (w3m-current-url (let ((parent-url w3m-current-url)) (catch 'loop (while (not (zerop count)) (setq count (1- count)) ;; Check whether http://foo/bar/ or http://foo/bar (if (string-match "/$" parent-url) (if (string-match "\\(.*\\)/[^/]+/$" parent-url) ;; http://foo/bar/ -> http://foo/ (setq parent-url (concat (match-string 1 parent-url) "/"))) (if (string-match "\\(.*\\)/.+$" parent-url) ;; http://foo/bar -> http://foo/ (setq parent-url (concat (match-string 1 parent-url) "/")))) ;; Ignore "http:/" (cond ((string-match "\\`[a-z]+:///?[^/]+/\\'" parent-url) (throw 'loop t)) ((and parent-url (string-match "\\`[a-z]+:/+\\'" parent-url)) (setq parent-url nil) (throw 'loop nil))))) (if parent-url (w3m-goto-url parent-url) (error "No parent page for: %s" w3m-current-url)))) (t (error "w3m-current-url is not set")))) (defun w3m-view-previous-page (&optional count) "Move back COUNT pages in the history. If COUNT is a positive integer, move backward COUNT times in the history. If COUNT is a negative integer, moving forward is performed. COUNT is treated as 1 by default if it is omitted." (interactive "p") (unless w3m-current-url ;; This page may have not been registered in the history since an ;; accident has probably occurred, so we should skip the page. (if (integerp count) (when (> count 0) (decf count)) (setq count 0))) (let ((index (car w3m-name-anchor-from-hist)) pos) (if (and (integerp count) (integerp index) (< 0 (setq index (+ index count))) (setq pos (nth index w3m-name-anchor-from-hist))) (progn (when (and (= (point) pos) (nth (1+ index) w3m-name-anchor-from-hist)) (setq index (1+ index))) (goto-char (nth index w3m-name-anchor-from-hist)) (setcar w3m-name-anchor-from-hist index) ;; Restore last position. (w3m-history-restore-position)) (let ((hist ;; Cons of a new history element and position pointers. (if (integerp count) (w3m-history-backward count) (w3m-history-backward))) ;; Inhibit sprouting of a new history. (w3m-history-reuse-history-elements t)) (if (caar hist) (let ((w3m-prefer-cache t)) ;; Save last position. (w3m-history-store-position) (w3m-goto-url (caar hist) nil nil (w3m-history-plist-get :post-data) (w3m-history-plist-get :referer) nil (w3m-history-element (caddr hist) t)) ;; Set the position pointers in the history. (setcar w3m-history (cdr hist)) ;; Restore last position. (w3m-history-restore-position)) (message "There's no more history")))))) (defun w3m-view-next-page (&optional count) "Move forward COUNT pages in history. If COUNT is a positive integer, move forward COUNT times in the history. If COUNT is a negative integer, moving backward is performed. COUNT is treated as 1 by default if it is omitted." (interactive "p") (w3m-view-previous-page (if (integerp count) (- count) -1))) (defun w3m-expand-path-name (file base) (let ((input (if (eq (elt file 0) ?/) file (concat base file))) (output "")) (save-match-data (while (string-match "^\\(?:\\.\\.?/\\)+" input) (setq input (substring input (match-end 0)))) (while (not (zerop (length input))) (cond ((string-match "^/\\.\\(?:/\\|$\\)" input) (setq input (concat "/" (substring input (match-end 0))))) ((string-match "^/\\.\\.\\(?:/\\|$\\)" input) (setq input (concat "/" (substring input (match-end 0)))) (when (string-match "/?[^/]+$" output) (setq output (substring output 0 (match-beginning 0))))) ((string-match "^\\.\\.?$" input) (setq input "")) (t (let ((end (and (string-match "^/[^/]*" input) (match-end 0)))) (setq output (concat output (substring input 0 end))) (setq input (substring input end)))))) output))) (defconst w3m-url-hierarchical-schemes '("http" "https" "ftp" "ftps" "file") "List of schemes which may have hierarchical parts. This list is refered to by `w3m-expand-url' to keep backward compatibility which is described in Section 5.2 of RFC 2396.") (defconst w3m-buffer-local-url "buffer://") (defun w3m-buffer-local-url-p (url) (save-match-data (string-match (concat "^" w3m-buffer-local-url) url))) (defun w3m-expand-url (url &optional base) "Convert URL to the absolute address, and canonicalize it." (save-match-data (if base (if (progn (w3m-string-match-url-components base) (match-beginning 1)) (and (not (match-beginning 3)) (member (downcase (match-string 2 base)) w3m-url-hierarchical-schemes) (setq base (concat (substring base 0 (match-end 1)) "//" (substring base (match-beginning 5))))) (error "BASE must have a scheme part: %s" base)) (setq base (or w3m-current-base-url w3m-current-url ;; Make url absolutely invalid. See `w3m-url-valid'. w3m-url-invalid-base))) (w3m-string-match-url-components url) ;; Remove an empty fragment part. (when (and (match-beginning 8) (= (match-beginning 9) (length url))) (setq url (substring url 0 (match-beginning 8))) (w3m-string-match-url-components url)) ;; Remove an empty query part. (when (and (match-beginning 6) (= (match-beginning 7) (or (match-beginning 8) (length url)))) (setq url (concat (substring url 0 (match-beginning 6)) (if (match-beginning 8) (substring url (match-beginning 8)) "")) base (progn (w3m-string-match-url-components base) (substring base 0 (match-beginning 6)))) (w3m-string-match-url-components url)) (cond ((match-beginning 1) ;; URL has a scheme part. => URL may have an absolute spec. (if (or (match-beginning 3) (and (< (match-beginning 5) (length url)) (eq ?/ (aref url (match-beginning 5))))) ;; URL has a net-location part or an absolute hierarchical ;; part. => URL has an absolute spec. url (let ((scheme (match-string 2 url))) (if (and (member (downcase scheme) w3m-url-hierarchical-schemes) (progn (w3m-string-match-url-components base) (equal scheme (match-string 2 base)))) (w3m-expand-url (substring url (match-end 1)) base) url)))) ((match-beginning 3) ;; URL has a net-location part. => The hierarchical part of URL ;; has an absolute spec. (w3m-string-match-url-components base) (concat (substring base 0 (match-end 1)) url)) ((> (match-end 5) (match-beginning 5)) (let ((path-end (match-end 5))) (if (string-equal base w3m-buffer-local-url) (if (eq (aref url 0) ?#) (concat base url) ;; Assume url omits the scheme, that is http. (concat "http://" url)) (w3m-string-match-url-components base) (concat (substring base 0 (match-beginning 5)) (if (and (match-beginning 2) (member (downcase (match-string 2 base)) w3m-url-hierarchical-schemes)) (w3m-expand-path-name (substring url 0 path-end) (or ;; Avoid file name handlers; cf. ;; (let (file-name-handler-alist) (file-name-directory (match-string 5 base))) "/")) (substring url 0 path-end)) (substring url path-end))))) ((match-beginning 6) ;; URL has a query part. (w3m-string-match-url-components base) (concat (substring base 0 (match-end 5)) url)) (t ;; URL has only a fragment part. (w3m-string-match-url-components base) (concat (substring base 0 (match-beginning 8)) url))))) (defun w3m-display-progress-message (url) "Show \"Reading URL...\" message in the middle of a buffer." (insert (make-string (max 0 (/ (1- (window-height)) 2)) ?\n) "Reading " (w3m-url-readable-string (w3m-url-strip-authinfo url)) "...") (beginning-of-line) (let ((fill-column (window-width))) (center-region (point) (point-max))) (goto-char (point-min)) (put-text-property (point) (point-max) 'w3m-progress-message t) (sit-for 0)) (defvar w3m-parent-session-buffer nil "A buffer of the parent session that launches this session. This is used to make `w3m-delete-buffer' return to the session that launches the current session, i.e., the one to be deleted.") (make-variable-buffer-local 'w3m-parent-session-buffer) (defun w3m-view-this-url-1 (url reload new-session) (lexical-let ((url url) pos buffer) (if new-session (let ((empty ;; If a new url has the #name portion, we simply copy ;; the buffer's contents to the new session, otherwise ;; creating an empty buffer. (not (and (progn (w3m-string-match-url-components url) (match-beginning 8)) (string-equal w3m-current-url (substring url 0 (match-beginning 8)))))) (parent (current-buffer))) (setq pos (point-marker) buffer (w3m-copy-buffer nil nil nil empty w3m-new-session-in-background t)) (when w3m-new-session-in-background (set-buffer buffer)) (setq w3m-parent-session-buffer parent) (when empty (w3m-display-progress-message url))) (setq buffer (current-buffer))) (let (handler) (w3m-process-do (success (w3m-goto-url url reload nil nil w3m-current-url handler nil w3m-new-session-in-background)) (set-window-hscroll (selected-window) 0) ;; Delete the newly created buffer if it's been made empty. (when (and pos (buffer-name buffer)) (w3m-delete-buffer-if-empty buffer)) (when pos ;; the new session is created. ;; FIXME: what we should actually do is to modify the `w3m-goto-url' ;; function so that it may return a proper value, and checking it. (when (and (marker-buffer pos) (buffer-name (marker-buffer pos))) (with-current-buffer (marker-buffer pos) (save-excursion (goto-char pos) (w3m-refontify-anchor))))) (w3m-recenter))))) (defun w3m-view-this-url (&optional arg new-session) "Display the page pointed to by the link under point. If ARG is the number 2 or the list of the number 16 (you may produce this by typing `C-u' twice) or NEW-SESSION is non-nil and the link is an anchor, this function makes a copy of the current buffer in advance. Otherwise, if ARG is non-nil, it forces to reload the url at point." (interactive (if (member current-prefix-arg '(2 (16))) (list nil t) (list current-prefix-arg nil))) ;; Store the current position in the history structure. (w3m-history-store-position) (let ((w3m-prefer-cache (or w3m-prefer-cache (and (stringp w3m-current-url) (string-match "\\`about://\\(?:db-\\)?history/" w3m-current-url)))) act url) (cond ((setq act (w3m-action)) (let ((w3m-form-new-session new-session) (w3m-form-download nil)) (eval act))) ((setq url (w3m-url-valid (w3m-anchor))) (w3m-view-this-url-1 url arg new-session)) ((w3m-url-valid (w3m-image)) (if (w3m-display-graphic-p) (w3m-toggle-inline-image) (w3m-view-image))) ((setq url (w3m-active-region-or-url-at-point 'never)) (unless (eq 'quit (setq url (w3m-input-url nil url 'quit nil 'feeling-searchy 'no-initial))) (w3m-view-this-url-1 url arg new-session))) (t (w3m-message "No URL at point"))))) (eval-and-compile (autoload 'mouse-set-point "mouse")) (defun w3m-mouse-view-this-url (event &optional arg) "Follow the link under the mouse pointer." (interactive "e\nP") (mouse-set-point event) (w3m-view-this-url arg)) (defun w3m-open-all-links-in-new-session (start end &optional arg) "Open all http links between START and END as new sessions. If the page looks like Google's search result and the START point is the beginning of a line, only the links displayed in the beginning of lines are picked up. If ARG is non-nil, it forces to reload all links. If Transient Mark mode, deactivate the mark." (interactive "r\nP") (when (w3m-region-active-p) (w3m-deactivate-region)) (let ((buffer (current-buffer)) (prev start) (url (w3m-url-valid (w3m-anchor start))) urls all) (when url (setq urls (list url))) (save-excursion (goto-char start) (setq all (not (and (bolp) w3m-current-url (string-match "\\`https?://\\(?:[^/]+\\.\\)*google\\." w3m-current-url)))) (while (progn (w3m-next-anchor) (and (> (point) prev) (< (point) end))) (setq prev (point)) (when (and (setq url (w3m-url-valid (w3m-anchor))) (string-match "\\`https?:" url) (or all (bolp))) (push url urls)))) (setq urls (nreverse urls)) (while urls (setq url (car urls) urls (cdr urls)) (set-buffer buffer) (w3m-view-this-url-1 url arg t)))) (defun w3m-view-this-url-new-session () "Display the page of the link under point in a new session. If the region is active, use the `w3m-open-all-links-in-new-session' command instead." (interactive) (if (w3m-region-active-p) (call-interactively 'w3m-open-all-links-in-new-session) (w3m-view-this-url nil t))) (defun w3m-mouse-view-this-url-new-session (event) "Follow the link under the mouse pointer in a new session." (interactive "e") (mouse-set-point event) (w3m-view-this-url nil t)) (defun w3m-submit-form (&optional new-session) "Submit the form at point." (interactive "P") (let ((submit (w3m-submit))) (if (and submit w3m-current-url (w3m-url-valid w3m-current-url) (if w3m-submit-form-safety-check (prog1 (y-or-n-p "Submit? ") (message nil)) t)) (let ((w3m-form-new-session new-session) (w3m-form-download nil)) (eval submit)) (w3m-message "Can't submit form at this point")))) (defun w3m-external-view (url &optional no-cache handler) (when (w3m-url-valid url) (lexical-let ((url url) (no-cache no-cache)) (w3m-process-do (type (w3m-content-type url no-cache handler)) (when type (lexical-let ((method (or (nth 2 (assoc type w3m-content-type-alist)) (nth 2 (assoc (w3m-prepare-content url type nil) w3m-content-type-alist)))) (default (nth 2 (assoc "text/html" w3m-content-type-alist)))) (when (and (not method) default) (setq method default)) (cond ((not method) (if (w3m-url-local-p url) (error "\ No method to view `%s' is registered. Use `w3m-edit-this-url'" (file-name-nondirectory (w3m-url-to-file-name url))) (w3m-download url nil no-cache handler))) ((functionp method) (funcall method url)) ((consp method) (lexical-let ((command (w3m-which-command (car method))) (arguments (cdr method)) (file (make-temp-name (expand-file-name "w3mel" w3m-external-view-temp-directory))) suffix) (setq suffix (file-name-nondirectory url)) (when (string-match "\\.[a-zA-Z0-9]+$" suffix) (setq suffix (match-string 0 suffix)) (when (< (length suffix) 5) (setq file (concat file suffix)))) (cond ((and command (memq 'file arguments)) (let ((w3m-current-buffer (current-buffer))) (w3m-process-do (success (w3m-download url file no-cache handler)) (when success (w3m-external-view-file command file url arguments))))) (command (w3m-external-view-file command nil url arguments)) (t (w3m-download url nil no-cache handler)))))))))))) (defun w3m-external-view-file (command file url arguments) ;; The 3rd argument `url' is necessary to handle the constant `url' ;; included in the 4th argument `arguments' which is provided by ;; `w3m-content-type-alist'. (lexical-let ((file file)) (let (proc) (unwind-protect (with-current-buffer (generate-new-buffer " *w3m-external-view*") (setq proc (apply 'start-process "w3m-external-view" (current-buffer) command (mapcar (function eval) arguments))) (w3m-message "Start %s..." (file-name-nondirectory command)) (set-process-sentinel proc (lambda (proc event) (let ((buffer (process-buffer proc))) (when (string-match "^\\(?:finished\\|exited\\)" event) ;; Some program lies that the process has been finished ;; even though it has not read the temp file yet, so ;; it is necessary to delay deleting of the file. (run-at-time 1 nil (lambda (file buffer) (when (file-exists-p file) (delete-file file)) (when (buffer-name buffer) (kill-buffer buffer)) (message "")) file buffer)))))) (and (stringp file) (file-exists-p file) (unless (and (processp proc) (memq (process-status proc) '(run stop))) (delete-file file))))))) (defun w3m-view-image () "Display the image under point in the external viewer. The viewer is defined in `w3m-content-type-alist' for every type of an image." (interactive) (let ((url (w3m-url-valid (w3m-image)))) (if url (w3m-external-view url) (w3m-message "No image at point")))) (defun w3m-save-image () "Save the image under point to a file. The default name will be the original name of the image." (interactive) (let ((url (w3m-url-valid (w3m-image)))) (if url (w3m-download url) (w3m-message "No image at point")))) (defun w3m-external-view-this-url () "Launch the external browser and display the link an point." ;; This command was listed in the menu bar and a link menu till ;; 2013-10-17. As someone may still need it, don't delete it even ;; if emacs-w3m no longer uses. (interactive) (let ((url (w3m-url-valid (or (w3m-anchor) (w3m-image))))) (if url (w3m-external-view url) (w3m-message "No URL at point")))) (defun w3m-external-view-current-url () "Launch the external browser and display the current URL." ;; This command was listed in the menu bar till 2013-10-17. ;; As someone may still need it, don't delete it even if emacs-w3m ;; no longer uses. (interactive) (if w3m-current-url (w3m-external-view w3m-current-url) (w3m-message "No URL at this page"))) (defun w3m-view-url-with-external-browser (&optional url) "Launch the external browser and display the same web page. If the cursor points to a link, it visits the url of the link instead of the url currently displayed. The browser is defined in `w3m-content-type-alist' for every type of a url." ;; This command bound the M key and was listed in the tab menu till ;; 2013-10-17. As someone may still need it, don't delete it even ;; if emacs-w3m no longer uses. (interactive (list (w3m-input-url "URL to view externally: " nil (or (w3m-anchor) (unless w3m-display-inline-images (w3m-image)) w3m-current-url) nil nil 'no-initial))) (when (w3m-url-valid url) (message "Browsing <%s>..." url) (w3m-external-view url))) (defun w3m-view-url-with-browse-url (url) "Run `browse-url' to open URL." (interactive (list (let ((w3m-display-inline-images t)) (w3m-active-region-or-url-at-point t)))) (if (and (stringp url) (not (string-match "\\`about:" url))) (progn (w3m-message "Browsing %s..." url) (browse-url url)) (w3m-message "No url at point"))) (defun w3m-download-this-url () "Download the file or the page pointed to by the link under point." (interactive) (let ((url (or (w3m-anchor) (w3m-image))) act) (cond ((w3m-url-valid url) (lexical-let ((pos (point-marker)) (curl w3m-current-url)) (w3m-process-with-null-handler (w3m-process-do (success (w3m-download url nil nil handler)) (and success (buffer-name (marker-buffer pos)) (with-current-buffer (marker-buffer pos) (when (equal curl w3m-current-url) (goto-char pos) (w3m-refontify-anchor)))))))) ((setq act (w3m-action)) (let ((w3m-form-download t)) (eval act))) (t (w3m-message "No URL at point"))))) (defun w3m-download-this-image () "Download the image under point." (interactive) (let ((url (w3m-image)) act) (cond ((w3m-url-valid url) (lexical-let ((pos (point-marker)) (curl w3m-current-url)) (w3m-process-with-null-handler (w3m-process-do (success (w3m-download url nil nil handler)) (and success (buffer-name (marker-buffer pos)) (with-current-buffer (marker-buffer pos) (when (equal curl w3m-current-url) (goto-char pos) (w3m-refontify-anchor)))))))) ((setq act (w3m-action)) (let ((w3m-form-download t)) (eval act))) (t (w3m-message "No image at point"))))) (defun w3m-print-current-url () "Display the current url in the echo area and put it into `kill-ring'." (interactive) (when w3m-current-url (let ((deactivate-mark nil)) (kill-new (w3m-url-encode-string-2 w3m-current-url)) (w3m-message "%s" (w3m-url-readable-string w3m-current-url))))) (defvar message-truncate-lines) (defun w3m-print-this-url (&optional interactive-p) "Display the url under point in the echo area and put it into `kill-ring'." (interactive (list t)) (let ((deactivate-mark nil) (url (if interactive-p (or (w3m-anchor) (w3m-image) (and (stringp w3m-current-url) (let ((name (or (car (get-text-property (point) 'w3m-name-anchor)) (car (get-text-property (point) 'w3m-name-anchor2))))) (when name (concat w3m-current-url "#" name))))) (or (w3m-anchor (point)) (w3m-image (point))))) (alt (if interactive-p (w3m-image-alt) (w3m-image-alt (point)))) (title (if interactive-p (w3m-anchor-title) (w3m-anchor-title (point))))) (when (or url interactive-p) (and url interactive-p (kill-new (w3m-url-encode-string-2 url))) (setq url (or (w3m-url-readable-string url) (and (w3m-action) "There is a form") "There is no url under point")) (w3m-message "%s" (cond ((> (length alt) 0) (concat alt ": " url)) ((> (length title) 0) ;; XEmacs21 doesn't have `message-truncate-lines' ;; and always truncates messages, so one line in ;; that case. (let ((str (concat title " (" url ")"))) (if (or (not (boundp 'message-truncate-lines)) message-truncate-lines (< (string-width str) (- (frame-width) 2))) ;; one line if fits or truncating str ;; or two lines if bigger than frame-width (concat title "\n" url)))) (t url)))))) (defun w3m-print-this-image-url (&optional interactive-p) "Display image url under point in echo area and put it into `kill-ring'." (interactive (list t)) (let ((deactivate-mark nil) (url (if interactive-p (w3m-image) (w3m-image (point)))) (alt (if interactive-p (w3m-image-alt) (w3m-image-alt (point))))) (when (or url interactive-p) (and url interactive-p (kill-new (w3m-url-encode-string-2 url))) (w3m-message "%s%s" (if (zerop (length alt)) "" (concat alt ": ")) (or (w3m-url-readable-string url) (and (w3m-action) "There is a form") "There is no image url under point"))))) (defmacro w3m-delete-all-overlays () "Delete all momentary overlays." '(dolist (overlay (overlays-in (point-min) (point-max))) (if (overlay-get overlay 'w3m-momentary-overlay) (delete-overlay overlay)))) (defun w3m-highlight-current-anchor-1 (seq) "Highlight an anchor in the line if the anchor sequence is the same as SEQ. Return t if highlighting is successful." (let ((limit (point-at-eol)) ov beg pos pseq) (save-excursion (beginning-of-line) (setq pos (point)) (while (and pos (< pos limit) (not (eq seq (setq pseq (w3m-anchor-sequence pos))))) (setq pos (next-single-property-change pos 'w3m-anchor-sequence))) (when (and pos (< pos limit) (eq seq pseq)) (setq beg pos) (setq pos (next-single-property-change pos 'w3m-anchor-sequence)) (setq ov (make-overlay beg pos)) (overlay-put ov 'face 'w3m-current-anchor) (overlay-put ov 'w3m-momentary-overlay t) (overlay-put ov 'evaporate t) t)))) (defun w3m-highlight-current-anchor () "Highlight an anchor under point." (when (let ((ovs (overlays-at (point))) ov) ;; If the anchor is already highlighted, it does nothing. (or (null ovs) (null (progn (while ovs (if (overlay-get (car ovs) 'w3m-momentary-overlay) (setq ov (car ovs) ovs nil)) (setq ovs (cdr ovs))) ov)))) (w3m-delete-all-overlays) (save-excursion (let ((seq (w3m-anchor-sequence)) (pos (point))) (when (and seq (w3m-highlight-current-anchor-1 seq) (zerop (forward-line 1))) (while (and (w3m-highlight-current-anchor-1 seq) (zerop (forward-line 1)))) (goto-char pos) (while (and (zerop (forward-line -1)) (w3m-highlight-current-anchor-1 seq)))))))) (defun w3m-edit-url (url) "Edit the source code of URL." (interactive (list (w3m-input-url))) (when (string-match "\\`about://\\(?:header\\|source\\)/" url) (setq url (substring url (match-end 0)))) (catch 'found (dolist (pair w3m-edit-function-alist) (when (and (string-match (car pair) url) (fboundp (cdr pair))) (throw 'found (funcall (cdr pair) url)))) (funcall w3m-edit-function (or (w3m-url-to-file-name url) (call-interactively 'w3m-save-buffer) (error "URL:%s is not a local file" url))))) (defun w3m-edit-current-url () "Edit the source code of the file that the current buffer is viewing." (interactive) (if w3m-current-url (w3m-edit-url w3m-current-url) (w3m-message "No URL"))) (defun w3m-edit-this-url () "Edit the source code of the file linked from the anchor at point." (interactive) (let ((url (w3m-url-valid (w3m-anchor)))) (if url (w3m-edit-url url) (w3m-message "No URL at point")))) (defvar w3m-goto-anchor-hist nil) (make-variable-buffer-local 'w3m-goto-anchor-hist) (defun w3m-goto-next-anchor () (let ((hseq (w3m-anchor-sequence)) (pos (next-single-property-change (point) 'w3m-anchor-sequence))) (if (or (not hseq) (< hseq 1)) (and pos (goto-char pos)) (setq pos ;; hseq is not sequence in form. (catch 'loop (setq hseq (1+ hseq)) (while (<= hseq w3m-max-anchor-sequence) (setq pos (text-property-any (point-min) (point-max) 'w3m-anchor-sequence hseq)) (when pos (throw 'loop pos)) (setq hseq (1+ hseq))))) (and pos (goto-char pos))))) (defun w3m-next-anchor (&optional arg) "Move the point to the next anchor." (interactive "p") (w3m-keep-region-active) (unless arg (setq arg 1)) (if (null (memq last-command '(w3m-next-anchor w3m-previous-anchor))) (when (setq w3m-goto-anchor-hist (w3m-anchor-sequence)) (setq w3m-goto-anchor-hist (list w3m-goto-anchor-hist))) (when (and (eq last-command 'w3m-previous-anchor) w3m-goto-anchor-hist) (setcdr w3m-goto-anchor-hist nil))) (if (< arg 0) (w3m-previous-anchor (- arg)) (let (pos) (while (> arg 0) (unless (w3m-goto-next-anchor) (setq w3m-goto-anchor-hist nil) (if (w3m-imitate-widget-button) (widget-forward 1) (when (setq pos (text-property-any (point-min) (point-max) 'w3m-anchor-sequence 1)) (goto-char pos)))) (setq arg (1- arg)) (if (member (w3m-anchor-sequence) w3m-goto-anchor-hist) (setq arg (1+ arg)) (push (w3m-anchor-sequence) w3m-goto-anchor-hist)))) (w3m-horizontal-on-screen) (w3m-print-this-url))) (defun w3m-goto-previous-anchor () (let ((hseq (w3m-anchor-sequence)) (pos (previous-single-property-change (point) 'w3m-anchor-sequence))) (cond ((and (not hseq) pos) (if (w3m-anchor-sequence pos) (goto-char pos) (setq pos (previous-single-property-change pos 'w3m-anchor-sequence)) (and pos (goto-char pos)))) ((or (not pos) (< hseq 2)) nil) (t (setq pos ;; hseq is not sequence in form. (catch 'loop (setq hseq (1- hseq)) (while (> hseq 0) (setq pos (text-property-any (point-min) (point-max) 'w3m-anchor-sequence hseq)) (when pos (throw 'loop pos)) (setq hseq (1- hseq))))) (and pos (goto-char pos)))))) (defun w3m-previous-anchor (&optional arg) "Move the point to the previous anchor." (interactive "p") (w3m-keep-region-active) (unless arg (setq arg 1)) (if (null (memq last-command '(w3m-next-anchor w3m-previous-anchor))) (when (setq w3m-goto-anchor-hist (w3m-anchor-sequence)) (setq w3m-goto-anchor-hist (list w3m-goto-anchor-hist))) (when (and (eq last-command 'w3m-next-anchor) w3m-goto-anchor-hist) (setcdr w3m-goto-anchor-hist nil))) (if (< arg 0) (w3m-next-anchor (- arg)) (let (pos) (while (> arg 0) (unless (w3m-goto-previous-anchor) (setq w3m-goto-anchor-hist nil) (if (w3m-imitate-widget-button) (widget-forward -1) (when (setq pos (and w3m-max-anchor-sequence (text-property-any (point-min) (point-max) 'w3m-anchor-sequence w3m-max-anchor-sequence))) (goto-char pos)))) (setq arg (1- arg)) (if (member (w3m-anchor-sequence) w3m-goto-anchor-hist) (setq arg (1+ arg)) (push (w3m-anchor-sequence) w3m-goto-anchor-hist)))) (w3m-horizontal-on-screen) (w3m-print-this-url))) (defun w3m-goto-next-form () ;; Move the point to the end of the current form. (when (w3m-action (point)) (goto-char (next-single-property-change (point) 'w3m-action))) ;; Find the next form. (or (w3m-action (point)) (let ((pos (next-single-property-change (point) 'w3m-action))) (when pos (goto-char pos) t)))) (defun w3m-next-form (&optional arg) "Move the point to the next form." (interactive "p") (w3m-keep-region-active) (unless arg (setq arg 1)) (if (null (memq last-command '(w3m-next-form w3m-previous-form))) (when (setq w3m-goto-anchor-hist (w3m-action (point))) (setq w3m-goto-anchor-hist (list w3m-goto-anchor-hist))) (when (and (eq last-command 'w3m-previous-form) w3m-goto-anchor-hist) (setcdr w3m-goto-anchor-hist nil))) (if (< arg 0) (w3m-previous-form (- arg)) (while (> arg 0) (unless (w3m-goto-next-form) ;; Make a search from the beginning of the buffer. (setq w3m-goto-anchor-hist nil) (goto-char (point-min)) (w3m-goto-next-form)) (setq arg (1- arg)) (if (member (w3m-action (point)) w3m-goto-anchor-hist) (setq arg (1+ arg)) (push (w3m-action (point)) w3m-goto-anchor-hist))) (w3m-horizontal-on-screen) (w3m-print-this-url))) (defun w3m-goto-previous-form () ;; Move the point to the beginning of the current form. (when (w3m-action (point)) (goto-char (previous-single-property-change (1+ (point)) 'w3m-action))) ;; Find the previous form. (let ((pos (previous-single-property-change (point) 'w3m-action))) (if pos (goto-char (if (w3m-action pos) pos (previous-single-property-change pos 'w3m-action)))))) (defun w3m-previous-form (&optional arg) "Move the point to the previous form." (interactive "p") (w3m-keep-region-active) (unless arg (setq arg 1)) (if (null (memq last-command '(w3m-next-form w3m-previous-form))) (when (setq w3m-goto-anchor-hist (w3m-action (point))) (setq w3m-goto-anchor-hist (list w3m-goto-anchor-hist))) (when (and (eq last-command 'w3m-next-form) w3m-goto-anchor-hist) (setcdr w3m-goto-anchor-hist nil))) (if (< arg 0) (w3m-next-form (- arg)) (while (> arg 0) (unless (w3m-goto-previous-form) ;; search from the end of the buffer (setq w3m-goto-anchor-hist nil) (goto-char (point-max)) (w3m-goto-previous-form)) (setq arg (1- arg)) (if (member (w3m-action (point)) w3m-goto-anchor-hist) (setq arg (1+ arg)) (push (w3m-action (point)) w3m-goto-anchor-hist))) (w3m-horizontal-on-screen) (w3m-print-this-url))) (defun w3m-goto-next-image () ;; Move the point to the end of the current image. (when (w3m-image (point)) (goto-char (next-single-property-change (point) 'w3m-image))) ;; Find the next form or image. (or (w3m-image (point)) (let ((pos (next-single-property-change (point) 'w3m-image))) (when pos (goto-char pos) t)))) (defun w3m-next-image (&optional arg) "Move the point to the next image." (interactive "p") (w3m-keep-region-active) (unless arg (setq arg 1)) (if (null (memq last-command '(w3m-next-image w3m-previous-image))) (when (setq w3m-goto-anchor-hist (w3m-image (point))) (setq w3m-goto-anchor-hist (list w3m-goto-anchor-hist))) (when (and (eq last-command 'w3m-previous-image) w3m-goto-anchor-hist) (setcdr w3m-goto-anchor-hist nil))) (if (< arg 0) (w3m-previous-image (- arg)) (while (> arg 0) (unless (w3m-goto-next-image) ;; Make a search for an image from the beginning of the buffer. (setq w3m-goto-anchor-hist nil) (goto-char (point-min)) (w3m-goto-next-image)) (setq arg (1- arg)) (if (member (w3m-image (point)) w3m-goto-anchor-hist) (setq arg (1+ arg)) (push (w3m-image (point)) w3m-goto-anchor-hist))) (w3m-horizontal-on-screen) (w3m-print-this-url))) (defun w3m-goto-previous-image () ;; Move the point to the beginning of the current image. (when (w3m-image (point)) (goto-char (previous-single-property-change (1+ (point)) 'w3m-image))) ;; Find the previous form or image. (let ((pos (previous-single-property-change (point) 'w3m-image))) (if pos (goto-char (if (w3m-image pos) pos (previous-single-property-change pos 'w3m-image)))))) (defun w3m-previous-image (&optional arg) "Move the point to the previous image." (interactive "p") (w3m-keep-region-active) (unless arg (setq arg 1)) (if (null (memq last-command '(w3m-next-image w3m-previous-image))) (when (setq w3m-goto-anchor-hist (w3m-image (point))) (setq w3m-goto-anchor-hist (list w3m-goto-anchor-hist))) (when (and (eq last-command 'w3m-next-image) w3m-goto-anchor-hist) (setcdr w3m-goto-anchor-hist nil))) (if (< arg 0) (w3m-next-image (- arg)) (while (> arg 0) (unless (w3m-goto-previous-image) ;; Make a search from the end of the buffer. (setq w3m-goto-anchor-hist nil) (goto-char (point-max)) (w3m-goto-previous-image)) (setq arg (1- arg)) (if (member (w3m-image (point)) w3m-goto-anchor-hist) (setq arg (1+ arg)) (push (w3m-image (point)) w3m-goto-anchor-hist))) (w3m-horizontal-on-screen) (w3m-print-this-url))) (defun w3m-copy-buffer (&optional buffer newname just-copy empty background last) "Create a copy of the BUFFER where emacs-w3m is running. Return a new buffer. If BUFFER is nil, the current buffer is assumed. If NEWNAME is nil, it defaults to the name of the current buffer. If JUST-COPY is nil, this function makes the new buffer the current buffer and pops up as a new window or a new frame according to `w3m-pop-up-windows' and `w3m-pop-up-frames' (which see), otherwise creates just BUFFER's copy. If EMPTY is nil, a page of the same url will be re-rendered in the new buffer, otherwise an empty buffer is created. If BACKGROUND is non-nil, you will not leave the current buffer. If LAST is non-nil, the new buffer will be made the last in order of the w3m buffers, otherwise it will be made the next of the current buffer. Note that this function should be called on the window displaying the original buffer BUFFER even if JUST-COPY is non-nil in order to render a page in a new buffer with the correct width." (interactive (list (current-buffer) (if current-prefix-arg (read-string "Name: ")) t)) (unless buffer (setq buffer (current-buffer))) (unless newname (setq newname (buffer-name buffer))) (when (string-match "<[0-9]+>\\'" newname) (setq newname (substring newname 0 (match-beginning 0)))) (let (url coding images init-frames new) (save-current-buffer (set-buffer buffer) (setq url (or w3m-current-url (car (w3m-history-element (cadar w3m-history)))) coding w3m-current-coding-system images w3m-display-inline-images init-frames (when (w3m-popup-frame-p) (copy-sequence w3m-initial-frames))) (unless url (setq empty t)) ;; (w3m-history-store-position) (set-buffer (setq new (w3m-generate-new-buffer newname (not last)))) (w3m-mode) ;; Make copies of `w3m-history' and `w3m-history-flat'. (w3m-history-copy buffer) (setq w3m-current-coding-system coding w3m-initial-frames init-frames w3m-display-inline-images (if w3m-toggle-inline-images-permanently images w3m-default-display-inline-images))) (cond ((and empty (not background)) ;; Pop to a window or a frame up because `w3m-goto-url' is not called. (w3m-popup-buffer new)) (empty ;; When empty and just-copy, stay origianl buffer. ) (t ;; Need to change to the `new' buffer in which `w3m-goto-url' runs. (set-buffer new) ;; Render a page. (let ((positions (copy-sequence (car w3m-history))) (w3m-history-reuse-history-elements t) (w3m-prefer-cache t)) (w3m-process-with-wait-handler (w3m-goto-url url 'redisplay nil nil nil handler ;; Pass the properties of the history elements, ;; although it is currently always nil. (w3m-history-element (cadr positions)))) (setcar w3m-history positions)) (when (and w3m-new-session-in-background just-copy (not (get-buffer-window buffer))) (set-window-buffer (selected-window) buffer)))) new)) (defun w3m-next-buffer (arg &optional buffer) "Turn ARG pages of emacs-w3m buffers ahead. Switch to BUFFER if it is specified regardless of ARG." (interactive "p") (when (and (eq major-mode 'w3m-mode) (or (and (buffer-live-p buffer) (with-current-buffer buffer (eq major-mode 'w3m-mode))) (progn (unless arg (setq arg 1)) (when (/= arg 0) (let* ((buffers (w3m-list-buffers)) (len (length buffers))) (setq buffer (nth (mod (+ arg (- len (length (memq (current-buffer) buffers)))) len) buffers))))))) (w3m-history-store-position) (switch-to-buffer buffer) (w3m-history-restore-position) (run-hooks 'w3m-select-buffer-hook) (w3m-select-buffer-update))) (defun w3m-previous-buffer (arg) "Turn ARG pages of emacs-w3m buffers behind." (interactive "p") (w3m-next-buffer (- arg))) (defun w3m-delete-buffer (&optional force) "Delete the current emacs-w3m buffer and switch to the previous one. If there is the sole emacs-w3m buffer, it is assumed to be called for terminating the emacs-w3m session; the prefix argument FORCE will be passed to the `w3m-quit' function (which see). When `w3m-use-tab' is non-nil, it returns to the buffer that launches this buffer." (interactive "P") ;; Bind `w3m-fb-mode' to nil so that this function might not call ;; `w3m-quit' when there is only one buffer belonging to the selected ;; frame, but there are emacs-w3m buffers in other frames. (let* ((w3m-fb-mode nil) (buffers (w3m-list-buffers t)) (num (length buffers)) cur buf bufs) (if (= 1 num) (w3m-quit force) (setq cur (current-buffer)) (if (w3m-use-tab-p) (progn (select-window (or (get-buffer-window cur t) (selected-window))) (w3m-next-buffer -1 w3m-parent-session-buffer)) ;; List buffers being shown in the other windows of the current frame. (save-current-buffer (walk-windows (lambda (window) (set-buffer (setq buf (window-buffer window))) (when (and (eq major-mode 'w3m-mode) (not (eq buf cur))) (push buf bufs))) 'no-minibuf)) (cond ((= (1- num) (length bufs)) ;; All the other buffers are shown in the current frame. (select-window (get-buffer-window (prog2 (w3m-next-buffer -1) (current-buffer) (delete-window))))) (bufs ;; Look for the buffer which is not shown in the current frame. (setq buf nil) (while (progn (w3m-next-buffer -1) (unless buf (setq buf (current-buffer))) (memq (current-buffer) bufs))) (when (memq buf bufs) ;; Go to the buffer which is most suitable to be called ;; the *previous* buffer. (select-window (get-buffer-window buf)))) ((progn ;; List buffers being not shown anywhere. (setq bufs nil) (while buffers (unless (get-buffer-window (setq buf (pop buffers)) t) (push buf bufs))) bufs) (while (progn (w3m-next-buffer -1) (not (memq (current-buffer) bufs))))) ((memq (selected-frame) w3m-initial-frames) ;; Assume that this frame was created to show this buffer. (if (one-window-p t) (delete-frame) (delete-window))) (t (if (>= num 2) (w3m-next-buffer -1) (unless (one-window-p t) (delete-window)))))) (w3m-session-deleted-save (list cur)) (w3m-process-stop cur) (w3m-idle-images-show-unqueue cur) (when w3m-use-form (w3m-form-kill-buffer cur)) (let ((frame-auto-delete nil) (ignore-window-parameters t)) (kill-buffer cur)) ;; A workaround to restore the window positions correctly when ;; this command is called by a mouse event. (run-at-time 0.1 nil #'w3m-history-restore-position) (run-hooks 'w3m-delete-buffer-hook) (w3m-session-crash-recovery-save))) (w3m-select-buffer-update) (unless w3m-fb-inhibit-buffer-selection (w3m-fb-select-buffer))) (defun w3m-delete-buffer-if-empty (buffer) "Delete a newly created emacs-w3m buffer BUFFER if it seems unnecessary. Some emacs-w3m commands create a buffer for the new session first, but it may be useless if the command is invoked for visiting a local file or a mail buffer. This command will delete BUFFER if it is empty or there is only a progress message. It also deletes windows and frames related to BUFFER." (with-current-buffer buffer (unless (or w3m-current-process w3m-current-url (not (or (zerop (buffer-size)) (and (get-text-property (point-min) 'w3m-progress-message) (get-text-property (1- (point-max)) 'w3m-progress-message))))) (w3m-delete-buffer t)))) (defun w3m-pack-buffer-numbers () "Renumber suffixes of names of emacs-w3m buffers. It aligns emacs-w3m buffers in order of *w3m*, *w3m<2>, *w3m*<3>,... as if the folder command of MH performs with the -pack option." (interactive) (let ((count 1) number newname) (dolist (buffer (w3m-list-buffers)) (setq number (w3m-buffer-number buffer)) (when number (unless (eq number count) (when (and (setq newname (w3m-buffer-set-number buffer count)) w3m-use-form) (w3m-form-set-number buffer newname))) (incf count))))) (defun w3m-delete-other-buffers (&optional buffer) "Delete emacs-w3m buffers except for BUFFER or the current buffer." (interactive) (unless buffer (setq buffer (current-buffer))) (w3m-delete-frames-and-windows buffer) (let ((buffers (delq buffer (w3m-list-buffers t)))) (w3m-delete-buffers buffers))) (defun w3m-delete-left-tabs () "Delete tabs on the left side of the current tab." (interactive) (let ((cbuf (current-buffer)) bufs) (setq bufs (catch 'done (dolist (buf (w3m-list-buffers)) (if (eq cbuf buf) (throw 'done bufs) (setq bufs (cons buf bufs)))))) (when bufs (w3m-delete-buffers bufs)))) (defun w3m-delete-right-tabs () "Delete tabs on the right side of the current tab." (interactive) (let ((bufs (w3m-righttab-exist-p))) (when bufs (w3m-delete-buffers bufs)))) (defun w3m-delete-buffers (buffers) "Delete emacs-w3m buffers." (let (buffer) (when buffers (w3m-session-deleted-save buffers)) (while buffers (setq buffer (pop buffers)) (w3m-process-stop buffer) (w3m-idle-images-show-unqueue buffer) (kill-buffer buffer) (when w3m-use-form (w3m-form-kill-buffer buffer)))) (run-hooks 'w3m-delete-buffer-hook) (w3m-session-crash-recovery-save) (w3m-select-buffer-update) (w3m-force-window-update)) (defvar w3m-ctl-c-map nil "Sub-keymap used for the `C-c'-prefixed commands. Note: keys should not be alphabet since `C-c LETTER' keys are reserved for users. See Info node `(elisp)Key Binding Conventions'.") (unless w3m-ctl-c-map (let ((map (make-sparse-keymap))) (define-key map "\M-h" 'w3m-history) (define-key map "\C-@" 'w3m-history-store-position) (if (featurep 'xemacs) (define-key map [(control space)] 'w3m-history-store-position) ;; `C- ' doesn't mean `C-SPC' in XEmacs. (define-key map [?\C-\ ] 'w3m-history-store-position)) (define-key map "\C-e" 'w3m-goto-new-session-url) (define-key map "\C-v" 'w3m-history-restore-position) (define-key map "\C-t" 'w3m-copy-buffer) (define-key map "\C-p" 'w3m-previous-buffer) (define-key map "\C-n" 'w3m-next-buffer) (when (featurep 'w3m-ems) (define-key map [?\C-,] 'w3m-tab-move-left) (define-key map [?\C-<] 'w3m-tab-move-left) (define-key map [?\C-.] 'w3m-tab-move-right) (define-key map [?\C->] 'w3m-tab-move-right)) (define-key map "\C-w" 'w3m-delete-buffer) (define-key map "\M-w" 'w3m-delete-other-buffers) (define-key map "\M-l" 'w3m-delete-left-tabs) (define-key map "\M-r" 'w3m-delete-right-tabs) (define-key map "\C-s" 'w3m-select-buffer) (define-key map "\C-a" 'w3m-switch-buffer) (define-key map "\C-b" 'report-emacs-w3m-bug) (define-key map "\C-c" 'w3m-submit-form) (define-key map "\C-k" 'w3m-process-stop) (define-key map "\C-m" 'w3m-move-unseen-buffer) (setq w3m-ctl-c-map map))) (defvar w3m-redisplay-map nil "Sub-keymap used for the `C'-prefixed redisplay commands.") (unless w3m-redisplay-map (let ((map (make-sparse-keymap))) (define-key map "t" 'w3m-redisplay-with-content-type) (define-key map "c" 'w3m-redisplay-with-charset) (define-key map "C" 'w3m-redisplay-and-reset) (setq w3m-redisplay-map map))) (defvar w3m-lnum-map nil "Sub-keymap used for the `L'-prefixed link numbering commands.") (unless w3m-lnum-map (let ((map (make-sparse-keymap))) (define-key map "f" 'w3m-lnum-follow) (define-key map "F" 'w3m-lnum-goto) (define-key map "w" 'w3m-lnum-universal) (define-key map "I" 'w3m-lnum-view-image) (define-key map "\M-i" 'w3m-lnum-save-image) (define-key map "d" 'w3m-lnum-download-this-url) (define-key map "e" 'w3m-lnum-edit-this-url) (define-key map "t" 'w3m-lnum-toggle-inline-image) (define-key map "u" 'w3m-lnum-print-this-url) (define-key map "b" 'w3m-lnum-bookmark-add-this-url) (define-key map "]" 'w3m-lnum-zoom-in-image) (define-key map "[" 'w3m-lnum-zoom-out-image) (setq w3m-lnum-map map))) (defvar w3m-lynx-like-map nil "Lynx-like keymap used in emacs-w3m buffers.") ;; `C-t' is a prefix key reserved to commands that do something in all ;; emacs-w3m buffers. 2006-05-18 (unless w3m-lynx-like-map (let ((map (make-keymap))) (suppress-keymap map) (define-key map " " 'w3m-scroll-up-or-next-url) (define-key map "b" 'w3m-scroll-down-or-previous-url) (define-key map [backspace] 'w3m-scroll-down-or-previous-url) (define-key map [delete] 'w3m-scroll-down-or-previous-url) (if (featurep 'xemacs) (define-key map [(shift space)] 'w3m-scroll-down-or-previous-url) (define-key map [?\S-\ ] 'w3m-scroll-down-or-previous-url)) (define-key map "f" 'w3m-toggle-filtering) (define-key map "h" 'backward-char) (define-key map "j" 'next-line) (define-key map "k" 'previous-line) (define-key map "l" 'forward-char) (define-key map "J" 'w3m-scroll-up) (define-key map "K" 'w3m-scroll-down) (define-key map "\C-?" 'w3m-scroll-down-or-previous-url) (define-key map "\t" 'w3m-next-anchor) (define-key map [tab] 'w3m-next-anchor) (define-key map [(shift tab)] 'w3m-previous-anchor) (define-key map [(shift iso-lefttab)] 'w3m-previous-anchor) (define-key map [backtab] 'w3m-previous-anchor) (define-key map [down] 'w3m-next-anchor) (define-key map "\M-\t" 'w3m-previous-anchor) (define-key map [up] 'w3m-previous-anchor) (define-key map "\C-m" 'w3m-view-this-url) (define-key map [(shift return)] 'w3m-view-this-url-new-session) (define-key map [(shift kp-enter)] 'w3m-view-this-url-new-session) (define-key map [right] 'w3m-view-this-url) (cond ((featurep 'xemacs) (define-key map [(button3)] 'w3m-mouse-major-mode-menu)) ;; Don't use [mouse-3], which gets submenus not working in GTK Emacs. ((featurep 'gtk) (define-key map [down-mouse-3] 'w3m-mouse-major-mode-menu) (define-key map [drag-mouse-3] 'undefined) (define-key map [mouse-3] 'undefined)) (t (define-key map [mouse-3] 'w3m-mouse-major-mode-menu))) (if (featurep 'xemacs) (progn (define-key map [(button2)] 'w3m-mouse-view-this-url) (define-key map [(shift button2)] 'w3m-mouse-view-this-url-new-session)) (define-key map [mouse-2] 'w3m-mouse-view-this-url) ;; Support for mouse-1 on Emacs 22 and greater. (define-key map [follow-link] 'mouse-face) (define-key map [S-mouse-2] 'w3m-mouse-view-this-url-new-session)) (define-key map [left] 'w3m-view-previous-page) (define-key map "B" 'w3m-view-previous-page) (define-key map "N" 'w3m-view-next-page) (define-key map "^" 'w3m-view-parent-page) (define-key map "\M-d" 'w3m-download) (define-key map "d" 'w3m-download-this-url) (define-key map "u" 'w3m-print-this-url) (define-key map "I" 'w3m-view-image) (define-key map "\M-i" 'w3m-save-image) (define-key map "c" 'w3m-print-current-url) (define-key map "M" 'w3m-view-url-with-browse-url) (define-key map "G" 'w3m-goto-url-new-session) (define-key map "g" 'w3m-goto-url) (define-key map "\C-tt" 'w3m-create-empty-session) (define-key map "T" 'w3m-toggle-inline-images) (define-key map "\M-T" 'w3m-turnoff-inline-images) (define-key map "t" 'w3m-toggle-inline-image) (when (w3m-display-graphic-p) (define-key map "\M-[" 'w3m-zoom-out-image) (define-key map "\M-]" 'w3m-zoom-in-image)) (define-key map "U" 'w3m-goto-url) (define-key map "v" 'w3m-bookmark-view) (define-key map "V" 'w3m-bookmark-view-new-session) (define-key map "q" 'w3m-close-window) (define-key map "Q" 'w3m-quit) (define-key map "\M-n" 'w3m-copy-buffer) (define-key map "\M-s" 'w3m-session-select) (define-key map "\M-S" 'w3m-session-save) (define-key map "r" 'w3m-redisplay-this-page) (define-key map "R" 'w3m-reload-this-page) (define-key map "\C-tR" 'w3m-reload-all-pages) (define-key map "?" 'describe-mode) (define-key map "\M-a" 'w3m-bookmark-add-this-url) (define-key map "\M-k" 'w3m-cookie) (define-key map "a" 'w3m-bookmark-add-current-url) (define-key map "\C-ta" 'w3m-bookmark-add-all-urls) (define-key map "+" 'w3m-antenna-add-current-url) (define-key map "]" 'w3m-next-form) (define-key map "[" 'w3m-previous-form) (define-key map "}" 'w3m-next-image) (define-key map "{" 'w3m-previous-image) (define-key map "H" 'w3m-gohome) (define-key map "A" 'w3m-antenna) (define-key map "W" 'w3m-weather) (define-key map "s" 'w3m-search) (define-key map "S" 'w3m-search-new-session) (define-key map "D" 'w3m-dtree) (define-key map ">" 'w3m-scroll-left) (define-key map "<" 'w3m-scroll-right) (define-key map "." 'w3m-shift-left) (define-key map "," 'w3m-shift-right) (define-key map "\M-l" 'w3m-horizontal-recenter) (define-key map "\C-a" 'w3m-beginning-of-line) (define-key map "\C-e" 'w3m-end-of-line) (define-key map "\\" 'w3m-view-source) (define-key map "=" 'w3m-view-header) (define-key map "E" 'w3m-edit-current-url) (define-key map "e" 'w3m-edit-this-url) (define-key map "|" 'w3m-pipe-source) (define-key map "\C-c" w3m-ctl-c-map) (define-key map "C" w3m-redisplay-map) (define-key map "L" w3m-lnum-map) (define-key map "\C-x\C-s" 'w3m-save-buffer) (setq w3m-lynx-like-map map))) (defvar w3m-info-like-map nil "Info-like keymap used in emacs-w3m buffers.") ;; `C-t' is a prefix key reserved to commands that do something in all ;; emacs-w3m buffers. 2006-05-18 (unless w3m-info-like-map (let ((map (make-keymap))) (suppress-keymap map) (define-key map [backspace] 'w3m-scroll-down-or-previous-url) (define-key map [delete] 'w3m-scroll-down-or-previous-url) (define-key map "\C-?" 'w3m-scroll-down-or-previous-url) (if (featurep 'xemacs) (define-key map [(shift space)] 'w3m-scroll-down-or-previous-url) (define-key map [?\S-\ ] 'w3m-scroll-down-or-previous-url)) (define-key map "\t" 'w3m-next-anchor) (define-key map [tab] 'w3m-next-anchor) (define-key map [(shift tab)] 'w3m-previous-anchor) (define-key map [(shift iso-lefttab)] 'w3m-previous-anchor) (define-key map [backtab] 'w3m-previous-anchor) (define-key map "\M-\t" 'w3m-previous-anchor) (define-key map "\C-m" 'w3m-view-this-url) (define-key map [(shift return)] 'w3m-view-this-url-new-session) (define-key map [(shift kp-enter)] 'w3m-view-this-url-new-session) (if (featurep 'xemacs) (progn (define-key map [(button2)] 'w3m-mouse-view-this-url) (define-key map [(shift button2)] 'w3m-mouse-view-this-url-new-session)) (define-key map [mouse-2] 'w3m-mouse-view-this-url) ;; Support for mouse-1 on Emacs 22 and greater. (define-key map [follow-link] 'mouse-face) (define-key map [S-mouse-2] 'w3m-mouse-view-this-url-new-session)) (cond ((featurep 'xemacs) (define-key map [(button3)] 'w3m-mouse-major-mode-menu)) ;; Don't use [mouse-3], which gets submenus not working in GTK Emacs. ((featurep 'gtk) (define-key map [down-mouse-3] 'w3m-mouse-major-mode-menu) (define-key map [drag-mouse-3] 'undefined) (define-key map [mouse-3] 'undefined)) (t (define-key map [mouse-3] 'w3m-mouse-major-mode-menu))) (define-key map " " 'w3m-scroll-up-or-next-url) (define-key map "a" 'w3m-bookmark-add-current-url) (define-key map "\C-ta" 'w3m-bookmark-add-all-urls) (define-key map "\M-a" 'w3m-bookmark-add-this-url) (define-key map "+" 'w3m-antenna-add-current-url) (define-key map "A" 'w3m-antenna) (define-key map "b" 'w3m-scroll-down-or-previous-url) (define-key map "!" 'w3m-redisplay-with-content-type) (define-key map "d" 'w3m-download) (define-key map "D" 'w3m-download-this-url) (define-key map "e" 'w3m-edit-current-url) (define-key map "E" 'w3m-edit-this-url) (define-key map "f" 'w3m-toggle-filtering) (define-key map "g" 'w3m-goto-url) (define-key map "G" 'w3m-goto-url-new-session) (define-key map "\C-tt" 'w3m-create-empty-session) (define-key map "h" 'describe-mode) (define-key map "H" 'w3m-gohome) (define-key map "i" (if (w3m-display-graphic-p) 'w3m-toggle-inline-image 'w3m-view-image)) (define-key map "I" 'w3m-toggle-inline-images) (define-key map "\M-I" 'w3m-turnoff-inline-images) (when (w3m-display-graphic-p) (define-key map "\M-[" 'w3m-zoom-out-image) (define-key map "\M-]" 'w3m-zoom-in-image)) (define-key map "\M-i" 'w3m-save-image) (define-key map "l" 'w3m-view-previous-page) (define-key map "\C-l" 'recenter) (define-key map [(control L)] 'w3m-reload-this-page) (define-key map [(control t) (control L)] 'w3m-reload-all-pages) (define-key map "M" 'w3m-view-url-with-browse-url) (define-key map "n" 'w3m-view-next-page) (define-key map "N" 'w3m-namazu) (define-key map "\M-n" 'w3m-copy-buffer) (define-key map "\M-k" 'w3m-cookie) (define-key map "\M-s" 'w3m-session-select) (define-key map "\M-S" 'w3m-session-save) (define-key map "o" 'w3m-history) (define-key map "O" 'w3m-db-history) (define-key map "p" 'w3m-view-previous-page) (define-key map "P" 'undecided) ;; reserved for print-this-buffer. (define-key map "q" 'w3m-close-window) (define-key map "Q" 'w3m-quit) (define-key map "r" 'w3m-redisplay-this-page) (define-key map "R" 'w3m-reload-this-page) (define-key map "\C-tR" 'w3m-reload-all-pages) (define-key map "s" 'w3m-search) (define-key map "S" 'w3m-search-new-session) (define-key map "T" 'w3m-dtree) (define-key map "u" 'w3m-view-parent-page) (define-key map "v" 'w3m-bookmark-view) (define-key map "V" 'w3m-bookmark-view-new-session) (define-key map "W" 'w3m-weather) (define-key map "y" 'w3m-print-current-url) (define-key map "Y" 'w3m-print-this-url) (define-key map "=" 'w3m-view-header) (define-key map "\\" 'w3m-view-source) (define-key map "?" 'describe-mode) (define-key map ">" 'w3m-scroll-left) (define-key map "<" 'w3m-scroll-right) (define-key map [(shift right)] 'w3m-shift-left) (define-key map [(shift left)] 'w3m-shift-right) (define-key map "\M-l" 'w3m-horizontal-recenter) (define-key map "\C-a" 'w3m-beginning-of-line) (define-key map "\C-e" 'w3m-end-of-line) (define-key map "." 'beginning-of-buffer) (define-key map "^" 'w3m-view-parent-page) (define-key map "]" 'w3m-next-form) (define-key map "[" 'w3m-previous-form) (define-key map "}" 'w3m-next-image) (define-key map "{" 'w3m-previous-image) (define-key map "|" 'w3m-pipe-source) (define-key map "\C-c" w3m-ctl-c-map) (define-key map "C" w3m-redisplay-map) (define-key map "L" w3m-lnum-map) (define-key map "\C-x\C-s" 'w3m-save-buffer) (setq w3m-info-like-map map))) (defun w3m-alive-p (&optional visible) "Return a buffer in which emacs-w3m is running. If there is no emacs-w3m session, return nil. If the optional VISIBLE is non-nil, a visible emacs-w3m buffer is preferred. The last visited emacs-w3m buffer is likely to return if VISIBLE is omitted or there is no visible buffer." (let* ((buffers (w3m-list-buffers t)) (buf (car buffers))) (if visible (progn (setq visible nil) (while (and (not visible) buffers) (when (get-buffer-window (car buffers) t) (setq visible (car buffers))) (setq buffers (cdr buffers))) (or visible buf)) buf))) (defun w3m-quit (&optional force) "Return to a peaceful life (exiting all emacs-w3m sessions). This command lets you quit browsing web after updating the arrived URLs database. Quit browsing immediately if the prefix argument FORCE is specified, otherwise prompt you for the confirmation. See also `w3m-close-window'." (interactive "P") (let ((buffers (w3m-list-buffers t)) (all-buffers (let ((w3m-fb-mode nil)) (w3m-list-buffers t)))) (if (or (= (length buffers) (length all-buffers)) (prog1 (y-or-n-p "Kill emacs-w3m buffers on other frames? ") (message nil))) (let ((w3m-fb-mode nil)) (when (or force (prog1 (y-or-n-p "Do you want to exit emacs-w3m? ") (message nil))) (w3m-session-automatic-save) (w3m-delete-frames-and-windows) (sit-for 0) ;; Delete frames seemingly fast. (dolist (buffer all-buffers) (w3m-cancel-refresh-timer buffer) (kill-buffer buffer) (when w3m-use-form (w3m-form-kill-buffer buffer))) (when w3m-use-form (w3m-form-textarea-file-cleanup)) (w3m-select-buffer-close-window) (w3m-cache-shutdown) (w3m-arrived-shutdown) (w3m-process-shutdown) (when w3m-use-cookies (w3m-cookie-shutdown)) (w3m-kill-all-buffer))) (w3m-session-automatic-save) (w3m-fb-delete-frame-buffers) (w3m-fb-select-buffer)))) (defun w3m-close-window () "Return to a restless life (quitting all emacs-w3m sessions). This command closes all emacs-w3m windows, but all the emacs-w3m buffers remain. Frames created for emacs-w3m sessions will also be closed. See also `w3m-quit'." (interactive) (w3m-history-store-position) ;; `w3m-list-buffers' won't return all the emacs-w3m buffers if ;; `w3m-fb-mode' is turned on. (let* ((buffers (w3m-list-buffers t)) (bufs buffers) buf windows window) (w3m-delete-frames-and-windows) (while bufs (setq buf (pop bufs)) (w3m-cancel-refresh-timer buf) (bury-buffer buf)) (while buffers (setq buf (pop buffers) windows (get-buffer-window-list buf 'no-minibuf t)) (while windows (setq window (pop windows)) (set-window-buffer window (w3m-static-if (featurep 'xemacs) (other-buffer buf (window-frame window) nil) (other-buffer buf nil (window-frame window))))))) (w3m-select-buffer-close-window) ;; The current-buffer and displayed buffer are not necessarily the ;; same at this point; if they aren't bury-buffer will be a nop, and ;; we will infloop. (set-buffer (window-buffer (selected-window))) (while (eq major-mode 'w3m-mode) (bury-buffer))) (unless w3m-mode-map (setq w3m-mode-map (if (eq w3m-key-binding 'info) w3m-info-like-map w3m-lynx-like-map))) (defun w3m-mouse-major-mode-menu (event) "Pop up a W3M mode-specific menu of mouse commands." (interactive "e") (mouse-set-point event) (let* ((bmkitems (if w3m-bookmark-mode (cdr w3m-bookmark-menu-items) (car w3m-bookmark-menu-items))) (bmkmenu (if w3m-bookmark-menu-items-pre `(,@bmkitems "----" ,@w3m-bookmark-menu-items-pre) bmkitems))) (w3m-static-if (featurep 'xemacs) (let (menubar) (when current-menubar (run-hooks 'activate-menubar-hook)) (setq menubar (cons "w3m" (delq nil `(,@(cdr w3m-rmouse-menubar) "----" "----" ,(assoc "w3m" current-menubar) "----" ,(assoc "Bookmark" current-menubar) ,(assoc "Tab" current-menubar) ,(assoc "Session" current-menubar))))) (popup-menu menubar event)) (run-hooks 'menu-bar-update-hook) (popup-menu (delete nil `(,@w3m-rmouse-menubar "----" "----" ,w3m-menubar "----" ,(cons "Bookmark" bmkmenu) ,(when w3m-tab-menubar-make-items-preitems (cons "Tab" w3m-tab-menubar-make-items-preitems)) ,(cons "Session" (if w3m-session-menu-items-pre (append w3m-session-menu-items '("----") w3m-session-menu-items-pre) w3m-session-menu-items)))) event)))) (defvar w3m-tab-button-menu-current-buffer nil "Internal variable used by `w3m-tab-button-menu'.") (defvar w3m-tab-button-menu-commands (let ((manyp '(cdr (w3m-list-buffers))) (currentp 'w3m-tab-button-menu-current-buffer) (leftp '(and w3m-tab-button-menu-current-buffer (w3m-lefttab-exist-p w3m-tab-button-menu-current-buffer))) (rightp '(and w3m-tab-button-menu-current-buffer (w3m-righttab-exist-p w3m-tab-button-menu-current-buffer))) (many2p '(and w3m-tab-button-menu-current-buffer (cdr (w3m-list-buffers))))) `((w3m-goto-url-new-session ,(w3m-make-menu-item "$B?7$7$$%?%V(B" "New Tab") t ,w3m-new-session-in-background w3m-new-session-url) (w3m-copy-buffer ,(w3m-make-menu-item "$B%?%V$rJ#@=(B" "Copy Tab") ,currentp ,w3m-new-session-in-background) - (w3m-reload-this-page ,(w3m-make-menu-item "$B%?%V$r:FFI$_9~$_(B" "Reload Tab") ,currentp) (w3m-reload-all-pages ,(w3m-make-menu-item "$B$9$Y$F$N%?%V$r:FFI$_9~$_(B" "Reload All Tabs") ,manyp) - (w3m-delete-buffer ,(w3m-make-menu-item "$B$3$N%?%V$rJD$8$k(B" "Close This Tab") ,currentp) - (w3m-delete-other-buffers ,(w3m-make-menu-item "$BB>$N%?%V$r$9$Y$FJD$8$k(B" "Close Other Tabs") ,many2p) (w3m-delete-left-tabs ,(w3m-make-menu-item "$B:8B&$N%?%V$r$9$Y$FJD$8$k(B" "Close Left Tabs") ,leftp) (w3m-delete-right-tabs ,(w3m-make-menu-item "$B1&B&$N%?%V$r$9$Y$FJD$8$k(B" "Close Right Tabs") ,rightp) - (w3m-view-url-with-browse-url ,(w3m-make-menu-item "browse-url $B$G3+$/(B" "View with browse-url") ,currentp ,w3m-new-session-in-background w3m-current-url) - (w3m-session-save ,(w3m-make-menu-item "$B$9$Y$F$N%?%V$rJ]B8$9$k(B" "Save All Tabs...") t) (w3m-session-select ,(w3m-make-menu-item "$B%?%V%j%9%H$rA*Br$9$k(B" "Select List of Tabs...") t) (w3m-bookmark-add-current-url ,(w3m-make-menu-item "$B$3$N%?%V$r%V%C%/%^!<%/(B" "Bookmark This Tab...") ,currentp ,w3m-new-session-in-background) (w3m-bookmark-add-all-urls ,(w3m-make-menu-item "$B$9$Y$F$N%?%V$r%V%C%/%^!<%/(B" "Bookmark All Tabs..." ) ,manyp))) "List of commands invoked by the tab button menu. Each item is the symbol `-' which is a separator, or a list which consists of the following elements: 0: a function. 1: a function description. 2: a Lisp form which returns non-nil if the item is active. 3: a flag specifying whether the buffer should be selected. &rest: arguments passed to the function.") (w3m-static-unless (featurep 'xemacs) (easy-menu-define w3m-tab-button-menu w3m-tab-map "w3m tab button menu." (cons nil (w3m-make-menu-commands w3m-tab-button-menu-commands))) ;; This function must be placed after `easy-menu-define'. (defun w3m-tab-button-menu (event buffer) (select-window (posn-window (event-start event))) (setq w3m-tab-button-menu-current-buffer buffer) (popup-menu w3m-tab-button-menu)) (defun w3m-tab-button-menu2 (event buffer) (select-window (posn-window (event-start event))) (setq w3m-tab-button-menu-current-buffer nil) (popup-menu w3m-tab-button-menu))) (unless w3m-link-map (setq w3m-link-map (make-sparse-keymap)) (cond ((featurep 'xemacs) (define-key w3m-link-map [(button3)] 'w3m-link-menu)) ;; Don't use [mouse-3], which gets submenus not working in GTK Emacs. ((featurep 'gtk) (define-key w3m-link-map [down-mouse-3] 'w3m-link-menu) (define-key w3m-link-map [drag-mouse-3] 'undefined) (define-key w3m-link-map [mouse-3] 'undefined)) (t (define-key w3m-link-map [mouse-3] 'w3m-link-menu)))) (easy-menu-define w3m-link-menu w3m-link-map "w3m link menu." `("Link" ;; This cannot be omitted for at least MacOS. [,(w3m-make-menu-item "$B%j%s%/$r$3$N%;%C%7%g%s$G3+$/(B" "Open Link in This Session") w3m-view-this-url (w3m-anchor (point))] [,(w3m-make-menu-item "$B%j%s%/$r?7$7$$%;%C%7%g%s$G3+$/(B" "Open Link in New Session") w3m-view-this-url-new-session (w3m-anchor (point))] [,(w3m-make-menu-item "$B%j%s%/$r(B browse-url $B$G3+$/(B" "Open Link using browse-url") w3m-view-url-with-browse-url (w3m-anchor (point))] "-" [,(w3m-make-menu-item "$B$3$N%j%s%/$r%V%C%/%^!<%/(B..." "Bookmark This Link...") w3m-bookmark-add-this-url (w3m-anchor (point))] [,(w3m-make-menu-item "$BL>A0$rIU$1$F%j%s%/@h$rJ]B8(B..." "Save Link As...") w3m-download-this-url (w3m-anchor (point))] [,(w3m-make-menu-item "$BL>A0$rIU$1$F2hA|$rJ]B8(B..." "Save Image As...") w3m-download-this-image (w3m-image (point))] [,(w3m-make-menu-item "$B%j%s%/$N(B URL $B$r%3%T!<(B" "Copy Link Location") w3m-print-this-url (w3m-anchor (point))] [,(w3m-make-menu-item "$B2hA|$N(B URL $B$r%3%T!<(B" "Copy Image Location") w3m-print-this-image-url (w3m-image (point))])) (defun w3m-link-menu (event) "Pop up a link menu." (interactive "e") (mouse-set-point event) (popup-menu w3m-link-menu)) (defvar w3m-buffer-unseen nil) (make-variable-buffer-local 'w3m-buffer-unseen) (defun w3m-set-buffer-unseen (&optional url) (setq w3m-buffer-unseen t) (w3m-make-local-hook 'pre-command-hook) (add-hook 'pre-command-hook 'w3m-set-buffer-seen nil t)) (defun w3m-set-buffer-seen () (setq w3m-buffer-unseen nil) (remove-hook 'pre-command-hook 'w3m-set-buffer-seen t)) (defun w3m-move-unseen-buffer () "Move to the next unseen buffer." (interactive) (when (eq major-mode 'w3m-mode) (let* ((bufs (w3m-list-buffers)) (right (memq (current-buffer) bufs)) unseen) (setq unseen (catch 'unseen (dolist (buf (append right bufs)) (when (w3m-unseen-buffer-p buf) (throw 'unseen buf))))) (if (not unseen) (message "No unseen buffer.") (switch-to-buffer unseen) (run-hooks 'w3m-select-buffer-hook) (w3m-select-buffer-update))))) (defun w3m-mode () "Major mode for browsing web. \\\ \\[w3m-view-this-url] Display the page pointed to by the link under point. You may use the prefix arg `2' or\ `\\[universal-argument] \\\ \\[universal-argument-more]\\' to make a new session. \\[w3m-mouse-view-this-url] Follow the link under the mouse pointer. If w3m-use-form is t, `\\[w3m-view-this-url]' and\ `\\[w3m-mouse-view-this-url]' enable you to enter forms. You may use the prefix arg `2' or\ `\\[universal-argument] \\\ \\[universal-argument-more]\\' to make a new session. \\[w3m-view-this-url-new-session] Display the page of the link\ in a new session. If the region is active, visit all the links within the region. \\[w3m-mouse-view-this-url-new-session] Display the page of the link\ in a new session by mouse. \\[w3m-submit-form] Submit the form at point. \\[w3m-reload-this-page] Reload the current page. \\[w3m-reload-all-pages] Reload all the pages. \\[w3m-redisplay-this-page] Redisplay the current page. \\[w3m-redisplay-with-content-type] Redisplay the page, specifying\ a content type. \\[w3m-redisplay-with-charset] Redisplay the current page, specifying\ a charset. \\[w3m-redisplay-and-reset] Redisplay the current page and reset\ the user-specified charset and\n\tcontent type. \\[w3m-next-anchor] Move the point to the next anchor. \\[w3m-previous-anchor] Move the point to the previous anchor. \\[w3m-next-form] Move the point to the next form. \\[w3m-previous-form] Move the point to the previous form. \\[w3m-next-image] Move the point to the next image. \\[w3m-previous-image] Move the point to the previous image. \\[w3m-view-previous-page] Move back to the previous page in the history. \\[w3m-view-next-page] Move forward to the next page in the history. \\[w3m-view-parent-page] Attempt to move to the parent directory of\ the page. \\[w3m-goto-url] Visit the web page. \\[w3m-goto-url-new-session] Visit the web page in a new session. \\[w3m-goto-new-session-url] Open page of which url is specified by\ `w3m-new-session-url' in\n\ta new session. \\[w3m-gohome] Go to the Home page. \\[w3m-view-url-with-browse-url] Open a link using `browse-url'. \\[w3m-delete-left-tabs] Delete tabs on the left side of\ the current tab. \\[w3m-delete-right-tabs] Delete tabs on the right side of\ the current tab. \\[w3m-tab-move-left] Move this tab N (default 1) times to the left. \\[w3m-tab-move-right] Move this tab N (default 1) times to the right. \\[w3m-download] Download the URL. \\[w3m-download-this-url] Download the URL under point. \\[w3m-view-image] Display the image under point in the external viewer. \\[w3m-save-image] Save the image under point to a file. \\[w3m-toggle-inline-image] Toggle the visibility of an image under point. \\[w3m-toggle-inline-images] Toggle the visibility of all images. \\[w3m-turnoff-inline-images] Turn off to display all images. \\[w3m-zoom-out-image] Zoom in an image on the point. \\[w3m-zoom-in-image] Zoom out an image on the point. \\[w3m-print-this-url] Display the url under point and put it into\ `kill-ring'. \\[w3m-print-current-url] Display the url of the current page and put\ it into `kill-ring'. \\[w3m-view-source] Display the html source of the current page. \\[w3m-view-header] Display the header of the current page. \\[w3m-edit-current-url] Edit the local file displayed as the current\ page. \\[w3m-edit-this-url] Edit the local file which is pointed to by URL under\ point. \\[w3m-cookie] Display cookies and enable you to manage them. \\[w3m-scroll-up-or-next-url] Scroll up the current window, or go to the\ next page. \\[w3m-scroll-down-or-previous-url] Scroll down the current window, or\ go to the previous page. \\[w3m-scroll-up] Scroll the current window up one line (or lines\ of which the number\n\tyou specify by the prefix argument). \\[w3m-scroll-left] Scroll to the left. \\[w3m-scroll-right] Scroll to the right. \\[w3m-shift-left] Shift to the left. \\[w3m-shift-right] Shift to the right. \\[w3m-horizontal-recenter] Recenter horizontally. \\[w3m-beginning-of-line] Go to the entire beginning of line, may be\ accompanied by scrolling. \\[w3m-end-of-line] Go to the entire end of line, may be accompanied\ by scrolling. \\[next-line] Next line. \\[previous-line] Previous line. \\[forward-char] Forward char. \\[backward-char] Backward char. \\[goto-line] Go to the line, specifying the line number (beginning with 1). \\[w3m-history-store-position] Mark the current position. \\[w3m-history-restore-position] Go to the last marked position. \\[w3m-history] Display the history of pages you have visited in the\ session. If it is called with the prefix arg, it displays the arrived URLs. \\[w3m-antenna] Display the report of changes in web pages. If it is called with the prefix arg, it updates the report. \\[w3m-antenna-add-current-url] Add the current url to the antenna database. \\[w3m-search] Query to the search engine a word. To change the server, give any prefix argument to the command. \\[w3m-search-new-session] Query to the search engine a word in a new session. To change the server, give any prefix argument to the command. \\[w3m-weather] Display a weather report. To change the local area, give any prefix argument to the command. \\[w3m-dtree] Display a directory tree. If the prefix arg is given, display files in addition to directories. \\[w3m-namazu] Search files with Namazu. To change the index, give any prefix argument to the command. \\[w3m-pipe-source] Pipe a page source to a shell command. \\[w3m-bookmark-view] Display the bookmark. \\[w3m-bookmark-view-new-session] Display the bookmark on a new session. \\[w3m-bookmark-add-current-url] Add a url of the current page to\ the bookmark. If the prefix arg is given, the user will be prompted for the url. \\[w3m-bookmark-add-all-urls] Add urls of all pages being visited to\ the bookmark. \\[w3m-bookmark-add-this-url] Add the url under point to the bookmark. \\[w3m-create-empty-session] Create an empty page as a new session and\ visit it. \\[w3m-copy-buffer] Create a copy of the current page as a new session. \\[w3m-next-buffer] Turn the page of emacs-w3m buffers ahead. \\[w3m-previous-buffer] Turn the page of emacs-w3m buffers behind. \\[w3m-move-unseen-buffer] Move to the next unseen buffer. \\[w3m-select-buffer] Pop to the emacs-w3m buffers selection window up. \\[w3m-switch-buffer] Select one of emacs-w3m buffers at the current window. \\[w3m-delete-buffer] Delete the current emacs-w3m buffer. \\[w3m-delete-other-buffers] Delete emacs-w3m buffers except for the\ current buffer. \\[w3m] Start browsing web with emacs-w3m. \\[w3m-close-window] Close all emacs-w3m windows, without deleteing\ buffers. \\[w3m-quit] Exit browsing web. All emacs-w3m buffers will be deleted. \\[w3m-process-stop] Try to stop internal processes of a page. \\[describe-mode] describe-mode. \\[w3m-mouse-major-mode-menu] Pop up a w3m-mode specific menu of mouse\ commands. \\[report-emacs-w3m-bug] Send a bug report to the emacs-w3m team. " (kill-all-local-variables) (buffer-disable-undo) (setq major-mode 'w3m-mode) (setq mode-name "w3m") (use-local-map w3m-mode-map) ;; Force paragraph direction to be left-to-right. Don't make it ;; bound globally in old Emacsen and XEmacsen. (set (make-local-variable 'bidi-paragraph-direction) 'left-to-right) (setq truncate-lines t w3m-display-inline-images w3m-default-display-inline-images) (when w3m-auto-show (when (boundp 'auto-hscroll-mode) (set (make-local-variable 'auto-hscroll-mode) nil)) (when (boundp 'automatic-hscrolling) (set (make-local-variable 'automatic-hscrolling) nil)) (when (boundp 'auto-show-mode) (set (make-local-variable 'auto-show-mode) nil)) (when (boundp 'hscroll-mode) (set (make-local-variable 'hscroll-mode) nil))) (make-local-variable 'list-buffers-directory) (w3m-static-unless (featurep 'xemacs) (setq show-trailing-whitespace nil)) (when (boundp 'mwheel-scroll-up-function) (eval '(set (make-local-variable (quote mwheel-scroll-up-function)) (function w3m-scroll-up))) (eval '(set (make-local-variable (quote mwheel-scroll-down-function)) (function w3m-scroll-down)))) (w3m-setup-toolbar) (w3m-setup-menu) (run-hooks 'w3m-mode-setup-functions) (w3m-run-mode-hooks 'w3m-mode-hook)) (condition-case nil (define-obsolete-function-alias 'w3m-scroll-up-1 'w3m-scroll-up "2013-01-23") (wrong-number-of-arguments ;; XEmacs (define-obsolete-function-alias 'w3m-scroll-up-1 'w3m-scroll-up))) (defun w3m-scroll-up (&optional arg interactive-p) "Scroll the current window up ARG lines. When called interactively, ARG defaults to 1." (interactive (list current-prefix-arg t)) (scroll-up (or arg (and interactive-p 1)))) (defun w3m-scroll-up-or-next-url (arg) "Scroll the current window up ARG lines, or go to the next page." (interactive "P") (if (w3m-image-page-displayed-p) (image-scroll-up arg) (w3m-keep-region-active) (if (and w3m-next-url (pos-visible-in-window-p (let ((cur (point))) (goto-char (point-max)) (skip-chars-backward "\t\n\r ") (forward-line 1) (prog1 (point) (goto-char cur))))) (let ((w3m-prefer-cache t)) (w3m-history-store-position) (w3m-goto-url w3m-next-url)) (w3m-scroll-up arg)))) (defun w3m-scroll-down (&optional arg interactive-p) "Scroll the current window down ARG lines. When called interactively, ARG defaults to 1." (interactive (list current-prefix-arg t)) (scroll-down (or arg (and interactive-p 1)))) (defun w3m-scroll-down-or-previous-url (arg) "Scroll the current window down ARG lines, or go to the previous page." (interactive "P") (if (w3m-image-page-displayed-p) (image-scroll-down arg) (w3m-keep-region-active) (if (and w3m-previous-url (pos-visible-in-window-p (point-min))) (let ((w3m-prefer-cache t)) (w3m-history-store-position) (w3m-goto-url w3m-previous-url)) (w3m-scroll-down arg)))) (defvar w3m-current-longest-line nil "The length of the longest line in the window.") (defun w3m-set-current-longest-line () "Set the value of `w3m-current-longest-line'." (save-excursion (goto-char (window-start)) (end-of-line) (setq w3m-current-longest-line 0) ;; The XEmacs version of `window-end' returns the point beyond ;; `point-max' if it is visible in the window. (let ((end (min (window-end) (point-max)))) (while (progn (skip-chars-backward " ") (setq w3m-current-longest-line (max w3m-current-longest-line (current-column))) (end-of-line 2) (< (point) end)))))) (defun w3m-scroll-left (arg) "Scroll to the left. If ARG (the prefix) is a number, scroll the window ARG columns. Otherwise, it defaults to `w3m-horizontal-scroll-columns'." (interactive "P") (setq arg (if arg (prefix-numeric-value arg) w3m-horizontal-scroll-columns)) (if (w3m-image-page-displayed-p) (image-forward-hscroll arg) (when (if (memq last-command '(w3m-scroll-left w3m-shift-left)) (or (< (window-hscroll) w3m-current-longest-line) (progn (ding) nil)) (w3m-set-current-longest-line) (< (window-hscroll) w3m-current-longest-line)) (w3m-horizontal-scroll 'left arg)))) (defun w3m-scroll-right (arg) "Scroll to the right. If ARG (the prefix) is a number, scroll the window ARG columns. Otherwise, it defaults to `w3m-horizontal-scroll-columns'." (interactive "P") (setq arg (if arg (prefix-numeric-value arg) w3m-horizontal-scroll-columns)) (if (w3m-image-page-displayed-p) (image-backward-hscroll arg) (if (zerop (window-hscroll)) (when (memq last-command '(w3m-scroll-right w3m-shift-right)) (ding)) (w3m-horizontal-scroll 'right arg)))) (defun w3m-shift-left (arg) "Shift to the left. Shift means a fine level horizontal scrolling. If ARG (the prefix) is a number, scroll the window ARG columns. Otherwise, it defaults to `w3m-horizontal-shift-columns'." (interactive "P") (setq arg (if arg (prefix-numeric-value arg) w3m-horizontal-shift-columns)) (if (w3m-image-page-displayed-p) (image-forward-hscroll arg) (when (if (memq last-command '(w3m-scroll-left w3m-shift-left)) (or (< (window-hscroll) w3m-current-longest-line) (progn (ding) nil)) (w3m-set-current-longest-line) (< (window-hscroll) w3m-current-longest-line)) (w3m-horizontal-scroll 'left arg)))) (defun w3m-shift-right (arg) "Shift to the right. Shift means a fine level horizontal scrolling. If ARG (the prefix) is a number, scroll the window ARG columns. Otherwise, it defaults to `w3m-horizontal-shift-columns'." (interactive "P") (setq arg (if arg (prefix-numeric-value arg) w3m-horizontal-shift-columns)) (if (w3m-image-page-displayed-p) (image-backward-hscroll arg) (if (zerop (window-hscroll)) (when (memq last-command '(w3m-scroll-right w3m-shift-right)) (ding)) (w3m-horizontal-scroll 'right arg)))) (defvar w3m-horizontal-scroll-done nil) (make-variable-buffer-local 'w3m-horizontal-scroll-done) (defvar w3m-current-position '(-1 0 0)) (make-variable-buffer-local 'w3m-current-position) (defun w3m-auto-show () "Scroll horizontally so that the point is visible." (when (and truncate-lines w3m-auto-show (not w3m-horizontal-scroll-done) (not (and (eq last-command this-command) (or (eq (point) (point-min)) (eq (point) (point-max))))) (or (memq this-command '(beginning-of-buffer end-of-buffer)) (and (symbolp this-command) (string-match "\\`i?search-" (symbol-name this-command))) (and (markerp (nth 1 w3m-current-position)) (markerp (nth 2 w3m-current-position)) (>= (point) (marker-position (nth 1 w3m-current-position))) (<= (point) (marker-position (nth 2 w3m-current-position)))))) (w3m-horizontal-on-screen)) (setq w3m-horizontal-scroll-done nil)) ;; Ailiases to meet XEmacs bugs? (eval-and-compile (unless (fboundp 'w3m-window-hscroll) (defalias 'w3m-window-hscroll 'window-hscroll)) (unless (fboundp 'w3m-current-column) (defalias 'w3m-current-column 'current-column)) (unless (fboundp 'w3m-set-window-hscroll) (defalias 'w3m-set-window-hscroll 'set-window-hscroll))) (defun w3m-horizontal-scroll (direction ncol) "Scroll the window NCOL columns horizontally to DIRECTION. DIRECTON should be the symbol `left' which specifies to scroll to the left, or any other Lisp object meaning to scroll to the right. NCOL should be a number. This function is a subroutine called by the commands `w3m-scroll-left', `w3m-scroll-right', `w3m-shift-left' and `w3m-shift-right'." (setq w3m-horizontal-scroll-done t) (let ((inhibit-point-motion-hooks t)) (w3m-set-window-hscroll (selected-window) (max 0 (+ (w3m-window-hscroll) (if (eq direction 'left) ncol (- ncol))))) (let ((hs (w3m-window-hscroll))) (unless (and (>= (- (current-column) hs) 0) (< (- (current-column) hs) (window-width))) (move-to-column (if (eq direction 'left) hs (+ hs (window-width) (w3m-static-if (featurep 'xemacs) -3 -2)))))))) (defun w3m-horizontal-on-screen () "Scroll the window horizontally so that the current position is visible. See the documentation for the `w3m-horizontal-scroll-division' variable for details." (when w3m-auto-show (setq w3m-horizontal-scroll-done t) (let ((cc (w3m-current-column)) (hs (w3m-window-hscroll)) (ww (window-width)) (inhibit-point-motion-hooks t)) (unless (and (>= (- cc hs) 0) (< (+ (- cc hs) (if (eolp) 0 (w3m-static-if (featurep 'xemacs) 3 2))) ;; '$$' ww)) (w3m-set-window-hscroll (selected-window) (max 0 (- cc (if (> hs cc) (/ ww w3m-horizontal-scroll-division) (* (/ ww w3m-horizontal-scroll-division) (1- w3m-horizontal-scroll-division)))))))))) (defun w3m-horizontal-recenter (&optional arg) "Recenter horizontally. With ARG, put the point on the column ARG. If `truncate-lines' is nil, it does nothing besides resetting the window's hscroll." (interactive "P") (if truncate-lines (progn (cond ((< (w3m-current-column) (window-hscroll)) (move-to-column (w3m-window-hscroll)) (setq arg 0)) ((>= (w3m-current-column) (+ (window-hscroll) (window-width))) (move-to-column (+ (w3m-window-hscroll) (window-width) -2)) (setq arg -1)) ((listp arg) (setq arg (car arg)))) (w3m-set-window-hscroll (selected-window) (if (numberp arg) (if (>= arg 0) (max (- (current-column) arg) 0) (let* ((home (point)) (inhibit-point-motion-hooks t) (maxcolumn (prog2 (end-of-line) (1- (current-column)) (goto-char home)))) (max (min (- (current-column) (window-width) arg -2) maxcolumn) 0))) (max (- (current-column) (/ (window-width) 2) -1) 0)))) (set-window-hscroll (selected-window) 0))) (defun w3m-recenter () "Recenter according to `w3m-view-recenter'." (when (and w3m-view-recenter (eq (window-buffer) (current-buffer))) (recenter (if (eq t w3m-view-recenter) '(4) ;; per "C-u C-l" to recenter in middle w3m-view-recenter)))) ;; otherwise an integer (defun w3m-beginning-of-line (&optional arg) "Make the beginning of the line visible and move the point to there." (interactive "P") (if (w3m-image-page-displayed-p) (image-bol (or arg 1)) (w3m-keep-region-active) (when (listp arg) (setq arg (car arg))) (set-window-hscroll (selected-window) 0) (beginning-of-line arg))) (defun w3m-end-of-line (&optional arg) "Move the point to the end of the line and scroll the window left. It makes the ends of upper and lower three lines visible. If `truncate-lines' is nil, it works identically as `end-of-line'." (interactive "P") (if (w3m-image-page-displayed-p) (image-eol (or arg 1)) (w3m-keep-region-active) (if truncate-lines (progn (when (listp arg) (setq arg (car arg))) (forward-line (1- (or arg 1))) (let ((inhibit-point-motion-hooks t) home) (end-of-line) (setq home (point) arg (current-column)) (dolist (n '(-3 -2 -1 1 2 3)) (forward-line n) (end-of-line) (setq arg (max (current-column) arg)) (goto-char home))) (setq temporary-goal-column arg this-command 'next-line) (w3m-set-window-hscroll (selected-window) (max (- arg (window-width) -2) 0))) (set-window-hscroll (selected-window) 0) (end-of-line arg)))) (defun w3m-pattern-uri-replace (uri format) "Create a new uri from URI matched by last search according to FORMAT." (replace-match format nil nil uri)) (defun w3m-uri-replace (uri) "Return the converted URI according to `w3m-uri-replace-alist'." (catch 'found-replacement (dolist (elem w3m-uri-replace-alist uri) (when (string-match (car elem) uri) (throw 'found-replacement (cond ((consp (cdr elem)) (apply (cadr elem) uri (cddr elem))) ;; Rest conditions are inserted in order to keep ;; backward compatibility. ((functionp (cdr elem)) (funcall (cdr elem) uri)) ((stringp (cdr elem)) (w3m-pattern-uri-replace uri (cdr elem))))))))) (defun w3m-goto-mailto-url (url &optional post-data) (let ((before (nreverse (buffer-list))) comp info body buffers buffer function) (setq url (w3m-decode-entities-string (w3m-url-decode-string url))) (save-window-excursion (if (and (symbolp w3m-mailto-url-function) (fboundp w3m-mailto-url-function)) (funcall w3m-mailto-url-function url) ;; Require `mail-user-agent' setting (unless (and (boundp 'mail-user-agent) (symbol-value 'mail-user-agent)) (error "You must specify the valid value to `mail-user-agent'")) (unless (and (setq comp (get (symbol-value 'mail-user-agent) 'composefunc)) (fboundp comp)) (error "No function to compose a mail in `%s'" (symbol-value 'mail-user-agent))) (if (or (featurep 'rfc2368) (condition-case nil (require 'rfc2368) (error nil))) ;; Use rfc2368.el (progn (setq info (rfc2368-parse-mailto-url url) body (assoc "Body" info) info (delq body info) body (delq nil (list (cdr body)))) (when post-data (setq body (nconc body (list (if (consp post-data) (car post-data) post-data))))) (apply comp (append (mapcar (lambda (x) (prog1 (cdr (assoc x info)) (setq info (delq (assoc x info) info)))) '("To" "Subject")) (list info)))) ;; W/o rfc2368.el (string-match ":\\([^?]+\\)" url) (funcall comp (match-string 1 url))))) (setq buffers (nreverse (buffer-list))) (save-current-buffer (while buffers (setq buffer (car buffers) buffers (cdr buffers)) (unless (memq buffer before) (set-buffer buffer) (when (setq function (cdr (assq major-mode w3m-mailto-url-popup-function-alist))) (setq buffers nil))))) (when function (let (same-window-buffer-names same-window-regexps mod) (w3m-static-if (boundp 'display-buffer-alist) (let (display-buffer-alist) (funcall function buffer)) (let (special-display-buffer-names special-display-regexps) (funcall function buffer))) (when body (setq mod (buffer-modified-p)) (goto-char (point-min)) (search-forward (concat "\n" (regexp-quote mail-header-separator) "\n") nil 'move) (unless (bolp) (insert "\n")) (while body (insert (pop body)) (unless (bolp) (insert "\n"))) (set-buffer-modified-p mod)))))) (defun w3m-convert-ftp-url-for-emacsen (url) (or (and (string-match "^ftp://?\\([^/@]+@\\)?\\([^/]+\\)\\(?:/~/\\)?" url) (concat "/" (if (match-beginning 1) (substring url (match-beginning 1) (match-end 1)) "anonymous@") (substring url (match-beginning 2) (match-end 2)) ":" (substring url (match-end 2)))) (error "URL is strange"))) (defun w3m-file-directory-p (file) "Emulate the `file-directory-p' function for the remote file FILE." (when (file-exists-p file) (let (dirp (i 10)) (catch 'loop (while (> i 0) (setq dirp (car (file-attributes file))) (if (stringp dirp) (setq file (expand-file-name dirp (file-name-directory (directory-file-name file))) i (1- i)) (throw 'loop dirp))))))) (defun w3m-goto-ftp-url (url &optional filename) "Copy a remote file to the local system or run dired for ftp URLs. If URL looks like a file, it will perform the copy. Otherwise, it will run `dired-other-window' using `ange-ftp' or `efs'. Optional FILENAME specifies the name of a local file. If FILENAME is omitted, this function will prompt user for it." (let ((ftp (w3m-convert-ftp-url-for-emacsen url)) file) (if (or (string-equal "/" (substring ftp -1)) ;; `file-directory-p' takes a long time for remote files. ;; `file-directory-p' returns t in Emacsen, anytime. (w3m-file-directory-p ftp)) (dired-other-window ftp) (setq file (file-name-nondirectory ftp)) (unless filename (setq filename (w3m-read-file-name nil nil file))) (unless (file-writable-p (file-name-directory filename)) (error "Permission denied, %s" (file-name-directory filename))) (when (or (not (file-exists-p filename)) (if (file-writable-p filename) (and (prog1 (y-or-n-p (format "File(%s) already exists. Overwrite? " filename)) (message nil)) (progn (delete-file filename) t)) (error "Permission denied, %s" filename))) (copy-file ftp filename) (message "Wrote %s" filename))))) (unless w3m-doc-view-map (setq w3m-doc-view-map (make-sparse-keymap)) (define-key w3m-doc-view-map "q" 'w3m-doc-view-quit)) (defun w3m-doc-view (url) "View PDF/PostScript/DVI files using `doc-view-mode'. `w3m-pop-up-windows' and `w3m-pop-up-frames' control how the document window turns up." (let* ((basename (file-name-nondirectory (w3m-url-strip-query url))) (regexp (concat "\\`" (regexp-quote basename) "\\(?:<[0-9]+>\\)?\\'")) (buffers (buffer-list)) buffer data case-fold-search) (save-current-buffer (while buffers (setq buffer (pop buffers)) (if (and (string-match regexp (buffer-name buffer)) (progn (set-buffer buffer) (eq major-mode 'doc-view-mode)) (equal buffer-file-name url)) (setq buffers nil) (setq buffer nil)))) (unless (prog1 buffer (unless buffer (setq buffer (generate-new-buffer basename) data (buffer-string))) (let ((pop-up-windows w3m-pop-up-windows) (pop-up-frames w3m-pop-up-frames)) (pop-to-buffer buffer))) (set-buffer-multibyte nil) (insert data) (set-buffer-modified-p nil) (setq buffer-file-name url) (doc-view-mode) (use-local-map w3m-doc-view-map) (set-keymap-parent w3m-doc-view-map doc-view-mode-map) 'internal-view))) (defun w3m-doc-view-quit (&optional kill) "Quit the `doc-view-mode' window that emacs-w3m launches. With the prefix argument KILL, kill the buffer." (interactive "P") (cond (w3m-pop-up-frames (when (prog1 (one-window-p t) (quit-window kill)) (delete-frame (selected-frame)))) (w3m-pop-up-windows (if (fboundp 'quit-window) (quit-window kill) (if kill (progn (set-buffer-modified-p nil) (kill-buffer (current-buffer))) (bury-buffer))) (unless (eq (next-window nil 'no-mini) (selected-window)) (delete-window))))) (defun w3m-store-current-position () "Memorize the current positions whenever every command starts. The value will be held in the `w3m-current-position' variable. This function is designed as the hook function which is registered to `pre-command-hook' by `w3m-buffer-setup'." (setq w3m-current-position (list (point) (copy-marker (point-at-bol)) (copy-marker (point-at-eol))))) (defun w3m-check-current-position () "Run `w3m-after-cursor-move-hook' if the point gets away from the window. This function is designed as the hook function which is registered to `post-command-hook' by `w3m-buffer-setup'." (when (/= (point) (car w3m-current-position)) ;; To bind `deactivate-mark' to nil protects the mark from being ;; deactivated. `deactivate-mark' is set when any function modifies ;; a buffer, and it causes the deactivation of the mark. (let ((deactivate-mark nil)) (run-hooks 'w3m-after-cursor-move-hook)))) (defun w3m-buffer-setup () "Generate a new buffer, select it and set it up for emacs-w3m. When the current buffer has already been prepared, it won't bother to generate a new buffer." (unless (eq major-mode 'w3m-mode) (let ((buffer (w3m-alive-p t))) (if buffer (set-buffer buffer) (set-buffer (w3m-generate-new-buffer "*w3m*")) (w3m-mode)))) ;; It may have been set to nil for viewing a page source or a header. (setq truncate-lines t) (w3m-make-local-hook 'pre-command-hook) (w3m-make-local-hook 'post-command-hook) (add-hook 'pre-command-hook 'w3m-store-current-position nil t) (add-hook 'post-command-hook 'w3m-check-current-position nil t) (w3m-initialize-graphic-icons) (setq mode-line-buffer-identification `(,@(w3m-static-if (featurep 'xemacs) (list (cons modeline-buffer-id-right-extent "%b") " ") (nconc (propertized-buffer-identification "%b") '(" "))) (w3m-current-process w3m-modeline-process-status-on (w3m-current-ssl (w3m-display-inline-images w3m-modeline-ssl-image-status-on w3m-modeline-ssl-status-off) (w3m-display-inline-images w3m-modeline-image-status-on w3m-modeline-status-off))) (w3m-show-graphic-icons-in-mode-line (w3m-use-favicon (w3m-favicon-image w3m-modeline-favicon w3m-modeline-separator) w3m-modeline-separator) w3m-modeline-separator) (w3m-current-process "Loading..." ,(if (fboundp 'format-mode-line) '(:eval (w3m-modeline-title)) (if w3m-use-title-buffer-name "" 'w3m-current-title))))) (unless (assq 'w3m-current-process mode-line-process) (setq mode-line-process (cons (list 'w3m-current-process 'w3m-process-modeline-string) mode-line-process)))) (defvar w3m-modeline-title-string nil "Internal variable used to keep contents to be shown in the mode line. This is a buffer-local variable.") (make-variable-buffer-local 'w3m-modeline-title-string) (defvar w3m-modeline-title-timer nil "Say time has not gone by after the mode line was updated last time. It is used to control the `w3m-modeline-title' function running too frequently, set by the function itself and cleared by a timer.") (make-variable-buffer-local 'w3m-modeline-title-timer) (eval-when-compile (unless (fboundp 'format-mode-line) (defalias 'format-mode-line 'ignore))) (defun w3m-modeline-title () "Return a truncated title not to cut the right end of the mode line. It currently works only with Emacs 22 and newer." (if w3m-use-title-buffer-name "" (when w3m-current-title (or (and w3m-modeline-title-timer w3m-modeline-title-string) (prog2 (setq w3m-modeline-title-string w3m-current-title w3m-modeline-title-timer t) (let ((excess (- (string-width (condition-case nil (format-mode-line mode-line-format 1) (error ""))) (window-width))) (tlen (string-width w3m-current-title))) (when (and (> excess 0) (> tlen 3)) (setq w3m-modeline-title-string (concat (w3m-replace-in-string (w3m-truncate-string w3m-current-title (max (- tlen excess 3) 2)) "[\t ]+\\'" "") "..."))) w3m-modeline-title-string) (run-at-time 0.5 nil (lambda (buffer) (when (buffer-live-p buffer) (with-current-buffer buffer (setq w3m-modeline-title-timer nil)))) (current-buffer))))))) ;;;###autoload (defun w3m-goto-url (url &optional reload charset post-data referer handler element no-popup save-pos) "Visit World Wide Web pages in the current buffer. This is the primitive function of `w3m'. If the second argument RELOAD is non-nil, reload a content of URL. Except that if it is 'redisplay, re-display the page without reloading. The third argument CHARSET specifies a charset to be used for decoding a content. The fourth argument POST-DATA should be a string or a cons cell. If it is a string, it makes this function request a body as if the content-type is \"x-www-form-urlencoded\". If it is a cons cell, the car of a cell is used as the content-type and the cdr of a cell is used as the body. If the fifth argument REFERER is specified, it is used for a Referer: field for this request. The remaining HANDLER, ELEMENT[1], NO-POPUP, and SAVE-POS[2] are for the internal operations of emacs-w3m. You can also use \"quicksearch\" url schemes such as \"gg:emacs\" which would search for the term \"emacs\" with the Google search engine. See the `w3m-search' function and the variable `w3m-uri-replace-alist'. Notes for the developers: \[1] ELEMENT is a history element which has already been registered in the `w3m-history-flat' variable. It is corresponding to URL to be retrieved at this time, not for the url of the current page. \[2] SAVE-POS leads this function to save the current emacs-w3m window configuration; i.e. to run `w3m-history-store-position'. `w3m-history-store-position' should be called in a w3m-mode buffer, so this will be convenient if a command that calls this function may be invoked in other than a w3m-mode buffer." (interactive (list (if w3m-current-process (error "%s" (substitute-command-keys "Cannot run two w3m processes simultaneously \ \(Type `\\\\[w3m-process-stop]' to stop asynchronous process)")) (w3m-input-url "Open URL in current buffer" nil nil nil 'feeling-searchy 'no-initial)) current-prefix-arg (w3m-static-if (fboundp 'universal-coding-system-argument) coding-system-for-read))) (when (and (stringp url) (not (w3m-interactive-p))) (setq url (w3m-canonicalize-url url))) (set-text-properties 0 (length url) nil url) (unless (or (w3m-url-local-p url) (string-match "\\`about:" url)) (w3m-string-match-url-components url) (setq url (concat (save-match-data (w3m-url-transfer-encode-string (substring url 0 (match-beginning 8)))) (if (match-beginning 8) (concat "#" (match-string 9 url)) "")))) (cond ;; process mailto: protocol ((string-match "\\`mailto:" url) (w3m-goto-mailto-url url post-data)) ;; process ftp: protocol ((and w3m-use-ange-ftp (string-match "\\`ftps?://" url) (not (string= "text/html" (w3m-local-content-type url)))) (w3m-goto-ftp-url url)) ;; find-file directly ((condition-case nil (and (w3m-url-local-p url) w3m-local-find-file-function (let ((base-url (w3m-url-strip-fragment url)) (match (car w3m-local-find-file-regexps)) nomatch file) (and (or (not match) (string-match match base-url)) (not (and (setq nomatch (cdr w3m-local-find-file-regexps)) (string-match nomatch base-url))) (setq file (w3m-url-to-file-name base-url)) (file-exists-p file) (not (file-directory-p file)) (prog1 t (funcall (if (functionp w3m-local-find-file-function) w3m-local-find-file-function (eval w3m-local-find-file-function)) file))))) (error nil))) ;; process buffer-local url ((w3m-buffer-local-url-p url) (let (file-part fragment-part) (w3m-string-match-url-components url) (setq file-part (concat (match-string 4 url) (match-string 5 url)) fragment-part (match-string 9 url)) (cond ((and (string= file-part "") fragment-part) (w3m-search-name-anchor fragment-part)) ((not (string= file-part "")) (w3m-goto-url (w3m-expand-url (substring url (match-beginning 4)) (concat "file://" default-directory)) reload charset post-data referer handler element)) (t (w3m-message "No URL at point"))))) ((w3m-url-valid url) (w3m-buffer-setup) ; Setup buffer. (w3m-arrived-setup) ; Setup arrived database. (unless no-popup (w3m-popup-buffer (current-buffer))) (w3m-cancel-refresh-timer (current-buffer)) (when w3m-current-process (error "%s" (substitute-command-keys " Cannot run two w3m processes simultaneously \ \(Type `\\\\[w3m-process-stop]' to stop asynchronous process)"))) (w3m-process-stop (current-buffer)) ; Stop all processes retrieving images. (w3m-idle-images-show-unqueue (current-buffer)) ;; Store the current position in the history structure if SAVE-POS ;; is set or this command is called interactively. (when (or save-pos (w3m-interactive-p)) (w3m-history-store-position)) ;; Access url group (if (string-match "\\`group:" url) (let ((urls (mapcar 'w3m-url-decode-string (split-string (substring url (match-end 0)) "&"))) (w3m-async-exec (and w3m-async-exec-with-many-urls w3m-async-exec)) buffers) (w3m-process-do (type (save-window-excursion (prog1 (w3m-goto-url (pop urls)) (dotimes (i (length urls)) (push (w3m-copy-buffer nil nil nil 'empty nil t) buffers)) (dolist (url (nreverse urls)) (with-current-buffer (pop buffers) (w3m-goto-url url)))))) type)) ;; Retrieve the page. (lexical-let ((orig url) (url (w3m-url-strip-authinfo url)) (reload (and (not (eq reload 'redisplay)) reload)) (redisplay (eq reload 'redisplay)) (charset charset) (post-data post-data) (referer referer) (name) (history-position (get-text-property (point) 'history-position)) (reuse-history w3m-history-reuse-history-elements)) (when w3m-current-forms ;; Store the current forms in the history structure. (w3m-history-plist-put :forms w3m-current-forms)) (let ((w3m-current-buffer (current-buffer))) (unless element (setq element (if (and (equal referer "about://history/") history-position) (w3m-history-element history-position t) (if w3m-history-reuse-history-elements (w3m-history-assoc url))))) ;; Set current forms using the history structure. (when (setq w3m-current-forms (when (and (not reload) ; If reloading, ignore history. (null post-data) ; If post, ignore history. (or (w3m-cache-available-p url) (w3m-url-local-p url))) ;; Don't use `w3m-history-plist-get' here. (plist-get (nthcdr 3 element) :forms))) ;; Mark that the form is from history structure. (setq w3m-current-forms (cons t w3m-current-forms))) (when (and post-data element) ;; Remove processing url's forms from the history structure. (w3m-history-set-plist (cadr element) :forms nil)) ;; local directory URL check (when (and (w3m-url-local-p url) (file-directory-p (w3m-url-to-file-name url)) (setq url (file-name-as-directory url)) (eq w3m-local-directory-view-method 'w3m-dtree) (string-match "\\`file:///" url)) (setq url (replace-match "about://dtree/" nil nil url) orig url)) ;; Split body and fragments. (w3m-string-match-url-components url) (and (match-beginning 8) (setq name (match-string 9 url) url (substring url 0 (match-beginning 8)))) (when (w3m-url-local-p url) (unless (string-match "[^\000-\177]" url) (setq url (w3m-url-decode-string url)))) (w3m-process-do (action (if (and (not reload) (not redisplay) (stringp w3m-current-url) (string= url w3m-current-url)) (progn (w3m-refontify-anchor) 'cursor-moved) (when w3m-name-anchor-from-hist (w3m-history-plist-put :name-anchor-hist (append (list 1 nil) (and (integerp (car w3m-name-anchor-from-hist)) (nthcdr (1+ (car w3m-name-anchor-from-hist)) w3m-name-anchor-from-hist))))) (setq w3m-name-anchor-from-hist (plist-get (nthcdr 3 element) :name-anchor-hist)) (setq w3m-current-process (w3m-retrieve-and-render orig reload charset post-data referer handler)))) (with-current-buffer w3m-current-buffer (setq w3m-current-process nil) (if (not action) (w3m-history-push w3m-current-url (list :title (or w3m-current-title ""))) (w3m-string-match-url-components w3m-current-url) (and (match-beginning 8) (setq name (match-string 9 w3m-current-url))) (when (and name (progn ;; Redisplay to search an anchor sure. (sit-for 0) (w3m-search-name-anchor name nil (not (eq action 'cursor-moved))))) (setf (w3m-arrived-time (w3m-url-strip-authinfo orig)) (w3m-arrived-time url))) (unless (eq action 'cursor-moved) (if (equal referer "about://history/") ;; Don't sprout a new branch for the existing history ;; element. (let ((w3m-history-reuse-history-elements t)) (w3m-history-push w3m-current-url (list :title w3m-current-title)) ;; Fix the history position pointers. (when history-position (setcar w3m-history (w3m-history-regenerate-pointers history-position)))) (let ((w3m-history-reuse-history-elements reuse-history) (position (when (eq 'reload reuse-history) (cadar w3m-history)))) (w3m-history-push w3m-current-url (list :title w3m-current-title)) (when position (w3m-history-set-current position)))) (w3m-history-add-properties (list :referer referer :post-data post-data)) (unless w3m-toggle-inline-images-permanently (setq w3m-display-inline-images w3m-default-display-inline-images)) (when (and w3m-use-form reload) (w3m-form-textarea-files-remove)) (cond ((w3m-display-inline-images-p) (and w3m-force-redisplay (sit-for 0)) (w3m-toggle-inline-images 'force reload)) ((and (w3m-display-graphic-p) (eq action 'image-page)) (and w3m-force-redisplay (sit-for 0)) (w3m-toggle-inline-image 'force reload))))) (setq buffer-read-only t) (set-buffer-modified-p nil) (setq list-buffers-directory w3m-current-title) ;; must be `w3m-current-url' (setq default-directory (w3m-current-directory w3m-current-url)) (w3m-buffer-name-add-title) (w3m-update-toolbar) (let ((real-url (if (w3m-arrived-p url) (or (w3m-real-url url) url) url))) (run-hook-with-args 'w3m-display-functions real-url) (run-hook-with-args 'w3m-display-hook real-url)) (w3m-select-buffer-update) (w3m-session-crash-recovery-save) (when (and w3m-current-url (stringp w3m-current-url) (or (string-match "\\`about://\\(?:header\\|source\\)/" w3m-current-url) (equal (w3m-content-type w3m-current-url) "text/plain"))) (setq truncate-lines nil)) ;; restore position must call after hooks for localcgi. (when (or reload redisplay) (w3m-history-restore-position)) (w3m-set-buffer-unseen) (w3m-refresh-at-time))))))) (t (w3m-message "Invalid URL: %s" url)))) (defun w3m-current-directory (url) "Return a directory used as the current directory in a page visiting URL. See `w3m-default-directory'." (or (and url (stringp url) (let (file) (if (string-match "\\`ftp://" url) (progn (setq file (w3m-convert-ftp-url-for-emacsen url)) (file-name-as-directory (if (string-match "/\\`" file) file (file-name-directory file)))) (and (setq file (w3m-url-to-file-name url)) (file-exists-p file) (file-name-as-directory (if (file-directory-p file) file (file-name-directory file))))))) (let (directory) (file-name-as-directory (or (and (stringp w3m-default-directory) (file-directory-p w3m-default-directory) (expand-file-name w3m-default-directory)) (and (symbolp w3m-default-directory) (boundp w3m-default-directory) (setq directory (symbol-value w3m-default-directory)) (stringp directory) (file-directory-p directory) (expand-file-name directory)) (and (functionp w3m-default-directory) (stringp (setq directory (condition-case nil (funcall w3m-default-directory url) (error nil)))) (file-directory-p directory) (expand-file-name directory)) w3m-profile-directory))))) (defun w3m-refresh-at-time () (when (and w3m-use-refresh w3m-current-refresh) (let ((seconds (car w3m-current-refresh)) (url (cdr w3m-current-refresh))) (setq seconds (max seconds w3m-refresh-minimum-interval)) (if (= seconds 0) (w3m-goto-url-with-timer url (current-buffer)) (setq w3m-refresh-timer (run-at-time seconds nil 'w3m-goto-url-with-timer url (current-buffer))))))) (defun w3m-goto-url-with-timer (url buffer) "Run the `w3m-goto-url' function by the refresh timer." (when (and (w3m-url-valid url) buffer (if (stringp buffer) (get-buffer buffer) (buffer-name buffer))) (cond ((get-buffer-window buffer) (save-selected-window (pop-to-buffer buffer) (with-current-buffer buffer (w3m-cancel-refresh-timer buffer) (if (and w3m-current-url (string= url w3m-current-url)) (w3m-reload-this-page t) (w3m-goto-url url))))) ((buffer-live-p buffer) (let* ((cwin (selected-window)) (cbuf (window-buffer cwin))) (with-current-buffer buffer (w3m-cancel-refresh-timer buffer) (if (and w3m-current-url (string= url w3m-current-url)) (w3m-reload-this-page t t) (w3m-goto-url url nil nil nil nil nil nil t))) (set-window-buffer cwin cbuf))) (t (with-current-buffer buffer (w3m-cancel-refresh-timer buffer)))))) (defun w3m-goto-new-session-url (&optional reload) "Open `w3m-new-session-url' in a new session." (interactive "P") (if (not (eq major-mode 'w3m-mode)) (message "This command can be used in w3m mode only") (w3m-view-this-url-1 w3m-new-session-url reload 'new-session))) ;;;###autoload (defun w3m-goto-url-new-session (url &optional reload charset post-data referer) "Visit World Wide Web pages in a new buffer. If you invoke this command in the emacs-w3m buffer, the new buffer will be created by copying the current buffer. Otherwise, the new buffer will start afresh." (interactive (list (w3m-input-url "Open URL in new buffer" nil (or (w3m-active-region-or-url-at-point) w3m-new-session-url) nil 'feeling-searchy 'no-initial) current-prefix-arg (w3m-static-if (fboundp 'universal-coding-system-argument) coding-system-for-read) nil ;; post-data nil)) ;; referer (let (buffer) (if (not (or (eq 'w3m-mode major-mode) (and (setq buffer (w3m-alive-p)) (prog1 t (w3m-popup-buffer buffer))))) (w3m-goto-url url nil charset post-data) ;; Store the current position in the history structure. (w3m-history-store-position) (switch-to-buffer (setq buffer (w3m-copy-buffer nil "*w3m*" w3m-new-session-in-background 'empty nil t))) (w3m-display-progress-message url) (w3m-goto-url url (or reload ;; When new URL has `name' portion, we have to ;; goto the base url because generated buffer ;; has no content at this moment. (and (w3m-string-match-url-components url) (match-beginning 8) 'redisplay)) charset post-data referer) ;; Delete useless newly created buffer if it is empty. (w3m-delete-buffer-if-empty buffer)))) (defun w3m-move-point-for-localcgi (url) (when (and (w3m-url-local-p url) (file-directory-p (w3m-url-to-file-name url)) (not (eq w3m-local-directory-view-method 'w3m-dtree)) (= (point-min) (point)) (w3m-search-name-anchor "current" 'quiet)) (recenter (/ (window-height) 5)))) ;;;###autoload (defun w3m-gohome () "Go to the Home page." (interactive) (unless w3m-home-page (error "You have to specify the value of `w3m-home-page'")) (w3m-goto-url w3m-home-page t nil nil nil nil nil nil t)) ;;;###autoload (defun w3m-create-empty-session () "Create an empty page as a new session and visit it." (interactive) (w3m-goto-url-new-session "about:blank")) (defun w3m-reload-this-page (&optional arg no-popup) "Reload the current page, disregarding the cached contents. If the prefix arg ARG is given, it also clears forms and post data." (interactive "P") (if w3m-current-url (let ((w3m-history-reuse-history-elements ;; Don't move the history position. 'reload) post-data) (if arg (progn (w3m-history-remove-properties '(:forms nil :post-data nil)) (setq w3m-current-forms nil)) (when (and (setq post-data (w3m-history-plist-get :post-data)) (not (y-or-n-p "Repost form data? "))) (setq post-data nil))) (w3m-history-store-position) (w3m-goto-url w3m-current-url 'reload nil post-data (w3m-history-plist-get :referer) nil (w3m-history-element (cadar w3m-history) t) no-popup) (w3m-history-restore-position)) (w3m-message "Can't reload this page"))) (defun w3m-reload-all-pages (&optional arg) "Reload all pages, disregarding the cached contents. If the prefix arg ARG is given, it also clears forms and post data." (interactive "P") (if arg (save-window-excursion (dolist (buffer (w3m-list-buffers)) (switch-to-buffer buffer) (w3m-reload-this-page))) (dolist (buffer (w3m-list-buffers)) (save-window-excursion (switch-to-buffer buffer) (w3m-reload-this-page))))) (defun w3m-redisplay-this-page (&optional arg) "Redisplay the current page. If the prefix arg ARG is given, it toggles the visibility of images." (interactive "P") (if (null w3m-current-url) (w3m-message "Can't redisplay this page") (when arg (setq w3m-display-inline-images (not w3m-display-inline-images))) (let ((w3m-prefer-cache t) (w3m-history-reuse-history-elements ;; Don't move the history position. 'reload)) (w3m-history-store-position) (w3m-goto-url w3m-current-url 'redisplay) (w3m-history-restore-position)))) (defun w3m-redisplay-and-reset (&optional arg) "Redisplay the current page and reset the user-specified values. This function clears the charset and the content type which the user specified for overriding the values of what the page requires. The prefix argument ARG is passed to the `w3m-redisplay-this-page' function (which see)." (interactive "P") (if (null w3m-current-url) (w3m-message "Can't execute this page") (setf (w3m-arrived-content-type w3m-current-url) nil) (setf (w3m-arrived-content-charset (if (string-match "\\`about://source/" w3m-current-url) (substring w3m-current-url (match-end 0)) w3m-current-url)) nil) (w3m-redisplay-this-page arg))) (defun w3m-redisplay-with-charset (&optional arg) "Redisplay the current page, specifying a charset. If the user enters the empty string, the value which once was used for decoding the page is used. The prefix argument ARG is passed to the `w3m-redisplay-this-page' function (which see)." (interactive "P") (if (null w3m-current-url) (w3m-message "Can't execute the command") (setf (w3m-arrived-content-charset (if (string-match "\\`about://source/" w3m-current-url) (substring w3m-current-url (match-end 0)) w3m-current-url)) (w3m-read-content-charset (format "Content-charset (current %s, default reset): " w3m-current-coding-system))) (w3m-redisplay-this-page arg))) (defun w3m-redisplay-with-content-type (&optional arg) "Redisplay the current page, specifying a content type. If the user enters the empty string, it uses the value which was specified by the page's contents itself. The prefix argument ARG is passed to the `w3m-redisplay-this-page' function (which see)." (interactive "P") (if (null w3m-current-url) (w3m-message "Can't execute this page") (setf (w3m-arrived-content-type w3m-current-url) (let ((type (completing-read (format "Content-type (current %s, default reset): " (or (w3m-arrived-content-type w3m-current-url) (w3m-content-type w3m-current-url))) w3m-content-type-alist nil t))) (unless (string= type "") type))) (w3m-redisplay-this-page arg))) (defun w3m-examine-command-line-args () "Return a url when the `w3m' command is invoked from the command line. The `w3m' Lisp command can be invoked even in the batch mode, e.g., ``emacs -f w3m'' or ``emacs -f w3m url''. This function is used in the very case, it extracts a url string from the command line arguments and passes it to the `w3m' command. If a url is omitted, it defaults to the value of `w3m-home-page' or \"about:\"." (let ((url (car command-line-args-left)) (directives '("-f" "-funcall" "--funcall" "-e")) args) (if (and url (not (string-match "\\`-" url))) (progn (setq command-line-args-left (cdr command-line-args-left)) (when (string-match "\\`[\t ]*\\'" url) ;; emacs -f w3m '' ... (setq url (or w3m-home-page "about:")))) (setq args (nthcdr (max (- (length command-line-args) (length command-line-args-left) 2) 1) command-line-args)) (when (and (equal (cadr args) "w3m") (member (car args) directives)) (setq url (or w3m-home-page "about:")))) (unless (and command-line-args-left (progn (setq args (reverse command-line-args-left)) (while (and args (not (and (setq args (cdr (member "w3m" args))) (member (car args) directives))))) args)) (defalias 'w3m-examine-command-line-args (lambda nil))) ;; Inhibit the startup screen. (when (and url ;; Since XEmacs provides `inhibit-startup-message' as ;; a constant, we don't modify the value. (not (featurep 'xemacs))) (let ((var (cond ((boundp 'inhibit-startup-screen) 'inhibit-startup-screen) ((boundp 'inhibit-startup-message) 'inhibit-startup-message))) fn) (when (and var (not (symbol-value var))) (set var t) (setq fn (make-symbol "w3m-inhibit-startup-screen")) (fset fn `(lambda nil (set ',var nil) (remove-hook 'window-setup-hook ',fn) (fmakunbound ',fn))) (add-hook 'window-setup-hook fn)))) url)) ;;;###autoload (defun w3m (&optional url new-session interactive-p) "Visit World Wide Web pages using the external w3m command. When you invoke this command interactively for the first time, it will visit a page which is pointed to by a string like url around the cursor position or the home page specified by the `w3m-home-page' variable, but you will be prompted for a URL if `w3m-quick-start' is nil (default t) or `w3m-home-page' is nil. The variables `w3m-pop-up-windows' and `w3m-pop-up-frames' control whether this command should pop to a window or a frame up for the session. When an emacs-w3m session has already been opened, this command will pop to an existing window or frame, but if `w3m-quick-start' is nil, (default t), you will be prompted for a URL (which defaults to `popup' meaning to pop to an existing emacs-w3m buffer up). In addition, if the prefix argument is given or you enter the empty string for the prompt, this command will visit a url at the point, or the home page the `w3m-home-page' variable specifies, or the \"about:\" page. You can also run this command in the batch mode as follows: emacs -f w3m http://emacs-w3m.namazu.org/ & In that case, or if this command is called non-interactively, the variables `w3m-pop-up-windows' and `w3m-pop-up-frames' will be ignored \(treated as nil) and it will run emacs-w3m at the current (or the initial) window. If the optional NEW-SESSION is non-nil, this function makes a new emacs-w3m buffer. Besides that, it also makes a new emacs-w3m buffer if `w3m-make-new-session' is non-nil and a user specifies a url string. The optional INTERACTIVE-P is for the internal use; it is mainly used to check whether Emacs 22 or later calls this function as an interactive command in the batch mode." (interactive (let ((url ;; Emacs 22 or later calls a Lisp command interactively even ;; if it is in the batch mode. If the following function ;; returns non-nil value, it means this function is called in ;; the batch mode, and we don't treat it as what it is called ;; to interactively. (w3m-examine-command-line-args)) new) (list ;; url (or url (let ((default (or (w3m-url-at-point) (if (w3m-alive-p) 'popup w3m-home-page)))) (setq new (if current-prefix-arg default (w3m-input-url nil nil default w3m-quick-start 'feeling-searchy 'no-initial))))) ;; new-session (and w3m-make-new-session (w3m-alive-p) (not (eq new 'popup))) ;; interactive-p (not url)))) (let ((nofetch (eq url 'popup)) (alived (w3m-alive-p)) (buffer (unless new-session (w3m-alive-p t))) (w3m-pop-up-frames (and interactive-p w3m-pop-up-frames)) (w3m-pop-up-windows (and interactive-p w3m-pop-up-windows))) (unless (and (stringp url) (> (length url) 0)) (if buffer (setq nofetch t) ;; This command was possibly be called non-interactively or as ;; the batch mode. (setq url (or (w3m-examine-command-line-args) ;; Unlikely but this function was called with no url. "about:") nofetch nil))) (unless buffer ;; It means `new-session' is non-nil or there's no emacs-w3m buffer. ;; At any rate, we create a new emacs-w3m buffer in this case. (with-current-buffer (setq buffer (w3m-generate-new-buffer "*w3m*")) (w3m-mode))) (w3m-popup-buffer buffer) (unless nofetch ;; `unwind-protect' is needed since a process may be terminated by C-g. (unwind-protect (let* ((crash (and (not alived) (w3m-session-last-crashed-session))) (last (and (not alived) (not crash) (w3m-session-last-autosave-session)))) (w3m-goto-url url) (when (or crash last) (w3m-session-goto-session (or crash last)))) ;; Delete useless newly created buffer if it is empty. (w3m-delete-buffer-if-empty buffer))))) (eval-when-compile (autoload 'browse-url-interactive-arg "browse-url")) ;;;###autoload (defun w3m-browse-url (url &optional new-session) "Ask emacs-w3m to browse URL. NEW-SESSION specifies whether to create a new emacs-w3m session. URL defaults to the string looking like a url around the cursor position. Pop to a window or a frame up according to `w3m-pop-up-windows' and `w3m-pop-up-frames'." (interactive (progn (require 'browse-url) (browse-url-interactive-arg "Emacs-w3m URL: "))) (when (stringp url) (setq url (w3m-canonicalize-url url)) (if new-session (w3m-goto-url-new-session url) (w3m-goto-url url nil nil nil nil nil nil nil t)))) ;;;###autoload (defun w3m-find-file (file) "Function used to open FILE whose name is expressed in ordinary format. The file name will be converted into the file: scheme." (interactive "fFilename: ") (w3m-goto-url (w3m-expand-file-name-as-url file) nil (w3m-static-if (fboundp 'universal-coding-system-argument) coding-system-for-read) nil nil nil nil nil t)) (defun w3m-cygwin-path (path) "Convert PATH in the win32 style into the cygwin format. ex. c:/dir/file => //c/dir/file" (if (string-match "^\\([A-Za-z]\\):" path) (replace-match "//\\1" nil nil path) path)) ;;;###autoload (defun w3m-region (start end &optional url charset) "Render the region of the current buffer between START and END. URL specifies the address where the contents come from. It can be omitted or nil when the address is not identified. CHARSET is used for decoding the contents. If it is nil, this function attempts to parse the meta tag to extract the charset." (interactive (list (region-beginning) (region-end) (w3m-expand-file-name-as-url (or (buffer-file-name) default-directory)))) (save-restriction (w3m-process-stop (current-buffer)) (narrow-to-region start end) (w3m-clear-local-variables) (let ((w3m-current-buffer (current-buffer))) (unless charset (setq charset (w3m-correct-charset (w3m-detect-meta-charset)))) (setq url (or url w3m-buffer-local-url) w3m-current-url url w3m-current-base-url url w3m-current-coding-system (if charset (w3m-charset-to-coding-system charset) w3m-coding-system) w3m-current-title (let (w3m-use-refresh) (w3m-rendering-buffer charset))) (w3m-fontify) (when (w3m-display-inline-images-p) (and w3m-force-redisplay (sit-for 0)) (w3m-toggle-inline-images 'force))))) ;;;###autoload (defun w3m-buffer (&optional url charset) "Render the current buffer. See `w3m-region' for the optional arguments." (interactive (list (w3m-expand-file-name-as-url (or (buffer-file-name) default-directory)))) (w3m-region (point-min) (point-max) url charset)) ;;; About: (defun w3m-about (url &rest args) (insert " About emacs-w3m
Welcome to \ \"emacs-w3m\"!

emacs-w3m is an interface program of w3m, works on Emacs.
") "text/html") (defun w3m-view-source (&optional arg) "Display an html source of a page visited in the current buffer. ARG should be a number (a non-numeric value is treated as `1') which controls how much to decode a source. A number larger than or equal to 4 (which the `C-u' prefix produces) means don't decode. The number 2 or 3 means decode normal text. The number 1 means decodes `&#nnn;' entities in 128..159 and 160 in addition to normal text (the default). A number less than or equal to zero means also encode urls containing non-ASCII characters." (interactive "p") (if w3m-current-url (let ((w3m-prefer-cache t) (w3m-view-source-decode-level (if (numberp arg) arg 0)) (w3m-history-reuse-history-elements t)) (w3m-history-store-position) (cond ((string-match "\\`about://source/" w3m-current-url) (w3m-goto-url (substring w3m-current-url (match-end 0)))) ((string-match "\\`about://header/" w3m-current-url) (w3m-goto-url (concat "about://source/" (substring w3m-current-url (match-end 0))))) (t (w3m-goto-url (concat "about://source/" w3m-current-url)))) (w3m-history-restore-position) t) ; <-- an improvement, but wrong if the above failed (BORUCH) (w3m-message "Can't view page source"))) (defun w3m-make-separator () (if (string= w3m-language "Japanese") (make-string (/ (w3m-display-width) 2) (make-char 'japanese-jisx0208 40 44)) (make-string (w3m-display-width) ?-))) (defun w3m-about-header (url &optional no-uncompress no-cache &rest args) (when (string-match "\\`about://header/" url) (setq url (substring url (match-end 0))) (insert "Page Information\n" "\nTitle: " (or (w3m-arrived-title (w3m-url-strip-authinfo url)) "") "\nURL: " url "\nDocument Type: " (or (w3m-content-type url) "") "\nLast Modified: " (let ((time (w3m-last-modified url))) (if time (current-time-string time) ""))) (let (anchor anchor-title image-url image-alt image-size) (with-current-buffer w3m-current-buffer (when (equal url w3m-current-url) (setq anchor (w3m-anchor) anchor-title (w3m-anchor-title) image-url (w3m-image) image-alt (w3m-image-alt) image-size (w3m-get-text-property-around 'w3m-image-size)))) (if anchor (insert "\nCurrent Anchor: " anchor)) (if anchor-title (insert "\nAnchor Title: " anchor-title)) (if image-url (insert "\nImage: " image-url)) (if image-alt (insert "\nImage Alt: " image-alt)) (if image-size (insert (format "\nImage Size: %sx%s" (car image-size) (cdr image-size))))) (let ((ct (w3m-arrived-content-type url)) (charset (w3m-arrived-content-charset url)) (separator (w3m-make-separator)) (case-fold-search t) header ssl beg) (when (or ct charset) (insert "\n\n" separator "\n\nModifier Information\n") (insert "\nDocument Content-Type: " (or ct "")) (insert "\nDocument Charset: " (or charset ""))) (when (and (not (w3m-url-local-p url)) (setq header (condition-case nil (or (unless no-cache (w3m-cache-request-header url)) (w3m-process-with-wait-handler (w3m-w3m-dump-head url handler))) (w3m-process-timeout nil)))) (insert "\n\n" separator "\n\nHeader Information\n\n" header) (goto-char (point-min)) (when (re-search-forward "^w3m-ssl-certificate: " nil t) (setq beg (match-end 0)) (forward-line) (while (and (not (eobp)) (looking-at "^[ \t]")) (forward-line)) (setq ssl (buffer-substring beg (point))) (delete-region beg (point)) (goto-char beg) (insert "SSL\n") (goto-char (point-max)) (insert separator "\n\nSSL Information\n\n") (setq beg (point)) (insert ssl) (goto-char beg) (while (re-search-forward "^\t" nil t) (delete-char -1) (when (looking-at "Certificate:") (insert "\n")))))) "text/plain")) (defun w3m-view-header () "Display the header of the current page." (interactive) (if w3m-current-url (let ((w3m-prefer-cache t) (w3m-history-reuse-history-elements t) (url (cond ((string-match "\\`about://header/" w3m-current-url) (substring w3m-current-url (match-end 0))) ((string-match "\\`about://source/" w3m-current-url) (let ((real-url (substring w3m-current-url (match-end 0)))) (unless (string-match "\\`about:" real-url) (concat "about://header/" real-url)))) ((string-match "\\`about:" w3m-current-url) nil) (t (concat "about://header/" w3m-current-url))))) (if url (progn (w3m-history-store-position) (w3m-goto-url url) (w3m-history-restore-position)) (w3m-message "Can't load a header for %s" w3m-current-url))) (w3m-message "Can't view page header"))) (defvar w3m-about-history-max-indentation '(/ (* (window-width) 2) 3) "*Number used to limit the identation level when showing a history. This value is evaluated whenever a history page is displayed by the `w3m-about-history' command. So, it can be any s-expression returning a number.") (defvar w3m-about-history-indent-level 4 "*Number used to specify the indentation level when showing a history. A history page is invoked by the `w3m-about-history' command.") (defun w3m-about-history (&rest args) "Show a tree-structured history." (let (start history current) (with-current-buffer w3m-current-buffer (setq history w3m-history-flat current (cadar w3m-history))) (insert "\ URL history

List of all the links you have visited in this session.

\n")
    (setq start (point))
    (when history
      (let ((form
	     (format
	      "%%0%dd"
	      (length
	       (number-to-string
		(apply 'max
		       (apply 'append
			      (mapcar
			       ;; Don't use `caddr' here, since it won't
			       ;; be substituted by the compiler macro.
			       (lambda (e)
				 (car (cdr (cdr e))))
			       history)))))))
	    (cur (current-buffer))
	    (margin (if (> w3m-about-history-indent-level 1)
			1
		      0))
	    (max-indent (condition-case nil
			    ;; Force the value to be a number or nil.
			    (+ 0 (eval w3m-about-history-max-indentation))
			  (error nil)))
	    (last-indent -1)
	    (sub-indent 0)
	    element url about title position bol indent)
	(while history
	  (setq element (pop history)
		url (car element)
		;; FIXME: an ad-hoc workaround to avoid illegal-type errors.
		about (or (not (stringp url))
			  (string-match w3m-history-ignored-regexp url))
		title (plist-get (cadr element) :title)
		position (caddr element))
	  (when url
	    (insert (format "h%s %d %d %s%s%s %s\n"
			    (mapconcat (lambda (d) (format form d))
				       position
				       "-")
			    (/ (1- (length position)) 2)
			    (if (equal current position) 1 0)
			    url
			    (if about "<" "")
			    (if (or (not title)
				    (string-equal "" title)
				    (string-match "^[\t $B!!(B]*$" title))
				url
			      (w3m-encode-specials-string title))
			    (if about ">" "")
			    position))))
	(sort-fields 0 start (point-max))
	(goto-char start)
	(while (not (eobp))
	  (setq bol (point))
	  (skip-chars-forward "^ ")
	  (setq indent (read cur)
		sub-indent (if (= indent last-indent)
			       (1+ sub-indent)
			     0)
		last-indent indent
		indent (+ (* w3m-about-history-indent-level indent)
			  sub-indent))
	  (when (prog1
		    (= (read cur) 1)
		  (delete-region bol (point))
		  (insert-char ?\  (+ margin (if max-indent
						 (min max-indent indent)
					       indent))))
	    (beginning-of-line)
	    (delete-char 1)
	    (insert ">"))
	  (forward-line 1))))
    (insert "
") "text/html")) (defun w3m-about-db-history (url &rest args) (let ((start 0) (size nil) (width (- (w3m-display-width) 18)) (now (current-time)) title time alist prev next page total) (when (string-match "\\`about://db-history/\\?" url) (dolist (s (split-string (substring url (match-end 0)) "&")) (when (string-match "\\`\\(?:start\\|\\(size\\)\\)=" s) (set (if (match-beginning 1) 'size 'start) (string-to-number (substring s (match-end 0))))))) (when w3m-arrived-db (mapatoms (lambda (sym) (and sym (setq url (symbol-name sym)) (not (string-match "#" url)) (not (string-match w3m-history-ignored-regexp url)) (push (cons url (w3m-arrived-time url)) alist))) w3m-arrived-db) (setq alist (sort alist (lambda (a b) (w3m-time-newer-p (cdr a) (cdr b)))))) (setq total (length alist)) (setq alist (nthcdr start alist)) (when size (when (> start 0) (setq prev (format "about://db-history/?start=%d&size=%d" (max 0 (- start size)) size))) (when (> (length alist) size) (setq next (format "about://db-history/?start=%d&size=%d" (+ start size) size))) (when (> total 0) (setq total (+ (/ total size) (if (> (% total size) 0) 1 0))) (setq page (1+ (/ start size))))) (insert "URL history in DataBase" (if prev (format "\n" prev) "") (if next (format "\n" next) "") (format "\n\n

Arrived URL history in DataBase%s

\n" (if (and page total) (format " (%d/%d)" page total) ""))) (setq prev (if (or prev next) (setq next (concat "

" (if prev (format "[Prev History]" prev) "") (if next (format "[Next History]" next) "") "

\n")) "")) (if (null alist) (insert "Nothing in DataBase.\n") (insert prev "\n") (while (and alist (or (not size) (>= (decf size) 0))) (setq url (car (car alist)) time (cdr (car alist)) alist (cdr alist) title (w3m-arrived-title url)) (if (or (null title) (string= "" title)) (setq title (concat "<" (w3m-truncate-string url width) ">")) (when (>= (string-width title) width) (setq title (concat (w3m-truncate-string title width) "...")))) (insert (format "" url (w3m-encode-specials-string title))) (when time (insert "")) (insert "\n")) (insert "

Title/URL

Time/Date

%s" (if (<= (w3m-time-lapse-seconds time now) 64800) ;; = (* 60 60 18) 18hours. (format-time-string "%H:%M:%S" time) (format-time-string "%Y-%m-%d" time)) "
" (if next "\n
\n
\n" "") prev)) (insert "\n")) "text/html") (defun w3m-history-highlight-current-url (url) "Highlight the current url if it is a page for the history. It does manage history position data as well." (when (string-equal "about://history/" url) (let ((inhibit-read-only t) (buffer (current-buffer)) start) ;; Make history position data invisible. (goto-char (point-min)) (w3m-next-anchor) (while (progn (setq start (point)) ;; Extend href anchor. (put-text-property (point-at-bol) start 'w3m-href-anchor (get-text-property start 'w3m-href-anchor)) (re-search-forward " (\\(?:[0-9]+ \\)*[0-9]+)$" nil t)) (goto-char (match-beginning 0)) (put-text-property start (match-beginning 0) 'history-position (read buffer)) (add-text-properties (match-beginning 0) (match-end 0) '(invisible t intangible t)) (forward-char 2) (skip-chars-forward "\t ")) ;; Highlight the current url. (goto-char (point-min)) (when (search-forward "\n>" nil t) (w3m-next-anchor) (setq start (point)) (end-of-line) (w3m-add-face-property start (point) 'w3m-history-current-url) (goto-char start))) (set-buffer-modified-p nil))) (defcustom w3m-db-history-display-size (and (> w3m-keep-arrived-urls 500) 500) "*Maximum number of arrived URLs which are displayed per page." :group 'w3m :type '(radio (const :tag "All entries are displayed in single page." nil) (integer :format "%t: %v\n"))) (defun w3m-db-history (&optional start size) "Display arrived URLs." (interactive (list nil w3m-db-history-display-size)) (w3m-goto-url (concat (format "about://db-history/?start=%d" (or start 0)) (if size (format "&size=%d" size) "")) nil nil nil nil nil nil nil t)) (defun w3m-history (&optional arg) "Display the history of all the links you have visited in the session. If it is called with the prefix argument, display the arrived URLs." (interactive "P") (if (null arg) (w3m-goto-url "about://history/" nil nil nil nil nil nil nil t) (w3m-db-history nil w3m-db-history-display-size))) (defun w3m-w32-browser-with-fiber (url) (let ((proc (start-process "w3m-w32-browser-with-fiber" (current-buffer) "fiber.exe" "-s" (if (w3m-url-local-p url) (w3m-url-to-file-name url) url)))) (set-process-filter proc 'ignore) (set-process-sentinel proc 'ignore))) (defun w3m-pipe-source (&optional url command) "Pipe the page source of url URL in binary to a shell command COMMAND. For the interactive use, URL defaults to that of a link at the point; if there are both a link to a page and a link to an image at the point, the link to a page is preferred unless the prefix argument is given." (interactive (let ((url (or (if current-prefix-arg (or (w3m-image) (w3m-anchor)) (or (w3m-anchor) (w3m-image))) (and w3m-current-url (prog1 (y-or-n-p (format "Pipe <%s> ? " w3m-current-url)) (message nil)) w3m-current-url))) command) (if (and (w3m-url-valid url) (progn (setq command (read-string "Command: ")) (not (string-match "\\`[\000-\040]*\\'" command)))) (list url command) (list 'none nil)))) (cond ((eq url 'none) nil) ((and (stringp url) (w3m-url-valid url) (stringp command) (not (string-match "\\`[\000-\040]*\\'" command))) (w3m-message "Pipe <%s> to \"| %s\"..." url command) (with-temp-buffer (set-buffer-multibyte nil) (w3m-process-with-wait-handler (w3m-retrieve (cond ((string-match "\\`about://source/" url) url) ((string-match "\\`about://header/" url) (concat "about://source/" (substring url (match-end 0)))) (t (concat "about://source/" url))))) (shell-command-on-region (point-min) (point-max) command nil) (w3m-message "Pipe <%s> to \"| %s\"...done" url command) (let ((buffer (get-buffer "*Shell Command Output*"))) (when (and buffer (not (zerop (buffer-size buffer)))) (display-buffer buffer))))) (t (error "Can't pipe page source")))) ;;; Interactive select buffer. (defcustom w3m-select-buffer-horizontal-window t "*Non-nil means split windows horizontally to open the selection window." :group 'w3m :type 'boolean) (defcustom w3m-select-buffer-window-ratio '(18 . 12) "*The percentage of the selection window to the whole frame. The car is used when splitting windows horizontally and the cdr is for splitting windows vertically." :group 'w3m :type '(cons (integer :format "H: %v[%%] ") (integer :format "V: %v[%%]\n"))) (defvar w3m-select-buffer-window nil) (defconst w3m-select-buffer-message "n: next buffer, p: previous buffer, q: quit." "Help message used when the emacs-w3m buffers selection window is open.") ;; Why this function is here abruptly is because of `w-s-b-horizontal-window'. (defun w3m-display-width () "Return the maximum width which should display lines within the value." (if (< 0 w3m-fill-column) w3m-fill-column (+ (if (and w3m-select-buffer-horizontal-window (get-buffer-window w3m-select-buffer-name)) ;; Show pages as if there is no buffers selection window. (frame-width) (window-width)) (or w3m-fill-column -1)))) (defun w3m-select-buffer (&optional toggle nomsg) "Pop to the emacs-w3m buffers selection window up. It provides the feature for switching emacs-w3m buffers using the buffer list. The following command keys are available: \\{w3m-select-buffer-mode-map}" (interactive "P") (when toggle (setq w3m-select-buffer-horizontal-window (not w3m-select-buffer-horizontal-window)) (when (get-buffer-window w3m-select-buffer-name) (delete-windows-on w3m-select-buffer-name))) (unless (or (eq major-mode 'w3m-mode) (eq major-mode 'w3m-select-buffer-mode)) (let ((buffer (w3m-alive-p t))) (if buffer (w3m-popup-buffer buffer) (w3m-goto-url (or w3m-home-page "about:"))))) (let ((selected-window (selected-window)) (current-buffer (current-buffer))) (set-buffer (w3m-get-buffer-create w3m-select-buffer-name)) (unless (eq nomsg 'update) (setq w3m-select-buffer-window selected-window)) (let ((w (or (get-buffer-window w3m-select-buffer-name) (split-window selected-window (w3m-select-buffer-window-size) w3m-select-buffer-horizontal-window)))) (set-window-buffer w (current-buffer)) (select-window w)) (w3m-select-buffer-generate-contents current-buffer)) (w3m-select-buffer-mode) (or nomsg (w3m-message w3m-select-buffer-message))) (defun w3m-select-buffer-update (&rest args) (when (get-buffer-window w3m-select-buffer-name) (save-selected-window (w3m-select-buffer nil 'update))) (when w3m-use-tab (w3m-force-window-update))) (defun w3m-select-buffer-generate-contents (current-buffer) (let ((i 0) (inhibit-read-only t)) (delete-region (point-min) (point-max)) (dolist (buffer (w3m-list-buffers)) (put-text-property (point) (progn (insert (format "%d:%s %s\n" (incf i) (if (w3m-unseen-buffer-p buffer) "(u)" " ") (w3m-buffer-title buffer))) (point)) 'w3m-select-buffer buffer)) (skip-chars-backward " \t\r\f\n") (delete-region (point) (point-max)) (set-buffer-modified-p nil) (goto-char (or (text-property-any (point-min) (point-max) 'w3m-select-buffer current-buffer) (point-min))))) (defvar w3m-select-buffer-mode-map nil) (unless w3m-select-buffer-mode-map (let ((map (make-keymap))) (suppress-keymap map) (substitute-key-definition 'next-line 'w3m-select-buffer-next-line map global-map) (substitute-key-definition 'previous-line 'w3m-select-buffer-previous-line map global-map) (substitute-key-definition 'w3m-copy-buffer 'w3m-select-buffer-copy-buffer map w3m-mode-map) (substitute-key-definition 'w3m-next-buffer 'w3m-select-buffer-next-line map w3m-mode-map) (substitute-key-definition 'w3m-previous-buffer 'w3m-select-buffer-previous-line map w3m-mode-map) (substitute-key-definition 'w3m-delete-buffer 'w3m-select-buffer-delete-buffer map w3m-mode-map) (substitute-key-definition 'w3m-delete-other-buffers 'w3m-select-buffer-delete-other-buffers map w3m-mode-map) (substitute-key-definition 'w3m-scroll-up-or-next-url 'w3m-select-buffer-show-this-line map w3m-mode-map) (substitute-key-definition 'w3m-scroll-down-or-previous-url 'w3m-select-buffer-show-this-line-and-down map w3m-mode-map) (substitute-key-definition 'w3m-select-buffer 'w3m-select-buffer-toggle-style map w3m-mode-map) (define-key map " " 'w3m-select-buffer-show-this-line) (define-key map "g" 'w3m-select-buffer-recheck) (define-key map "j" 'w3m-select-buffer-next-line) (define-key map "k" 'w3m-select-buffer-previous-line) (define-key map "n" 'w3m-select-buffer-next-line) (define-key map "p" 'w3m-select-buffer-previous-line) (define-key map "q" 'w3m-select-buffer-quit) (define-key map "h" 'w3m-select-buffer-show-this-line-and-switch) (define-key map "w" 'w3m-select-buffer-show-this-line-and-switch) (define-key map "\C-m" 'w3m-select-buffer-show-this-line-and-quit) (define-key map "\C-c\C-c" 'w3m-select-buffer-show-this-line-and-quit) (define-key map "\C-c\C-k" 'w3m-select-buffer-quit) (define-key map "\C-c\C-q" 'w3m-select-buffer-quit) (define-key map "\C-g" 'w3m-select-buffer-quit) (define-key map "?" 'describe-mode) (setq w3m-select-buffer-mode-map map))) (defun w3m-select-buffer-mode () "Major mode for switching emacs-w3m buffers using the buffer list. \\\ \\[w3m-select-buffer-next-line]\ Next buffer. \\[w3m-select-buffer-previous-line]\ Previous buffer. \\[w3m-select-buffer-show-this-line]\ Show the buffer on the current menu line or scroll it up. \\[w3m-select-buffer-show-this-line-and-down]\ Show the buffer on the current menu line or scroll it down. \\[w3m-select-buffer-show-this-line-and-switch]\ Show the buffer on the menu and switch to the buffer. \\[w3m-select-buffer-show-this-line-and-quit]\ Show the buffer on the menu and quit the buffers selection. \\[w3m-select-buffer-copy-buffer]\ Create a copy of the buffer on the menu, and show it. \\[w3m-select-buffer-delete-buffer]\ Delete the buffer on the current menu line. \\[w3m-select-buffer-delete-other-buffers]\ Delete emacs-w3m buffers except for the buffer on the menu. \\[w3m-select-buffer-toggle-style]\ Toggle the style of the selection between horizontal and vertical. \\[w3m-select-buffer-recheck]\ Do the roll call to all emacs-w3m buffers. \\[w3m-select-buffer-quit]\ Quit the buffers selection. " (setq major-mode 'w3m-select-buffer-mode mode-name "w3m buffers" truncate-lines t buffer-read-only t) (use-local-map w3m-select-buffer-mode-map) (w3m-run-mode-hooks 'w3m-select-buffer-mode-hook)) (defun w3m-select-buffer-recheck () "Do the roll call to all emacs-w3m buffers and regenerate the menu." (interactive) (let ((inhibit-read-only t)) (erase-buffer)) (w3m-select-buffer-generate-contents (window-buffer w3m-select-buffer-window)) (w3m-select-buffer-show-this-line)) (defmacro w3m-select-buffer-current-buffer () '(get-text-property (point-at-bol) 'w3m-select-buffer)) (defun w3m-select-buffer-show-this-line (&optional interactive-p) "Show the buffer on the current menu line or scroll it up." (interactive (list t)) (forward-line 0) (let ((obuffer (and (window-live-p w3m-select-buffer-window) (window-buffer w3m-select-buffer-window))) (buffer (w3m-select-buffer-current-buffer))) (unless buffer (error "No buffer at point")) (cond ((get-buffer-window buffer) (setq w3m-select-buffer-window (get-buffer-window buffer))) ((window-live-p w3m-select-buffer-window) ()) ((one-window-p t) (setq w3m-select-buffer-window (selected-window)) (select-window (split-window nil (w3m-select-buffer-window-size) w3m-select-buffer-horizontal-window))) (t (setq w3m-select-buffer-window (get-largest-window)))) (set-window-buffer w3m-select-buffer-window buffer) (when (and interactive-p (eq obuffer buffer)) (save-selected-window (pop-to-buffer buffer) (w3m-scroll-up-or-next-url nil))) (w3m-force-window-update w3m-select-buffer-window) (w3m-message w3m-select-buffer-message) buffer)) (defun w3m-select-buffer-show-this-line-and-down () "Show the buffer on the current menu line or scroll it down." (interactive) (let ((obuffer (and (window-live-p w3m-select-buffer-window) (window-buffer w3m-select-buffer-window))) (buffer (w3m-select-buffer-show-this-line))) (when (eq obuffer buffer) (save-selected-window (pop-to-buffer buffer) (w3m-scroll-down-or-previous-url nil))))) (defun w3m-select-buffer-next-line (&optional n) "Move cursor vertically down N lines and show the buffer on the menu." (interactive "p") (forward-line n) (prog1 (w3m-select-buffer-show-this-line) (w3m-static-when (featurep 'xemacs) (save-window-excursion ;; Update gutter tabs. (select-window w3m-select-buffer-window))))) (defun w3m-select-buffer-previous-line (&optional n) "Move cursor vertically up N lines and show the buffer on the menu." (interactive "p") (w3m-select-buffer-next-line (- n))) (defun w3m-select-buffer-copy-buffer () "Create a copy of the buffer on the current menu line, and show it." (interactive) (w3m-select-buffer-show-this-line) (let ((window (selected-window))) (select-window (get-buffer-window (w3m-select-buffer-current-buffer))) ;; The selection buffer will be updated automatically because ;; `w3m-copy-buffer' calls `w3m-select-buffer-update' by way of ;; `w3m-goto-url'. (w3m-copy-buffer) (select-window window))) (defun w3m-select-buffer-delete-buffer (&optional force) "Delete the buffer on the current menu line. If only one emacs-w3m buffer exists, it is assumed that the function was called to terminate the emacs-w3m session. In this case, the optional prefix argument FORCE can be set non-nil to exit the session without prompting for confirmation." (interactive "P") (let ((pos (point)) (buffer (w3m-select-buffer-show-this-line))) (if (= 1 (count-lines (point-min) (point-max))) (w3m-quit force) (w3m-process-stop buffer) (w3m-idle-images-show-unqueue buffer) (kill-buffer buffer) (when w3m-use-form (w3m-form-kill-buffer buffer)) (run-hooks 'w3m-delete-buffer-hook) (w3m-select-buffer-generate-contents (w3m-select-buffer-current-buffer)) (w3m-select-buffer-show-this-line) (goto-char (min pos (point-max))) (beginning-of-line)))) (defun w3m-select-buffer-delete-other-buffers () "Delete emacs-w3m buffers except for the buffer on the current menu." (interactive) (w3m-select-buffer-show-this-line) (w3m-delete-other-buffers (w3m-select-buffer-current-buffer))) (defun w3m-select-buffer-quit () "Quit the buffers selection." (interactive) (if (one-window-p t) (set-window-buffer (selected-window) (or (w3m-select-buffer-current-buffer) (w3m-alive-p))) (let ((buf (or (w3m-select-buffer-current-buffer) (w3m-alive-p))) pop-up-frames) (pop-to-buffer buf) (and (get-buffer-window w3m-select-buffer-name) (delete-windows-on w3m-select-buffer-name))))) (defun w3m-select-buffer-show-this-line-and-switch () "Show the buffer on the menu and switch to the buffer." (interactive) (pop-to-buffer (w3m-select-buffer-show-this-line)) (message nil)) (defun w3m-select-buffer-show-this-line-and-quit () "Show the buffer on the menu and quit the buffers selection." (interactive) (w3m-select-buffer-show-this-line-and-switch) (and (get-buffer-window w3m-select-buffer-name) (delete-windows-on w3m-select-buffer-name))) (defun w3m-select-buffer-close-window () "Close the window which displays the buffers selection." (let ((window (get-buffer-window w3m-select-buffer-name))) (when window (if (one-window-p t) (set-window-buffer window (other-buffer)) (delete-window window))))) (defun w3m-select-buffer-toggle-style() "Toggle the style of the selection between horizontal and vertical." (interactive) (w3m-select-buffer t)) (defun w3m-select-buffer-window-size () (if w3m-select-buffer-horizontal-window (- (window-width) (/ (* (frame-width) (car w3m-select-buffer-window-ratio)) 100)) (- (window-height) (/ (* (frame-height) (cdr w3m-select-buffer-window-ratio)) 100)))) ;;; Header line (defcustom w3m-use-header-line t "*Non-nil means display the header line." :group 'w3m :type 'boolean) (defcustom w3m-use-header-line-title nil "Non-nil means display the current title at the header line. This variable is effective only when `w3m-use-tab' is nil." :group 'w3m :type 'boolean) (defface w3m-header-line-location-title '((((class color) (background light)) (:foreground "Blue" :background "Gray90")) (((class color) (background dark)) (:foreground "Cyan" :background "Gray20"))) "Face used to highlight title when displaying location in the header line." :group 'w3m-face) ;; backward-compatibility alias (put 'w3m-header-line-location-title-face 'face-alias 'w3m-header-line-location-title) (defface w3m-header-line-location-content '((((class color) (background light)) (:foreground "DarkGoldenrod" :background "Gray90")) (((class color) (background dark)) (:foreground "LightGoldenrod" :background "Gray20"))) "Face used to highlight url when displaying location in the header line." :group 'w3m-face) ;; backward-compatibility alias (put 'w3m-header-line-location-content-face 'face-alias 'w3m-header-line-location-content) (defface w3m-error '((((class color) (background light)) (:foreground "Red1" :bold t)) (((class color) (background dark)) (:foreground "Pink" :bold t)) (t (:inverse-video t :bold t))) "Face used to highlight errors and to denote failure." :group 'w3m-face) (when (featurep 'xemacs) (when (featurep 'tty) (set-face-reverse-p 'w3m-error t 'global '(default tty)))) (defvar w3m-header-line-map nil) (unless w3m-header-line-map (let ((map (make-sparse-keymap))) (set-keymap-parent map w3m-mode-map) (define-key map [mouse-2] 'w3m-goto-url) ;; Prevent tool-bar from being doubled under GNU Emacs. (define-key map [tool-bar] 'undefined) (setq w3m-header-line-map map))) (defun w3m-header-line-insert () "Put the header line into the current buffer." (when (and (or (featurep 'xemacs) (w3m-use-tab-p)) w3m-use-header-line w3m-current-url (eq 'w3m-mode major-mode)) (goto-char (point-min)) (let ((ct (w3m-arrived-content-type w3m-current-url)) (charset (w3m-arrived-content-charset w3m-current-url))) (insert (format "Location%s: " (cond ((and ct charset) " [TC]") (ct " [T]") (charset " [C]") (t ""))))) (w3m-add-face-property (point-min) (point) 'w3m-header-line-location-title) (let ((start (point))) (insert (w3m-puny-decode-url (if (string-match "[^\000-\177]" w3m-current-url) w3m-current-url (w3m-url-decode-string w3m-current-url w3m-current-coding-system "%\\([2-9a-f][0-9a-f]\\)")))) (w3m-add-face-property start (point) 'w3m-header-line-location-content) (w3m-add-text-properties start (point) `(mouse-face highlight keymap ,w3m-header-line-map ,@(if (featurep 'xemacs) '(help-echo "button2 prompts to input URL" balloon-help "button2 prompts to input URL") '(help-echo "mouse-2 prompts to input URL")))) (setq start (point)) (insert-char ?\ (max 0 (- (if (and w3m-select-buffer-horizontal-window (get-buffer-window w3m-select-buffer-name)) (frame-width) (window-width)) (current-column) 1))) (w3m-add-face-property start (point) 'w3m-header-line-location-content) (unless (eolp) (insert "\n"))))) ;;; w3m-minor-mode (defcustom w3m-goto-article-function nil "Function used to visit an article pointed to by a given URL in `w3m-minor-mode' buffer. Normally, this option is used only when you follow a link in an html article. A function set to this variable must take one argument URL, and should display the specified page. It may return the symbol `w3m-goto-url' when it fails displaying the page. In this case, either `w3m-goto-url' or `w3m-goto-url-new-session' is employed to display the page." :group 'w3m :type '(radio (const :tag "Use emacs-w3m" nil) (function :value browse-url))) (defun w3m-safe-view-this-url (&optional force) "View the URL of the link under point. This command is quite similar to `w3m-view-this-url' except for the four differences: [1]don't handle forms, [2]don't consider URL-like string under the cursor, [3]compare URL with `w3m-safe-url-regexp' first to check whether it is safe, and [4]the arguments list differs; the optional FORCE, if it is non-nil, specifies URL is safe. You should use this command rather than `w3m-view-this-url' when viewing doubtful pages that might contain vicious forms. This command makes a new emacs-w3m buffer if `w3m-make-new-session' is non-nil and a user invokes this command in a buffer not being running the `w3m-mode', otherwise use an existing emacs-w3m buffer." (interactive "P") (let ((w3m-pop-up-windows nil) (url (w3m-url-valid (w3m-anchor))) safe-regexp) (cond (url (setq safe-regexp (get-text-property (point) 'w3m-safe-url-regexp)) (if (or (not safe-regexp) (w3m-buffer-local-url-p url) (string-match safe-regexp url) force) (unless (and (functionp w3m-goto-article-function) (not (eq 'w3m-goto-url (funcall w3m-goto-article-function url)))) (if (and w3m-make-new-session (not (eq major-mode 'w3m-mode))) (w3m-goto-url-new-session url) (w3m-goto-url url))) (when (w3m-interactive-p) (w3m-message "\ This link is considered to be unsafe; use the prefix arg to view anyway")))) ((w3m-url-valid (w3m-image)) (if (w3m-display-graphic-p) (if (w3m-interactive-p) (call-interactively 'w3m-toggle-inline-image) (w3m-toggle-inline-image force)) (w3m-view-image))) (t (w3m-message "No URL at point"))))) (defun w3m-mouse-safe-view-this-url (event) "Perform the command `w3m-safe-view-this-url' by the mouse event." ;; Note: a command invoked by [mouse-N] cannot accept the prefix ;; argument since [down-mouse-N] eats it. (interactive "e") (mouse-set-point event) (let ((url (w3m-url-valid (or (w3m-anchor) (w3m-image))))) (if url (let ((safe-regexp (get-text-property (point) 'w3m-safe-url-regexp)) (use-dialog-box t)) (when (or (not safe-regexp) (w3m-buffer-local-url-p url) (string-match safe-regexp url) (y-or-n-p "\ This link is considered to be unsafe; continue? ")) (w3m-safe-view-this-url t))) (w3m-message "No URL at point")))) (defconst w3m-minor-mode-command-alist '((w3m-next-anchor) (w3m-previous-anchor) (w3m-next-image) (w3m-previous-image) (w3m-toggle-inline-image) (w3m-toggle-inline-images) (w3m-view-this-url . w3m-safe-view-this-url) (w3m-mouse-view-this-url . w3m-mouse-safe-view-this-url) (w3m-print-this-url)) "Alist of commands and commands to be defined in `w3m-minor-mode-map'. Each element looks like (FROM-COMMAND . TO-COMMAND); those keys which are defined as FROM-COMMAND in `w3m-mode-map' are redefined as TO-COMMAND in `w3m-minor-mode-map'. When TO-COMMAND is nil, FROM-COMMAND is defined in `w3m-minor-mode-map' with the same key in `w3m-mode-map'.") (defun w3m-make-minor-mode-keymap () "Return a keymap used for `w3m-minor-mode'." (let ((keymap (make-sparse-keymap))) (dolist (pair w3m-minor-mode-command-alist) (substitute-key-definition (car pair) (or (cdr pair) (car pair)) keymap w3m-mode-map)) (unless (featurep 'xemacs) ;; Inhibit the `widget-button-click' command when ;; `w3m-imitate-widget-button' is activated. (define-key keymap [down-mouse-2] 'undefined)) keymap)) (defvar w3m-minor-mode-map (w3m-make-minor-mode-keymap) "*Keymap used when `w3m-minor-mode' is active.") (defcustom w3m-minor-mode-hook nil "*Hook run after `w3m-minor-mode' initialization." :group 'w3m :type 'hook) (defvar w3m-minor-mode nil "Non-nil if w3m minor mode is enabled.") (make-variable-buffer-local 'w3m-minor-mode) (unless (assq 'w3m-minor-mode minor-mode-alist) (push (list 'w3m-minor-mode " w3m") minor-mode-alist)) (unless (assq 'w3m-minor-mode minor-mode-map-alist) (push (cons 'w3m-minor-mode w3m-minor-mode-map) minor-mode-map-alist)) (defun w3m-minor-mode (&optional arg) "Minor mode to view text/html parts in articles." (interactive "P") (when (setq w3m-minor-mode (if arg (> (prefix-numeric-value arg) 0) (not w3m-minor-mode))) (run-hooks 'w3m-minor-mode-hook))) (defcustom w3m-do-cleanup-temp-files nil "*Whether to clean up temporary files when emacs-w3m shutdown." :group 'w3m :type 'boolean) (defun w3m-cleanup-temp-files () (when w3m-do-cleanup-temp-files (dolist (f (directory-files w3m-profile-directory)) (when (string-match "^w3m\\(el\\|src\\)" f) (delete-file (expand-file-name f w3m-profile-directory)))))) (defun w3m-show-form-hint () "Show sending form hint when the cursor is in a form." (when w3m-use-form (w3m-form-unexpand-form)) (let ((keys (where-is-internal 'w3m-submit-form))) (when (and (w3m-submit (point)) keys) (if (get-text-property (point) 'w3m-form-readonly) (if (memq (car (w3m-action)) '(w3m-form-input w3m-form-input-textarea)) (progn (w3m-form-expand-form) (w3m-message "This form is not editable; type `c' to copy the contents")) (w3m-message "This form is not accessible")) (w3m-message "Press %s to send the current form" (key-description (car keys))))))) (provide 'w3m) (unless noninteractive (when w3m-init-file (if (string-match "\\.el\\'" w3m-init-file) (or (load (concat w3m-init-file "c") t t t) (load w3m-init-file t t t)) (load w3m-init-file t t)))) (run-hooks 'w3m-load-hook) ;;; w3m.el ends here w3m-el-snapshot-1.4.609+0.20171225.orig/icons/0000755000000000000000000000000013224004712016434 5ustar rootrootw3m-el-snapshot-1.4.609+0.20171225.orig/icons/state-00.xpm0000644000000000000000000000101707736774045020546 0ustar rootroot/* XPM */ static char *noname[] = { /* width height ncolors chars_per_pixel */ " 16 14 7 1", /* colors */ " c none", "# c #314030", "$ c #617f5f", "% c #485e47", "+ c #89b386", ". c #c4ffbf", "; c #b0e5ac", /* pixels */ " ", " ", " #### #### ", " %$#$# #$#$% ", "%%++$+$ $+$++%%", ";;;;+;+ +;+;;;;", "....+.+ +.+....", ";;;;+;+ +;+;;;;", "++++$;$ $;$++++", "%%%%#%# #%#%%%%", " %+#+# #+#+% ", " #### #### ", " ", " " }; w3m-el-snapshot-1.4.609+0.20171225.orig/icons/open-up.xpm0000644000000000000000000000172507732257036020572 0ustar rootroot/* XPM */ static char *open-up[] = { /* width height num_colors chars_per_pixel */ " 24 24 9 1", /* colors */ ". c #b6b2b6 s backgroundToolBarColor", "# c #000000", "a c #efffc7", "b c #cfba96", "c c #f7ffbe", "d c #aeb2ae", "e c #a6a6a6", "f c #79b2f7", "g c #698eef", /* pixels */ "........................", "........................", ".........#############..", "........#a#bccccccccc#dd", ".......#aa#bccccccccc#ed", "......#a###bccccccccc#ed", "......##bbbbccdcdddcc#ed", "......#bccccccccccccc#ed", "...#..#cccccccccccccc#ed", "...##.#ccddccccddddcc#ed", "...#f##cccccccccccccc#ed", "####gf#cccccccccccccc#ed", "#fffggf#cdccddcccddcc#ed", "#ggggggf#cccccccccccc#ed", "#gggggg#ccccccccccccc#ed", "####gg#ccddccddcdddcc#ed", "...#g##cccccccccccccc#ed", "...##.#cccccccccccccc#ed", "...#..#cccccccccccccc#ed", "......#cccccccccccccc#ed", "......################ed", ".......eeeeeeeeeeeeeeeed", "........................", "........................" }; w3m-el-snapshot-1.4.609+0.20171225.orig/icons/state-10.xpm0000644000000000000000000000105507736774045020551 0ustar rootroot/* XPM */ static char *noname[] = { /* width height ncolors chars_per_pixel */ " 16 14 9 1", /* colors */ " c none", "# c #314030", "$ c #617F5F", "% c #485E47", "+ c #89B386", ". c #C4FFBF", "; c #B0E5AC", "! c #ff0000", "& c #ff7f7f", /* pixels */ " ", " &&!!!!&& ", " ####!!#### ", " %$#$#!!#$#$% ", "%%++$+$!!$+$++%%", ";;;;+;+!!+;+;;;;", "....+.+!!+.+....", ";;;;+;+!!+;+;;;;", "++++$;$!!$;$++++", "%%%%#%#!!#%#%%%%", " %+#+#!!#+#+% ", " ####!!#### ", " &&!!!!&& ", " " }; w3m-el-snapshot-1.4.609+0.20171225.orig/icons/antenna-up.png0000644000000000000000000000046110556351575021232 0ustar rootrootPNG  IHDR廩擁?PLTE恐8Iy｢q｢小墾08q焦iaΧ暁<:tRNS@聊fIDAT(mQ YPqWEY"?f討'FZRi聨Aレ[i ヒ^`Jp1H02^"Da`+%dIH+ 1$>4 AH 枠輿玻汗}Zm遮吾 '9V綟袖輟}s票cPr9瓔~IENDB`w3m-el-snapshot-1.4.609+0.20171225.orig/icons/antenna-up.xpm0000644000000000000000000000221407732257036021247 0ustar rootroot/* XPM */ static char *antenna-up[] = { /* width height num_colors chars_per_pixel */ " 24 24 21 1", /* colors */ ". c #b6b2b6 s backgroundToolBarColor", "# c #fff749", "a c #000000", "b c #869661", "c c #96a679", "d c #b6c7be", "e c #303871", "f c #081018", "g c #8e9e69", "h c #8ea271", "i c #181c38", "j c #96aa86", "k c #9eae8e", "l c #000008", "m c #96aa9e", "n c #9eb296", "o c #a6b69e", "p c #a6baa6", "q c #8ea2c7", "r c #96bec7", "s c #aebeae", /* pixels */ "......########..........", "....##........##........", "...#...######...........", "..#..##......##.........", ".#..#...####............", ".#.#..##....#...........", "#..#.#...##.............", "#.#..#.##..#........aaa.", "#.#.#..#.aaa......aabba.", "#.#.#.#..acdae..aabbbaf.", "#.#.#.#..aca..eeggggadf.", "#.#.#.....a.eahheeeadi..", "#.........e.aeccccaddi..", "...........ejkejaaddl...", "..........aekkkadddml...", ".........anennaddmml....", "........aooeaaddmlaa....", ".......apppammmmlqqra...", "......assafmmmllqqqra...", "......aaaaaaal..aqqra...", "................aqqqra..", "...............aqqqqqra.", "..............aqqqqqqqra", "..............aaaaaaaaaa" }; w3m-el-snapshot-1.4.609+0.20171225.orig/icons/parent-disabled.xpm0000644000000000000000000000167507732257036022251 0ustar rootroot/* XPM */ static char * parent_disabled_xpm[] = { " 24 24 12 1", " c #b6b2b6 s backgroundToolBarColor", "# c #606060", "a c #d7d7d7", "b c #c6c6c6", "c c #bebebe", "d c #b6b6b6", "e c #a9ada9", "f c #a1a5a1", "g c #999999", "h c #bebabe", "i c #898989", "j c #797979", /* pixels */ " ", " ", " ", " ", " ", " # ", " #a# ", " #aba# ", " #abbba# ", " #accccca# ", " #accccccca# ", " #addddddddda# ", " #####eeeee##### ", " hhhh#fffff#hhhh ", " #ggggg# ", " #iiiii# ", " #jjjjj# ", " ####### ", " hhhhhhh ", " ", " ", " ", " ", " " }; w3m-el-snapshot-1.4.609+0.20171225.orig/icons/forward-up.xpm0000644000000000000000000000206207732257036021270 0ustar rootroot/* XPM */ static char * forward_up_xpm[] = { "24 24 15 1", " c #B6DAB2CAB6DA s backgroundToolBarColor", ". c #000000000000", "X c #C71BFFFF8617", "o c #5965F3CE0000", "O c #5144E79D0000", "+ c #4924DB6C0000", "@ c #4103CF3C0000", "# c #38E3C71B0000", "$ c #AEBAAAAAAEBA", "% c #28A2BAEA0000", "& c #8E388A288E38", "* c #2081AEBA0000", "= c #1861A2890000", "- c #10409A690000", "; c #08208E380000", " ", " ", " ", " ", " . ", " .. ", " .X. ", " .oX. ", " ......OOX. ", " .XXXXX+++X. ", " .@@@@@@@@@X. ", " .##########X. ", " .%%%%%%%%%%.&$ ", " .*********.&$ ", " ......===.&$ ", " &&&&.--.&$ ", " $$$.;.&$ ", " ..&$ ", " .&$ ", " &$ ", " ", " ", " ", " " }; w3m-el-snapshot-1.4.609+0.20171225.orig/icons/parent-up.png0000644000000000000000000000031010556351575021070 0ustar rootrootPNG  IHDRY !PLTE恐YA 8I(Q?tRNS@聊fUIDATc` `A89 I( I 船XVK9ZjTER..瞭..4r郡&3矗言Ck }bjXIENDB`w3m-el-snapshot-1.4.609+0.20171225.orig/icons/save-up.png0000644000000000000000000000051312507124425020530 0ustar rootrootPNG  IHDRY 0PLTEj遅褥ｃ髯`玉燗煬鈴鮗褪T果郎奐鷹溲%AIDATM亊 AA0XL"" IE吾k1L I!娯;畏} ggo駭23t~kA麁ZG霪 (o-=ﾀ 代5c a>D%of(v`c `ｕ `□Z{6婪$婁H+ 教VEぴ aN蛙U%,RHq8!U{躡IENDB`w3m-el-snapshot-1.4.609+0.20171225.orig/icons/home-up.png0000644000000000000000000000036110556351575020535 0ustar rootrootPNG  IHDRY $PLTE恐i0ｮ郎i8otRNS@聊f{IDATc` 28SY*8JAJ0里 Ukお+\uR \*R嫖&pI.　`e.瞭S&9S\v ' 潰{{＃nd`琥蓙(r,巽-IENDB`w3m-el-snapshot-1.4.609+0.20171225.orig/icons/copy-up.png0000644000000000000000000000032210556351575020554 0ustar rootrootPNG  IHDRY PLTE恐暁荻ΖB璋tRNS@聊fnIDAT ]dVYL副耻uС md;/VU pW,rSW嶋Y`3u&f 暢 Vw!`i"v&) T`u[.07WIENDB`w3m-el-snapshot-1.4.609+0.20171225.orig/icons/forward-disabled.png0000644000000000000000000000033710556351575022377 0ustar rootrootPNG  IHDRY -PLTE恐供ァyyy篤鴇松昇抄橋```忻廬5%tRNS@聊f`IDATc` 陟p. s"s袱Rw閘K{n:梦@(rPKJ@;孫l 7MsJ0p ``8s6w @}25$[甫IENDB`w3m-el-snapshot-1.4.609+0.20171225.orig/icons/back-disabled.png0000644000000000000000000000034310556351575021630 0ustar rootrootPNG  IHDRY -PLTE恐供　yyy篤鴇松昇抄橋```忻彈ktRNS@聊fdIDATc` \@b"s!qx#qu椽{&j媚wo'@%v^ B8@l1B9'Mrx9a8y R紅nD0L 椏2'UJIENDB`w3m-el-snapshot-1.4.609+0.20171225.orig/icons/image-up.xpm0000644000000000000000000000204107732257036020703 0ustar rootroot/* XPM */ static char *image-up[] = { /* width height num_colors chars_per_pixel */ " 24 24 14 1", /* colors */ ". c #b6b2b6 s backgroundToolBarColor", "# c #000000", "a c #efffc7", "b c #cfba96", "c c #f7ffbe", "d c #aeb2ae", "e c #a6a6a6", "f c #c7d7ff", "g c #b6c7f7", "h c #a6b6ef", "i c #c7ff86", "j c #9ea6e7", "k c #38c700", "l c #8e96df", /* pixels */ "........................", "........................", "..........#############.", ".........#a#bccccccccc#d", "........#aa#bccccccccc#e", ".......#a###bccccccccc#e", ".......##b########cdcc#e", ".......#bc#ffffff#cccc#e", "....#..#cc#gggggg#cccc#e", "....##.#cc#hhhhhh#ddcc#e", "....#i##cc#jjjjjj#cccc#e", ".####ki#cc#llllll#cccc#e", ".#iiikki#c########ddcc#e", ".#kkkkkki#cccccccccccc#e", ".#kkkkkk#ccccccccccccc#e", ".####kk#ccddccdcdccdcc#e", "....#k##cccccccccccccc#e", "....##.#ccdcddcdcddccc#e", "....#..#cccccccccccccc#e", ".......#cccccccccccccc#e", ".......################e", "........eeeeeeeeeeeeeeee", "........................", "........................" }; w3m-el-snapshot-1.4.609+0.20171225.orig/icons/image-up.png0000644000000000000000000000042110556351575020664 0ustar rootrootPNG  IHDRY *PLTE恐臟牌荻Ζο8暁燉商駈P5'tRNS@聊fIDATc`\誓fYRs\/ "q8 縱8@dXx9qa9{P0派H電C釡[%&i e,*g@q|3gbb z =z4 *Q0! p <]BIENDB`w3m-el-snapshot-1.4.609+0.20171225.orig/icons/history-up.xpm0000644000000000000000000000160307732257036021325 0ustar rootroot/* XPM */ static char * history_up_xpm[] = { /* width height num_colors chars_per_pixel */ " 24 24 3 1", /* colors */ " c #b6b2b6 s backgroundToolBarColor", "% c #6992cf", "# c #30009e", /* pixels */ " ", " ", " ", "################# ", "#%%%%%%%%%%%%%%%# ", "################# ", " ", " ################# ", " #%%%%%%%%%%%%%%%# ", " ################# ", " ", "################# ", "#%%%%%%%%%%%%%%%# ", "################# ", " ", " ################# ", " #%%%%%%%%%%%%%%%# ", " ################# ", " ", " ################", " #%%%%%%%%%%%%%%#", " ################", " ", " " }; w3m-el-snapshot-1.4.609+0.20171225.orig/icons/state-01.xpm0000644000000000000000000000102207736774045020543 0ustar rootroot/* XPM */ static char *noname[] = { /* width height num_colors chars_per_pixel */ " 16 14 7 1", /* colors */ " c none", "# c #403700", "$ c #7f6e00", "% c #5e5100", "+ c #b39b00", ". c #fffafa", "; c #e5c600", /* pixels */ " ", " ", " #### #### ", " %$#$# #$#$% ", "%%++$+$ $+$++%%", ";;;;+;+ +;+;;;;", "....+.+ +.+....", ";;;;+;+ +;+;;;;", "++++$;$ $;$++++", "%%%%#%# #%#%%%%", " %+#+# #+#+% ", " #### #### ", " ", " " }; w3m-el-snapshot-1.4.609+0.20171225.orig/icons/back-up.xpm0000644000000000000000000000205607732257036020527 0ustar rootroot/* XPM */ static char * back_up_xpm[] = { "24 24 15 1", " c #B6DAB2CAB6DA s backgroundToolBarColor", ". c #000000000000", "X c #C71BFFFF8617", "o c #5965F3CE0000", "O c #5144E79D0000", "+ c #4924DB6C0000", "@ c #8E388A288E38", "# c #4103CF3C0000", "$ c #38E3C71B0000", "% c #28A2BAEA0000", "& c #2081AEBA0000", "* c #AEBAAAAAAEBA", "= c #1861A2890000", "- c #10409A690000", "; c #08208E380000", " ", " ", " ", " ", " . ", " .. ", " .X. ", " .Xo. ", " .XOO...... ", " .X+++XXXXX.@ ", " .X#########.@ ", " .X$$$$$$$$$$.@ ", " @.%%%%%%%%%%.@ ", " @.&&&&&&&&&.@ ", " *@.===......@ ", " *@.--.@@@@@@ ", " *@.;. ", " *@.. ", " @. ", " @ ", " ", " ", " ", " " }; w3m-el-snapshot-1.4.609+0.20171225.orig/icons/reload-up.png0000644000000000000000000000041710556351575021055 0ustar rootrootPNG  IHDRY !PLTE狂eiQwvQ堪ex韄徐RtRNS@聊fIDAT= `e衫#zk> 8edYxFer^召3R瘋pN$鼈q5杯斟橦p!エ>pQt&<=I廻y$冖E簓 ゎLQ\'v $@/o41G吟k2IENDB`w3m-el-snapshot-1.4.609+0.20171225.orig/icons/weather-up.png0000644000000000000000000000037610556351575021252 0ustar rootrootPNG  IHDR廩擁9PLTE恐iaYQmY荻y}aq闖閙烝腕消N~ztRNS@聊fsIDAT(廊俚@ 牘Xj-[p濺さ消 |zkD訛R(]{?0sk&鰐"-[#Χ^(a]N+p:鳴H}CK3D <髭0竃 c #69A69248E79D", "< c #69A68A28E79D", "1 c #965896589658", "2 c #AEBAAEBAAEBA", " ", " ", " .... ", " ..XXXX.. ", " .XoO+++Oo. ", " .Xo+@@#$%+o. ", " .Xo+$@@&&*$+o. ", " .XO%*=-;-=*%O. ", " .X+$&-:>:-&$+. ", " .X+#&;><>;&#+. ", " ..X$&-:>:-&$.. ", " .1.%*=-;-=*.1. ", " .2..*&&&..2.1 ", " .@@....22.11 ", " ..@@@2..11 ", " 1.....111 ", " 1..111111 ", " 1..1111 ", " 1..11 ", " 1..1 ", " 1..11 ", " @@.1 ", " ", " " }; w3m-el-snapshot-1.4.609+0.20171225.orig/icons/state-10.png0000644000000000000000000000031210556351575020515 0ustar rootrootPNG  IHDRPLTE医H^Ga_1@0誄FtRNS@聊f]IDATc(rc,---pMh )gp hta``hdRJJBJJAVVAA67r把61dV@*#{aIENDB`w3m-el-snapshot-1.4.609+0.20171225.orig/icons/weather-up.xpm0000644000000000000000000000217507732257036021270 0ustar rootroot/* XPM */ static char *weather-up[] = { /* width height num_colors chars_per_pixel */ " 24 24 20 1", /* colors */ ". c #b6b2b6 s backgroundToolBarColor", "# c #ffaa61", "a c #ffeb9e", "b c #ffdb96", "c c #ffc786", "d c #ffb679", "e c #ffa271", "f c #ff9269", "g c #ff7d61", "h c #ffffff", "i c #ff6d59", "j c #efefef", "k c #ff5951", "l c #dfdfdf", "m c #cfd3cf", "n c #bec3be", "o c #aeb2ae", "p c #9ea29e", "q c #969696", "r c #000000", /* pixels */ "........................", "........................", ".........#..............", ".........#..............", "..#......#......#.......", "...#....###....#........", "....##..###..##.........", "....###.aaa.###.........", ".....#bbbbbbb#..........", "......ccccccc...........", "...##ddddddddd##........", "#####eeeeeeeee#####.....", "...##fffffffff##........", "......gggggggghhh..hhh..", ".....#iiiiiiijjjjjjjjjj.", "....###.kkk.llllllllllll", "....##..###.mmmmmmmmmmmm", "...#....###.nnnnnnnnnnnn", "..#......#..oooooooooooo", ".........#...pppppppppp.", ".........#....qqq..qqq..", "........................", "........................", "........................" }; w3m-el-snapshot-1.4.609+0.20171225.orig/icons/db-history-up.png0000644000000000000000000000024710556351575021674 0ustar rootrootPNG  IHDRk PLTE恐I0i0tRNS@聊fIIDATc`V@ ["R<$ 枇椥 @e害jeu- ]%絶*c8k-IENDB`w3m-el-snapshot-1.4.609+0.20171225.orig/icons/copy-up.xpm0000644000000000000000000000163707732257036020605 0ustar rootroot/* XPM */ static char *copy_up_xpm[] = { /* width height ncolors chars_per_pixel */ "24 24 7 1", /* colors */ " c #b6b2b6 s backgroundToolBarColor", "# c #000000", "a c #aeb2ae", "b c #c7ff86", "c c #f7ffbe", "d c #aeb2ae", "e c #a6a6a6", /* pixels */ " ", " #########ed ", " #ccccccc##ed ", " #ccccccc#c#ed ", " #caaaaac####ed ", " #cccccccccc#ed ", " #caaaaccccc#ed ", " #cccccccccc#ed ", " #ccccc#########ed ", " #c##cc#bbbbbbb##ed ", " #ccccc#bbbbbbb#b#ed ", " #ccccc#baaaaab####ed ", " #ccccc#bbbbbbbbbb#ed ", " #ccccc#baaaabbbbb#ed ", " #######bbbbbbbbbb#ed ", " eeeee#bbbbbbbbbb#ed ", " dddd#baaaaaaabb#ed ", " #bbbbbbbbbb#ed ", " #bbbbbbbbbb#ed ", " #bbbbbbbbbb#ed ", " #bbbbbbbbbb#ed ", " ############ed ", " eeeeeeeeeeeed ", " dddddddddddd " }; w3m-el-snapshot-1.4.609+0.20171225.orig/icons/reload-up.xpm0000644000000000000000000000176607732257036021104 0ustar rootroot/* XPM */ static char *reload-up[] = { /* width height num_colors chars_per_pixel */ " 24 24 11 1", /* colors */ ". c #b6b8b6 s backgroundToolBarColor", "# c #aeb4ae", "a c #000000", "b c #6580c9", "c c #6984d7", "d c #7788d7", "e c #768cdf", "f c #788fe7", "g c #6580e7", "h c #5195ef", "i c #5197f7", /* pixels */ "........................", "........................", "...........#aaaaa.......", "..........aabbbbbaa.....", ".........abbbbbbbbba....", "........accccaaacccca...", ".......#addda###addda#..", ".......aeeea#####aeeea..", ".......afffa#..aaafffaaa", ".......aaaaa....aggggga#", ".................ahhha##", "..##a.............aia##.", ".##aia.............a##..", "##ahhha.................", "#aggggga....aaaaa.......", "aaafffaaa..#afffa.......", "..aeeea#####aeeea.......", "..#addda###addda#.......", "...accccaaacccca........", "....abbbbbbbbba.........", ".....aabbbbbaa..........", ".......aaaaa#...........", "........................", "........................" }; w3m-el-snapshot-1.4.609+0.20171225.orig/icons/forward-disabled.xpm0000644000000000000000000000207007732257036022412 0ustar rootroot/* XPM */ static char *forward-disabled[] = { /* width height num_colors chars_per_pixel */ " 24 24 15 1", /* colors */ ". c #b6b2b6 s backgroundToolBarColor", "# c #606060", "a c #d7d7d7", "b c #c6c6c6", "c c #bebebe", "d c #b6b6b6", "e c #a9ada9", "f c #a1a5a1", "g c #aeaaae", "h c #999999", "i c #bebabe", "j c #919191", "k c #898989", "l c #818181", "m c #797979", /* pixels */ "........................", "........................", "........................", "........................", "...........#............", "...........##...........", "...........#a#..........", "...........#ba#.........", "......######cca#........", "......#aaaaaddda#.......", "......#eeeeeeeeea#......", "......#ffffffffffa#.....", "......#hhhhhhhhhh#ig....", "......#jjjjjjjjj#ig.....", "......######kkk#ig......", ".......iiii#ll#ig.......", "........ggg#m#ig........", "...........##ig.........", "...........#ig..........", "...........ig...........", "........................", "........................", "........................", "........................" }; w3m-el-snapshot-1.4.609+0.20171225.orig/icons/save-up.xpm0000644000000000000000000000201012507124426020543 0ustar rootroot/* XPM */ static char *save-up[] = { /* width height ncolors chars_per_pixel */ "24 24 16 1", /* colors */ " c #6AC3D9", ". c #FCFDFE", "X c #EAF3F7", "o c #A3E3EF", "O c White", "+ c #F1F9FC", "@ c #60B6CC", "# c #DFF3F8", "$ c #97DFEC", "% c #CEEBF2", "& c #BCEAF4", "* c #54B2CC", "= c #9ECFBA", "- c #D4F6FC", "; c #C2EBF3", ": c #8CDEEC", /* pixels */ "=@********************@=", "@%XXXXXXXXXXXXXXXXXXX#%@", "*XOOOOOOO.+X&;#.OOOO.@#*", "*XOOOOO+----@@@ %.OOO.X*", "*XOOO.#-----@@@@@:+OOOX*", "*XOO.------- @@@@ +OOX*", "*XOO#-----OOOO@@@@@:.OX*", "*XOX------OOOO@@@@@ %OX*", "*XO;&;----OOOO@@@@ :OX*", "*X+&&&&;--OOOO@@ XX*", "*X#&&&&&&%OOOO %X*", "*X#&&&&&;;OOOO:: ;X*", "*X#&&&&&+OOOOOO# ;X*", "*XX&&&&&;.OOOO.: %X*", "*X+&&&&&o%OOOO&:: XX*", "*XO;&&ooooXOO#::::: :OX*", "*XOXooooooo..$::::::%OX*", "*XOO&oooooo;&::::::oOOX*", "*XOO.&oooooo::::::o+OOX*", "*XOOO.&ooooo:::::o+OOOX*", "*XOOOOO#&ooo:::o#OOOOOX*", "*XOOOOOOO+#-%#+OOOOOOOX*", "@%XXXXXXXXXXXXXXXXXXXX%@", "=@********************@=" }; w3m-el-snapshot-1.4.609+0.20171225.orig/icons/state-01.png0000644000000000000000000000027410556351575020524 0ustar rootrootPNG  IHDRPLTEn^Q綟@70%tRNS@聊fUIDATcp-- 田71!PQ農P%c窶WSccWV  q4 ePRJJqSSRbpQMMq B6.r)蔚)IENDB`w3m-el-snapshot-1.4.609+0.20171225.orig/icons/spinner.gif0000644000000000000000000000067107756536161020632 0ustar rootrootGIF89a謂随階悶_q^^^GT^@@@桐09@! NETSCAPE2.0! ,cIifUb0pc$RA,B[Q澄@aBr`$@@` @Q0x .#XptB 0 $* ! ,cIifUb0(c$RA( G[Q@aBr`$`` P0x .#Y(tB 0 $* ! ,cIifUb0涜-c$RApB[Q叩@a Br`$C` S0x .#園,tB 0 $* ;w3m-el-snapshot-1.4.609+0.20171225.orig/icons/db-history-up.xpm0000644000000000000000000000162507732257036021714 0ustar rootroot/* XPM */ static char * db_history_up_xpm[] = { /* width height num_colors chars_per_pixel */ " 24 24 4 1", /* colors */ " c #b6b2b6 s backgroundToolBarColor", "* c #fff749", "% c #6992cf", "# c #30009e", /* pixels */ " ", " ", " ", "###################### ", "%%%%%%%%%%%%%%%%%%## ", "################## ", " ", "################ ", "%%%%%%%%%%%%%%%# ", "################ ", " ", "################## ", "%%%%%%%%%%%%%%%%%%## ", "###################### ", "#****##*****# ", "##*##*##*###*###########", " #*###*#*###*#%%%%%%%%%#", " #*###*#****############", " #*###*#*###*# ", "##*##*##*###*######### ", "#****##*****#%%%%%## ", "################## ", " ", " " }; w3m-el-snapshot-1.4.609+0.20171225.orig/icons/back-disabled.xpm0000644000000000000000000000206507732257036021652 0ustar rootroot/* XPM */ static char *back-disabled[] = { /* width height num_colors chars_per_pixel */ " 24 24 15 1", /* colors */ ". c #b6b2b6 s backgroundToolBarColor", "# c #606060", "a c #d7d7d7", "b c #c6c6c6", "c c #bebebe", "d c #b6b6b6", "e c #bebabe", "f c #a9ada9", "g c #a1a1a1", "h c #999999", "i c #919191", "j c #aeaaae", "k c #898989", "l c #818181", "m c #797979", /* pixels */ "........................", "........................", "........................", "........................", "............#...........", "...........##...........", "..........#a#...........", ".........#ab#...........", "........#acc######......", ".......#adddaaaaa#e.....", "......#afffffffff#e.....", ".....#agggggggggg#e.....", ".....e#hhhhhhhhhh#e.....", "......e#iiiiiiiii#e.....", "......je#kkk######e.....", ".......je#ll#eeeeee.....", "........je#m#...........", ".........je##...........", "...........e#...........", "............e...........", "........................", "........................", "........................", "........................" }; w3m-el-snapshot-1.4.609+0.20171225.orig/install-sh0000755000000000000000000001271107565100723017341 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.609+0.20171225.orig/w3m-hist.el0000644000000000000000000007417411727074021017341 0ustar rootroot;;; w3m-hist.el --- the history management system for emacs-w3m ;; Copyright (C) 2001-2012 TSUCHIYA Masatoshi ;; Author: 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: ;; Emacs-w3m keeps history in the buffer-local variables `w3m-history' ;; and `w3m-history-flat'. Each variable contains a list of all the ;; links you have visited. The behavior tracing history backward or ;; forward is controlled by the `w3m-history-reuse-history-elements' ;; variable. See the documentations for those variables for details. ;;; Code: (eval-when-compile (require 'cl)) (require 'w3m-util) (defcustom w3m-history-reuse-history-elements nil "Non-nil means reuse the history element when re-visiting the page. Otherwise, a new history element will be created even if there are elements for the same url in the history. Emacs-w3m used to operate as the case in which it is non-nil, however it sometimes brought about users' dissatisfaction. For example, if a user visited the pages A -> B -> C -> B in order, performing BACK on the second B would let a user visit A. The reason why a user was taken to A rather than C is that the `w3m-history' variable only had the list `(A B C)' as a history and B was the current position at that time. The default value for this variable is nil which allows the `w3m-history' variable to have the list `(A B C B)'. Where contents of two B's are the identical Lisp objects. So, too much wasting the Lisp resources will be avoided. See the documentation for the variables `w3m-history' and `w3m-history-flat' for more information." :group 'w3m :type '(boolean :format "%{%t%}: %[%v%]" :on "On" :off "Off")) (defcustom w3m-history-minimize-in-new-session nil "Non-nil means minimize copied history so that there's only current page. This variable is effective when creating of the new session by copying \(i.e., `w3m-copy-buffer')." :group 'w3m :type '(boolean :format "%{%t%}: %[%v%]" :on "On" :off "Off")) (defvar w3m-history nil "A tree-structured complex list of all the links which you have visited. This is a buffer-local variable. For example, it will grow as follows: \[Branch-1.0.0.0]: +--> U1.0.0.0.0 --> U1.0.0.0.1 | [Branch-1.0]: +--> U1.0.0 --> U1.0.1 --> U1.0.2 | [Trunk]: U0 --> U1 --> U2 --> U3 --> U4 --> U5 --> U6 | [Branch-2.0]: +--> U2.0.0 --> U2.0.1 | [Branch-2.1]: +--> U2.1.0 --> U2.1.1 --> U2.1.2 | \[Branch-2.1.1.0]: +--> U2.1.1.0.0 In this case, the U1.0.0.0.0 history element represents the first link of the first branch which is sprouted from the U1.0.0 history element. The trunk or each branch is a simple list which will contain some history elements. History elements in the trunk or each branch will be arranged in increasing order (the newest history element will be the last element of the list). Each history element represents a link which consists of the following records: (URL PROPERTIES BRANCH BRANCH ...) Where URL is a string of an address of a link. PROPERTIES is a plist which is able to contain any kind of data to supplement the URL as follows: (KEYWORD VALUE KEYWORD VALUE ...) A note for programmers: PROPERTIES should always be a non-nil value in order to make it easy to share the value in every history element in every emacs-w3m buffer. The remaining BRANCHes are branches of the history element. Branches will also be arranged in increasing order (the newest one will be the rightmost element). Each BRANCH will also be a tree-structured complex list. Therefore, the history structure will grow up infinitely. In order to save the Lisp resources, URL strings and PROPERTIES in the `w3m-history' variables are shared in every emacs-w3m buffer (it means each element in two `w3m-history' variables can be compared by `eq' rather than `equal'). If there is necessity to make buffer-local properties, in other words, to make properties of which values differ in every emacs-w3m buffer, use the `w3m-history-flat' variable instead. There are special rules on the emacs-w3m history management system. As you perhaps foresaw, the operation BACK on U2.0.0 brings you to U2, and one more BACK brings you to U1. Well, where do you think we should go next when the operation FORWARD is performed on U1? The rule is to go to the newest link you have ever visited. So, that operation should take you to U1.0.0. Another rule is that the new U4 link should sprout from U1.0.1 if `w3m-history-reuse-history-elements' is nil when you visit the U4 link directly from U1.0.1. In contrast, you should be taken to the existing U4 link instead of sprouting the new branch from U1.0.1 if `w3m-history-reuse-history-elements' is non-nil. In addition, the first element of `w3m-history' is special. It is a list containing pointers which point to three history elements as shown below: (PREV CURRENT NEXT) PREV points to the previous history element, CURRENT points to the current one and NEXT points to the next one. Each of them is a list which contains an odd number of integers. For example, `(0)' does point to U0 and `(2 1 0)' does point to U2.1.0. Finally, the value of the `w3m-history' variable will be constructed as follows: \(((1) (2) (2 1 0)) (\"http://www.U0.org/\" (:title \"U0\" :foo \"bar\")) (\"http://www.U1.org/\" (:title \"U1\" :foo \"bar\") ((\"http://www.U100.org/\" (:title \"U100\" :foo \"bar\") ((\"http://www.U10000.org/\" (:title \"U10000\" :foo \"bar\")) (\"http://www.U10001.org/\" (:title \"U10001\" :foo \"bar\")))) (\"http://www.U101.org/\" (:title \"U101\" :foo \"bar\")) (\"http://www.U102.org/\" (:title \"U102\" :foo \"bar\")))) (\"http://www.U2.org/\" (:title \"U2\" :foo \"bar\") ((\"http://www.U200.org/\" (:title \"U200\" :foo \"bar\")) (\"http://www.U201.org/\" (:title \"U201\" :foo \"bar\"))) ((\"http://www.U210.org/\" (:title \"U210\" :foo \"bar\")) (\"http://www.U211.org/\" (:title \"U211\" :foo \"bar\") ((\"http://www.U21100.org/\" (:title \"U21100\" :foo \"bar\")))) (\"http://www.U212.org/\" (:title \"U212\" :foo \"bar\")))) (\"http://www.U3.org/\" (:title \"U3\" :foo \"bar\")) (\"http://www.U4.org/\" (:title \"U4\" :foo \"bar\")) (\"http://www.U5.org/\" (:title \"U5\" :foo \"bar\")) (\"http://www.U6.org/\" (:title \"U6\" :foo \"bar\")))") (defvar w3m-history-flat nil "A flattened alist of all the links which you have visited. All history elements except for buffer-local properties are the same as ones of `w3m-history'. Each element will contain the following records: (URL PROPERTIES POSITION [KEYWORD VALUE [KEYWORD VALUE ...]]) Where URL is a string of an address of a link, PROPERTIES is a plist which is able to contain any kind of data to supplement the URL. Each PROPERTIES is the Lisp object identical with that corresponding element of `w3m-history'. POSITION is a list of integers to designate the current position in the history. The remaining [KEYWORD VALUE [KEYWORD VALUE ...]] is a plist similar to PROPERTIES, but it is buffer-local. You can manipulate buffer-local properties using the functions `w3m-history-plist-get', `w3m-history-plist-put', `w3m-history-add-properties' and `w3m-history-remove-properties'. See the documentation for the `w3m-history' variable for more information.") (make-variable-buffer-local 'w3m-history) (make-variable-buffer-local 'w3m-history-flat) ;; Inline functions. (defsubst w3m-history-assoc (url) "Extract a history element associated with URL from `w3m-history-flat'." (assoc url w3m-history-flat)) ;; Functions for internal use. (defun w3m-history-set-current (position) "Modify `w3m-history' so that POSITION might be the current position. What is called the current position is the `cadar' of `w3m-history'. The previous position and the next position will be computed automatically." (setcar w3m-history (w3m-history-regenerate-pointers position))) (defun w3m-history-element (position &optional flat) "Return a history element located in the POSITION of the history. If FLAT is nil, the value will be extracted from `w3m-history' and represented with the `(URL PROPERTIES BRANCH BRANCH ...)' form. Otherwise, the value will be extracted from `w3m-history-flat' and represented with the `(URL PROPERTIES POSITION [KEYWORD VALUE ...])' form. FYI, to know the current position, the `(cadar w3m-history)' form for example can be used." (when position (if flat (let ((flat w3m-history-flat) element) (while flat (if (equal (caddr (setq element (pop flat))) position) (setq flat nil) (setq element nil))) element) (let ((element (nth (pop position) (cdr w3m-history)))) (while position (setq element (nth (pop position) (cddr element)) element (nth (pop position) element))) element)))) (defun w3m-history-previous-position (position) "Return a history position of the previous location of POSITION. POSITION is a list of integers of the same form as being used in one of the elements of the `car' of `w3m-history' (which see)." (let (class number previous) (when position (setq class (1- (length position)) number (nth class position)) (if (zerop number) ;; This POSITION is the beginning of the branch. (unless (zerop class) ;; There's a parent. (setq previous (copy-sequence position)) (setcdr (nthcdr (- class 2) previous) nil)) ;; This POSITION is not the beginning of the branch. (setq previous (copy-sequence position)) (setcar (nthcdr class previous) (1- number)))) previous)) (defun w3m-history-next-position (position) "Return a history position of the next location of POSITION. POSITION is a list of integers of the same form as being used in one of the elements of the `car' of `w3m-history' (which see)." (let (next branch element number) (when position (setq next position branch (cdr w3m-history) element (nth (pop next) branch)) (while next (setq branch (nth (pop next) (cddr element)) element (nth (pop next) branch))) (cond ((nth 2 element) ;; There're branches sprouted from the POSITION. (setq next (copy-sequence position)) (setcdr (nthcdr (1- (length next)) next) (list (- (length element) 3) 0))) ((> (length branch) (setq number (1+ (nth (1- (length position)) position)))) ;; This POSITION is not the end of the branch. (setq next (copy-sequence position)) (setcar (nthcdr (1- (length next)) next) number)))) next)) (defun w3m-history-set-plist (plist property value) "Similar to `plist-put' but PLIST is actually modified even in XEmacs. If VALUE is nil, the pair of PROPERTY and VALUE is removed from PLIST. Exceptionally, if PLIST is made empty because of removing, it will be instead set to `(nil nil)'. Return PLIST itself." (let ((pair (memq property plist))) (if pair (if value (setcar (cdr pair) value) (if (eq (car plist) property) (progn (setcar plist (nth 2 plist)) (setcar (cdr plist) (nth 3 plist)) (setcdr (cdr plist) (nthcdr 4 plist))) (setcdr (nthcdr (- (length plist) (length pair) 1) plist) (nthcdr 2 pair)))) (when value (setcdr (nthcdr (1- (length plist)) plist) (list property value))))) plist) (defun w3m-history-modify-properties (old new &optional replace) "Merge NEW plist into OLD plist and return a modified plist. If REPLACE is non-nil, OLD will be replaced with NEW. OLD plist is modified and also the new value is shared in all the history elements containing OLD plist. Properties whose values are nil are removed from OLD plist, but if OLD plist is made empty because of removing, it will be instead set to `(nil nil)'." (prog1 old (if replace (progn (setcar old (car new)) (setcdr old (or (cdr new) (list nil)))) (while new (w3m-history-set-plist old (car new) (cadr new)) (setq new (cddr new)))) (setq new (copy-sequence old)) (while new (w3m-history-set-plist old (car new) (cadr new)) (setq new (cddr new))))) (defun w3m-history-seek-element (url &optional newprops replace) "Return a copy of history element corresponding to URL. Searching is performed in all emacs-w3m buffers and the first match found is returned. If REPLACE is nil, NEPROPS will be merged into properties of an element. Otherwise, properties of an element will be replaced with NEWPROPS." (let* ((current (current-buffer)) (buffers (cons current (delq current (buffer-list)))) element) (while buffers (set-buffer (pop buffers)) (when (and (eq major-mode 'w3m-mode) (setq element (w3m-history-assoc url))) (setq buffers nil))) (set-buffer current) (prog1 (copy-sequence element) (when element (w3m-history-modify-properties (cadr element) newprops replace))))) ;; Generic functions. (defun w3m-history-previous-link-available-p () "Return non-nil if the previous history element is available." (caar w3m-history)) (defun w3m-history-next-link-available-p () "Return non-nil if the next history element is available." (caddar w3m-history)) (defun w3m-history-backward (&optional count) "Move backward COUNT times in the history structure. Return a cons of a new history element and new position pointers of the history. The position pointers of `w3m-history' will not change. If COUNT is omitted, it defaults to the number one. If COUNT is negative, moving forward is performed. Return nil if there is no previous element." (when w3m-history (let ((oposition (copy-sequence (car w3m-history))) position last) (cond ((or (unless count (setq count 1)) (> count 0)) (while (and (> count 0) (setq position (caar w3m-history))) (w3m-history-set-current (setq last position)) (decf count))) ((< count 0) (while (and (< count 0) (setq position (caddar w3m-history))) (w3m-history-set-current (setq last position)) (incf count))) (t ;; Don't move. (setq last (cadar w3m-history)))) (prog1 (when last (cons (w3m-history-element (cadar w3m-history)) (car w3m-history))) (setcar w3m-history oposition))))) (defun w3m-history-forward (&optional count) "Move forward COUNT times in the history structure. Return a cons of a new history element and new position pointers of the history. The position pointers of `w3m-history' will not change. If COUNT is omitted, it defaults to the number one. If COUNT is negative, moving backward is performed. If there is no room to move in the history, move as far as possible." (w3m-history-backward (- (or count 1)))) (defun w3m-history-regenerate-pointers (position) "Regenerate the position pointers due to only the current POSITION. The history position pointers are made with the `(PREV CURRENT NEXT)' form which is mentioned in the documentation for `w3m-history'." (list (w3m-history-previous-position position) position (w3m-history-next-position position))) (defun w3m-history-flat () "Set the value of `w3m-history-flat' due to the value of `w3m-history'. See also the documentations for those variables." (setq w3m-history-flat nil) (when w3m-history (let ((history (cdr w3m-history)) (position (list 0)) element branches flag children) (while (setq element (pop history)) (if (stringp (car element)) (progn (push (list (car element) (cadr element) (reverse position)) w3m-history-flat) (if (setq element (cddr element)) (progn (setq history (append element history) position (append (list 0 0) position)) (push (length element) branches)) (setcar position (1+ (car position))) (setq flag t) (while (and flag children (zerop (setcar children (1- (car children))))) (setq children (cdr children)) (if (zerop (setcar branches (1- (car branches)))) (progn (setq branches (cdr branches) position (cddr position)) (setcar position (1+ (car position)))) (setcar position 0) (setcar (cdr position) (1+ (cadr position))) (setq flag nil))))) (setq history (append element history)) (push (length element) children)))) (setq w3m-history-flat (nreverse w3m-history-flat)))) (defun w3m-history-tree (&optional newpos) "Set the value of `w3m-history' due to the value of `w3m-history-flat'. See also the documentations for those variables. NEWPOS specifies the current position of the history. It defaults to the beginning position of the history." (if w3m-history-flat (let ((flat w3m-history-flat) element positions rest position) (setq w3m-history (list (list nil nil))) (while (setq element (pop flat)) (setq positions (caddr element) rest w3m-history) (while positions (setq position (pop positions)) (unless (> (length rest) position) (setcdr (nthcdr (1- (length rest)) rest) (make-list (- position (length rest) -1) (list nil nil)))) (setq rest (nth position rest)) (when positions (setq position (pop positions)) (unless (> (- (length rest) 2) position) (setcdr (nthcdr (1- (length rest)) rest) (make-list (- position (length rest) -3) (list (list nil nil))))) (setq rest (nth (+ position 2) rest)))) (setcar rest (car element)) (setcar (cdr rest) (cadr element))) (push 'dummy w3m-history) (w3m-history-set-current (or newpos (list 0))) w3m-history) (setq w3m-history nil))) (defun w3m-history-push (url &optional newprops replace) "Push URL into the history structure. A history which corresponds to URL becomes the current one. NEWPROPS is a plist which supplements URL. Return a new history position pointers. How this function behaves to the history structure (i.e., `w3m-history' and `w3m-history-flat') is controlled by the value of `w3m-history-reuse-history-elements'. The case where `w3m-history-reuse-history-elements' is nil: A new history element is always created. If there is another element corresponding to the same URL, its properties are inherited into the new history element. The case where `w3m-history-reuse-history-elements' is non-nil: If there is an element corresponding to URL in the history, it becomes the current history element. Otherwise, this function behaves like the case where `w3m-history-reuse-history-elements' is nil. If REPLACE is nil, NEWPROPS is merged into properties of the current history element. Otherwise, properties of the current history element are replaced with NEWPROPS." (let ((element (w3m-history-seek-element url newprops replace)) position class number branch) (if element (setcdr (cdr element) nil) (setq element (list url (w3m-history-modify-properties newprops nil)))) (cond ((null w3m-history) ;; The dawn of the history. (setq position (list nil (list 0) nil) w3m-history (list position element) w3m-history-flat (list (append element (list (list 0))))) position) ((and w3m-history-reuse-history-elements (setq position (caddr (w3m-history-assoc url)))) ;; Reuse the existing history element assigned to the current one. ;; The position pointers will be fixed with correct values after ;; visiting a page when moving back, moving forward or jumping from ;; the about://history/ page. (w3m-history-set-current position)) (t ;; Sprout a new history element. (setq position (copy-sequence (cadar w3m-history)) class (1- (length position)) number 0 branch (nthcdr (car position) (cdr w3m-history))) (while (> class number) (setq number (1+ number) branch (nth (nth number position) (cddar branch)) number (1+ number) branch (nthcdr (nth number position) branch))) (if (cdr branch) ;; We should sprout a new branch. (progn (setq number (1- (length (car branch)))) (setcdr (nthcdr class position) (list (1- number) 0)) (setcdr (nthcdr number (car branch)) (list (list element)))) ;; The current position is the last of the branch. (setcar (nthcdr class position) (1+ (car (nthcdr class position)))) (setcdr branch (list element))) (setq w3m-history-flat (nconc w3m-history-flat (list (append element (list position))))) (setcar w3m-history (list (cadar w3m-history) position nil)))))) (defun w3m-history-copy (buffer) "Copy the history structure from BUFFER to the current buffer. This function keeps corresponding elements identical Lisp objects between buffers while copying the frameworks of `w3m-history' and `w3m-history-flat'. Exceptionally, buffer-local properties contained in `w3m-history-flat' will not be copied except for the positions. If `w3m-history-minimize-in-new-session' is non-nil, the copied history structure will be shrunk so that it may contain only the current history element." (let ((current (current-buffer)) position flat element props window-start rest) (set-buffer buffer) (when w3m-history (setq position (copy-sequence (cadar w3m-history)) flat w3m-history-flat)) (set-buffer current) (when position (if w3m-history-minimize-in-new-session (progn (setq w3m-history-flat flat element (copy-sequence (w3m-history-element position t))) (setcdr (cdr element) nil) (setq w3m-history (list (list nil (list 0) nil) element) w3m-history-flat (list (append element (list (list 0)))))) ;; Remove buffer-local properties, except for the positions, ;; from the new `w3m-history-flat'. (while flat (setq element (copy-sequence (car flat)) flat (cdr flat) props (cdddr element) window-start (plist-get props :window-start)) (if window-start (setcdr (cddr element) (list :window-start window-start :position (plist-get props :position) :window-hscroll (plist-get props :window-hscroll))) (setcdr (cddr element) nil)) (push element rest)) (setq w3m-history-flat (nreverse rest)) (w3m-history-tree position))))) (defun w3m-history-plist-get (keyword &optional not-buffer-local) "Extract a value from the properties of the current history element. KEYWORD is usually a symbol. This function returns the value corresponding to KEYWORD, but it returns nil if the properties don't contain KEYWORD. If NOT-BUFFER-LOCAL is nil, this function searches a value in buffer-local properties, otherwise looks over the global properties instead." (let ((element (w3m-history-element (cadar w3m-history) t))) (plist-get (if not-buffer-local (cadr element) (cdddr element)) keyword))) (defun w3m-history-add-properties (newprops &optional not-buffer-local) "Add NEWPROPS to the properties of the current history element. NEWPROPS should be a plist, which is merged into the properties. Return new properties. If NOT-BUFFER-LOCAL is nil, NEWPROPS will be added to the buffer-local properties. Otherwise, NEWPROPS will be added to the global properties instead." (if not-buffer-local (cadr (w3m-history-seek-element (car (w3m-history-element (cadar w3m-history))) newprops)) (let ((element (w3m-history-element (cadar w3m-history) t)) properties) (if element (progn (setq properties (cdddr element) properties (if properties (w3m-history-modify-properties properties newprops) ;; Use `w3m-history-modify-properties' to remove ;; keyword-value pairs whose value is nil. (w3m-history-modify-properties newprops nil))) (unless (car properties) ;; check whether it is `(nil nil)'. (setq properties nil)) (setcdr (cddr element) properties)) (message "\ Warning: the history database in this session seems corrupted.") (sit-for 1) nil)))) (defun w3m-history-plist-put (keyword value &optional not-buffer-local) "Put KEYWORD and VALUE into the current history element. Return new properties. If NOT-BUFFER-LOCAL is nil, KEYWORD and VALUE will be put into the buffer-local properties. Otherwise, KEYWORD and VALUE will be put into the global properties instead." (w3m-history-add-properties (list keyword value) not-buffer-local)) (defun w3m-history-remove-properties (properties &optional not-buffer-local) "Remove PROPERTIES from the current history element. PROPERTIES should be one or more keyword-value pairs (i.e., plist) but values are ignored (treated as nil). Return new properties. If NOT-BUFFER-LOCAL is nil, the buffer-local properties will be modified. Otherwise, the global properties will be modified instead." (let (rest) (while properties (setq rest (cons nil (cons (car properties) rest)) properties (cddr properties))) (w3m-history-add-properties (nreverse rest) not-buffer-local))) (defun w3m-history-store-position () "Store the current cursor position into the current history element. Data consist of the position where the window starts and the cursor position. Naturally, those should be treated as buffer-local." (interactive) (when (cadar w3m-history) ;; Emacs lies about the column number in the results of ;; the functions `current-column', `window-hscroll', etc. if there ;; are images; it is likely larger than the position of the cursor ;; actually visible, and restoring it causes h-scrolling too much. ;; So, we store the position of an image if the cursor follows. (let ((column (current-column)) (hscroll (window-hscroll)) pos) (when (cond ((bobp) nil) ((get-text-property (point) 'w3m-image) nil) ((get-text-property (1-(point)) 'w3m-image) (goto-char (1- (point)))) ((setq pos (previous-single-property-change (point) 'w3m-image nil (point-at-bol))) (unless (= pos (point-at-bol)) (goto-char (1- pos))))) (setq pos (current-column)) (move-to-column column) (setq hscroll (max (- hscroll (- column pos)) 0) column pos)) (w3m-history-add-properties (list :window-start (window-start) :position (cons (count-lines (point-min) (point-at-bol)) column) :window-hscroll hscroll))) (when (w3m-interactive-p) (message "The current cursor position saved")))) (defun w3m-history-restore-position () "Restore the saved cursor position in the page. Even if the page has been shrunk (by reloading, for example), somehow it works although it may not be perfect." (interactive) (when (cadar w3m-history) (let ((start (w3m-history-plist-get :window-start)) position window) (cond ((and start (setq position (w3m-history-plist-get :position))) (when (<= start (point-max)) (goto-char (point-min)) (forward-line (car position)) (setq window (get-buffer-window (current-buffer) 'all-frames)) (when window (set-window-start window start) (set-window-hscroll window (or (w3m-history-plist-get :window-hscroll) 0))) (move-to-column (cdr position)) (let ((deactivate-mark nil)) (run-hooks 'w3m-after-cursor-move-hook)))) ((w3m-interactive-p) (message "No cursor position saved")))))) (defun w3m-history-minimize () "Minimize the history so that there may be the current page only." (interactive) (let ((position (cadar w3m-history)) element) (when position (setq element (w3m-history-element position t)) (setcar (cddr element) (list 0)) (setq w3m-history-flat (list element) w3m-history (list (list nil (list 0) nil) (list (car element) (cadr element))))))) (defun w3m-history-slimmed-history-flat () "Return slimmed history." (let ((position (cadar w3m-history)) flat-map new-flat) (dolist (l w3m-history-flat) (setq flat-map (cons (cons (nth 2 l) l) flat-map))) (setq new-flat (cons (cdr (assoc position flat-map)) nil)) (let ((pos (w3m-history-previous-position position))) (while pos (setq new-flat (cons (cdr (assoc pos flat-map)) new-flat)) (setq pos (w3m-history-previous-position pos)))) (let ((pos (w3m-history-next-position position))) (while pos (setq new-flat (cons (cdr (assoc pos flat-map)) new-flat)) (setq pos (w3m-history-next-position pos)))) new-flat)) (defun w3m-history-slim () "Slim the history. This makes the history slim so that it may have only the pages that are accessible by PREV and NEXT operations." (interactive) (let ((position (cadar w3m-history))) (setq w3m-history-flat (w3m-history-slimmed-history-flat)) (w3m-history-tree position))) (eval-when-compile (defvar w3m-arrived-db) (autoload 'w3m-goto-url "w3m")) (defun w3m-history-add-arrived-db () "Add the arrived database to the history structure unreasonably. This function is useless normally, so you may not want to use it. \(The reason it is here is because it is useful once in a while when debugging w3m-hist.el.)" (interactive) (unless (eq 'w3m-mode major-mode) (error "`%s' must be invoked from an emacs-w3m buffer" this-command)) (when (and w3m-arrived-db (prog1 (yes-or-no-p "Are you sure you really want to destroy the history? ") (message ""))) (setq w3m-history nil w3m-history-flat nil) (let ((w3m-history-reuse-history-elements t) url-title title) (mapatoms (lambda (symbol) (when symbol (if (setq title (get symbol 'title)) (push (list (symbol-name symbol) (list :title title)) url-title) (push (list (symbol-name symbol)) url-title)))) w3m-arrived-db) (apply 'w3m-history-push (nth (random (length url-title)) url-title)) (while url-title (w3m-history-push (car (nth (random (length w3m-history-flat)) w3m-history-flat))) (apply 'w3m-history-push (pop url-title)))) (w3m-goto-url "about://history/" t))) (provide 'w3m-hist) ;;; w3m-hist.el ends here w3m-el-snapshot-1.4.609+0.20171225.orig/w3m-bug.el0000644000000000000000000001432011335006354017131 0ustar rootroot;;; w3m-bug.el --- command to report emacs-w3m bugs -*- coding: euc-japan -*- ;; Copyright (C) 2002, 2003, 2005, 2007, 2010 ;; TSUCHIYA Masatoshi ;; Author: 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: ;; `M-x report-emacs-w3m-bug' starts an email note to the emacs-w3m ;; developers describing a problem. ;;; Code: (defvar report-emacs-w3m-bug-address "emacs-w3m@namazu.org" "*Address of mailing list for emacs-w3m bugs.") (defvar report-emacs-w3m-bug-no-explanations nil "*If non-nil, suppress the explanations given for the sake of novice users.") (defconst report-emacs-w3m-bug-system-informations (eval '`(emacs-w3m-version emacs-version ,@(if (or (boundp 'mule-version) (functionp 'mule-version)) '(mule-version)) ,@(cond ((featurep 'xemacs) '((featurep 'mule) (featurep 'file-coding))) ((or (boundp 'Meadow-version) (functionp 'Meadow-version)) '(Meadow-version))) system-type (featurep 'gtk) w3m-version w3m-type w3m-compile-options w3m-language w3m-command-arguments w3m-command-arguments-alist w3m-command-environment w3m-input-coding-system w3m-output-coding-system w3m-use-mule-ucs)) "List of the system informations. Users should NEVER modify the value." ;; For the developers: ;; It is possible that it would be a security hole. To prevent those ;; rogue attacks, this constant should be reloaded for each time to ;; send a bug report. Each element can be the symbol of a variable, ;; a Lisp function with no argument or any Lisp form to be evaluated. ) (eval-when-compile (require 'cl)) (defun report-emacs-w3m-bug (topic &optional buffer) "Report a bug in emacs-w3m. Prompts for bug subject. Leaves you in a mail buffer." (interactive (let* ((buffer (current-buffer)) (buffers (cons buffer (delq buffer (buffer-list)))) (inhibit-point-motion-hooks t) keymap) (save-current-buffer (while buffers (setq buffer (car buffers) buffers (cdr buffers)) (set-buffer buffer) (save-restriction (widen) (if (or (eq major-mode 'w3m-mode) (and (keymapp (setq keymap (or (get-text-property (max (1- (point-max)) (point-min)) 'keymap) (get-text-property (max (1- (point-max)) (point-min)) 'local-map))))) (where-is-internal 'w3m-print-current-url keymap)) (setq buffers nil) (setq buffer nil))))) (list (read-string "Bug Subject: ") buffer))) (let (after-load-alist) ;; See the comment for `report-emacs-w3m-bug-system-informations'. (load "w3m-bug")) (compose-mail report-emacs-w3m-bug-address topic nil 'new) (goto-char (point-min)) (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$")) (forward-line 1) (unless buffer (insert (if (and (boundp 'w3m-language) (equal (symbol-value 'w3m-language) "Japanese")) "もし可能なら emacs-w3m を起動してからやり直してください。\n" "It is if possible, please redo after starting emacs-w3m.\n") "\ ================================================================\n")) (unless report-emacs-w3m-bug-no-explanations ;; Insert warnings for the novice users. (if (and (boundp 'w3m-language) (equal (symbol-value 'w3m-language) "Japanese")) (progn (insert "このバグリポートは emacs-w3m 開発チームに送られます。\n") (put-text-property (point) (progn (insert "\ あなたのローカルサイトの管理者宛てではありません!!") (point)) 'face 'underline) (insert "\n\nできるだけ簡潔に述べてください: \t- 何が起きましたか? \t- 本当はどうなるべきだったと思いますか? \t- そのとき何をしましたか? (正確に) もし Lisp のバックトレースがあれば添付してください。\n")) (insert "\ This bug report will be sent to the emacs-w3m development team,\n") (put-text-property (point) (progn (insert " not to your local site managers!!") (point)) 'face 'italic) (insert "\nPlease write in ") (put-text-property (point) (progn (insert "simple") (point)) 'face 'italic) (insert " English, because the emacs-w3m developers aren't good at English reading. ;-) Please describe as succinctly as possible: \t- What happened. \t- What you thought should have happened. \t- Precisely what you were doing at the time. Please also include any Lisp back-traces that you may have.\n")) (insert "\ ================================================================\n")) (insert "Dear Bug Team!\n\n") (let ((user-point (point)) (print-escape-newlines t) (print-quoted t) infos print-length print-level) (insert "\n ================================================================ System Info to help track down your bug: ---------------------------------------\n") (with-current-buffer (or buffer (current-buffer)) (dolist (info report-emacs-w3m-bug-system-informations) (push (prin1-to-string info) infos) (push "\n => " infos) (push (cond ((functionp info) (prin1-to-string (condition-case code (funcall info) (error code)))) ((symbolp info) (prin1-to-string (condition-case code (symbol-value info) (error code)))) ((consp info) (prin1-to-string (condition-case code (eval info) (error code))))) infos) (push "\n" infos))) (apply 'insert (nreverse infos)) (goto-char user-point))) ;;; w3m-bug.el ends here w3m-el-snapshot-1.4.609+0.20171225.orig/w3m-cookie.el0000644000000000000000000005604013213222142017622 0ustar rootroot;;; w3m-cookie.el --- Functions for cookie processing ;; Copyright (C) 2002, 2003, 2005, 2006, 2008, 2009, 2010, 2017 ;; 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.") ;; Use `url-domsuf-cookie-allowed-p', if available (Emacs >= 24.3), ;; to check if a domain is unique to allow having cookies set. (eval-and-compile (ignore-errors (require 'url-domsuf))) (declare-function url-domsuf-cookie-allowed-p "url-domsuf") (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 dots in the domain name in order to set a cookie. This constant will never be used if url-domsuf.el(c) is available.") (defcustom w3m-cookie-accept-domains nil "A list of trusted domain name string." :group 'w3m :type '(repeat (string :format "Domain name: %v\n"))) (defcustom w3m-cookie-reject-domains nil "A list of untrusted domain name string." :group 'w3m :type '(repeat (string :format "Domain name: %v\n"))) (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) ;;; Cookie accessor. (defmacro w3m-cookie-url (cookie) "Return the url of COOKIE." `(aref ,cookie 0)) (defmacro w3m-cookie-domain (cookie) "Return the domain of COOKIE." `(aref ,cookie 1)) (defmacro w3m-cookie-secure (cookie) "Return whether COOKIE is secure." `(aref ,cookie 2)) (defmacro w3m-cookie-name (cookie) "Return the name of COOKIE." `(aref ,cookie 3)) (defmacro w3m-cookie-value (cookie) "Return the value of COOKIE." `(aref ,cookie 4)) (defmacro w3m-cookie-path (cookie) "Return the relative file path of COOKIE." `(aref ,cookie 5)) (defmacro w3m-cookie-version (cookie) "Return a version information of COOKIE." `(aref ,cookie 6)) (defmacro w3m-cookie-expires (cookie) "Return when COOKIE will expire." `(aref ,cookie 7)) (defmacro w3m-cookie-ignore (cookie) "Return t if COOKIE is marked to be ignored by emacs-w3m." `(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")) (nreverse 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) (cond ((string= host domain) ; Apparently netscape lets you do this t) ;; A special case that domain name is ".hostname". ((string= (concat "." host) domain) t) ((fboundp 'url-domsuf-cookie-allowed-p) (url-domsuf-cookie-allowed-p (if (eq (aref domain 0) ?.) (substring domain 1) domain))) ((let ((case-fold-search t) (numdots 0) last) (while (setq last (string-match "\\." domain last)) (setq numdots (1+ numdots) last (1+ last))) (>= numdots ; We have enough dots in domain name (if (string-match w3m-cookie-two-dot-domains-regexp domain) 2 3))) ;; 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 max-age path cookie) (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)) max-age (cdr-safe (w3m-assoc-ignore-case "max-age" args)) path (or (cdr-safe (w3m-assoc-ignore-case "path" args)) (file-name-directory (w3m-http-url-path http-url))) cookie (car args)) ;; Convert Max-Age to Expires (and max-age (setq max-age (ignore-errors (format-time-string "%a %b %d %H:%M:%S %Y GMT" (time-add nil (read max-age)) t))) (setq expires max-age)) (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 ;; 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 cookie))) (w3m-cookie-store (w3m-cookie-create :url url :domain domain :name (car cookie) :value (cdr cookie) :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." (interactive) (setq w3m-cookies nil) (dolist (buffer (w3m-list-buffers t)) (with-current-buffer buffer (when (equal w3m-current-url "about://cookie/") (let ((w3m-message-silent t)) (w3m-reload-this-page nil t)))))) (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 (&optional interactive-p) "Save cookies, and reset cookies' data." (interactive (list t)) ;; Don't error out no matter what happens ;; since `kill-emacs-hook' runs this function. (condition-case err (progn (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*")))) (error (if interactive-p (signal (car err) (cdr err)) (message "Error while running w3m-cookie-shutdown: %s" (error-message-string err)))))) (add-hook 'kill-emacs-hook 'w3m-cookie-shutdown) ;;;###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)))) value) ;; 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) (if (setq value (w3m-cookie-value cookie)) (concat (w3m-cookie-name cookie) "=" value) (w3m-cookie-name cookie))) cookies "; ")))) ;;;###autoload (defun w3m-cookie (&optional no-cache) "Display cookies and enable you to manage them." (interactive "P") (unless w3m-use-cookies (when (y-or-n-p "Use of cookies is currently disable. Enable? ") (setq w3m-use-cookies t))) (when w3m-use-cookies (w3m-goto-url-new-session "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. To delete all cookies associated with amazon.com for example, do it in the following two steps: 1. Mark them `unused' (type `C-c C-c' or press any OK button). Limit to [amazon.com ] <= [ ]regexp [OK] ( )Noop ( )Use all (*)Unuse all ( )Delete unused all [OK] 2. Delete cookies that are marked `unused'. Limit to [amazon.com ] <= [ ]regexp [OK] ( )Noop ( )Use all ( )Unuse all (*)Delete unused all [OK] You can mark cookies on the one-by-one basis of course. The `Limit-to' string is case insensitive and allows a regular expression." (w3m-cookie-setup) (let ((case-fold-search t) (pos 0) ;; The car is a string used to limit cookies to the ones matching, ;; and the cdr is a boolean flag that specifies whether the string ;; is a regexp or not. (match '(nil . nil)) delete dels cookies regexp) (when post-data (dolist (pair (split-string post-data "&")) (setq pair (split-string pair "=")) (w3m-static-if (fboundp 'pcase) (pcase (car pair) ("delete" (setq delete (cadr pair))) ("re-search" (setcdr match t)) ("search" (setcar match (replace-regexp-in-string "[\n\r].*" "" (w3m-url-decode-string (cadr pair))))) (_ (when (equal (cadr pair) "0") (push (string-to-number (car pair)) dels)))) (cond ((equal "delete" (car pair)) (setq delete (cadr pair))) ((equal "re-search" (car pair)) (setcdr match t)) ((equal "search" (car pair)) (setcar match (replace-regexp-in-string "[\n\r].*" "" (w3m-url-decode-string (cadr pair))))) (t (when (equal (cadr pair) "0") (push (string-to-number (car pair)) dels))))))) (if (zerop (length (car match))) (setq match nil cookies w3m-cookies) (setq regexp (car match)) (unless (cdr match) (setq regexp (regexp-quote regexp))) (dolist (cookie w3m-cookies) (when (string-match regexp (w3m-cookie-url cookie)) (push cookie cookies))) (setq cookies (nreverse cookies))) (w3m-static-if (fboundp 'pcase) (pcase delete ("0" (dolist (del dels) (setf (w3m-cookie-ignore (nth del cookies)) t))) ("1" (dolist (cookie cookies) (setf (w3m-cookie-ignore cookie) nil))) ("2" (dolist (cookie cookies) (setf (w3m-cookie-ignore cookie) t))) ("3" (progn (dolist (del dels) (setf (w3m-cookie-ignore (nth del cookies)) t)) (dolist (cookie cookies) (when (w3m-cookie-ignore cookie) (setq cookies (delq cookie cookies) w3m-cookies (delq cookie w3m-cookies))))))) (cond ((equal "0" delete) (dolist (del dels) (setf (w3m-cookie-ignore (nth del cookies)) t))) ((equal "1" delete) (dolist (cookie cookies) (setf (w3m-cookie-ignore cookie) nil))) ((equal "2" delete) (dolist (cookie cookies) (setf (w3m-cookie-ignore cookie) t))) ((equal "3" delete) (dolist (del dels) (setf (w3m-cookie-ignore (nth del cookies)) t)) (dolist (cookie cookies) (when (w3m-cookie-ignore cookie) (setq cookies (delq cookie cookies) w3m-cookies (delq cookie w3m-cookies))))))) (insert (concat ;; Allow nil values in operand. "Cookies
Cookies

Limit to  <= regexp 
Noop  Use all  Unuse all  Delete unused all 

    ")) (dolist (cookie cookies) (insert (concat ;; Allow nil values in operand. "

  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) "=" (or (w3m-cookie-value cookie) "(no value)") "
    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.609+0.20171225.orig/patches/0000755000000000000000000000000013224004712016750 5ustar rootrootw3m-el-snapshot-1.4.609+0.20171225.orig/patches/italic-text.patch0000644000000000000000000003527410536136732022246 0ustar rootroot--- w3m-0.5.1/file.c~ 2004-04-16 18:47:19 +0000 +++ w3m-0.5.1/file.c 2006-12-08 01:04:52 +0000 @@ -2301,6 +2301,7 @@ sizeof(obuf->anchor)); obuf->bp.img_alt = obuf->img_alt; obuf->bp.in_bold = obuf->in_bold; + obuf->bp.in_italic = obuf->in_italic; obuf->bp.in_under = obuf->in_under; obuf->bp.nobr_level = obuf->nobr_level; obuf->bp.prev_ctype = obuf->prev_ctype; @@ -2315,6 +2316,7 @@ sizeof(obuf->anchor)); obuf->img_alt = obuf->bp.img_alt; obuf->in_bold = obuf->bp.in_bold; + obuf->in_italic = obuf->bp.in_italic; obuf->in_under = obuf->bp.in_under; obuf->prev_ctype = obuf->bp.prev_ctype; obuf->pos = obuf->bp.pos; @@ -2337,6 +2339,7 @@ case HTML_IMG_ALT: case HTML_B: case HTML_U: + case HTML_I: push_link(obuf->tag_stack[i]->cmd, obuf->line->length, obuf->pos); break; } @@ -2551,7 +2554,7 @@ FILE *f = h_env->f; Str line = obuf->line, pass = NULL; char *hidden_anchor = NULL, *hidden_img = NULL, *hidden_bold = NULL, - *hidden_under = NULL, *hidden = NULL; + *hidden_under = NULL, *hidden_italic = NULL, *hidden = NULL; #ifdef DEBUG if (w3m_debug) { @@ -2589,6 +2592,12 @@ hidden = hidden_bold; } } + if (obuf->in_italic) { + if ((hidden_italic = has_hidden_link(obuf, HTML_I)) != NULL) { + if (!hidden || hidden_italic < hidden) + hidden = hidden_italic; + } + } if (obuf->in_under) { if ((hidden_under = has_hidden_link(obuf, HTML_U)) != NULL) { if (!hidden || hidden_under < hidden) @@ -2618,6 +2627,8 @@ Strcat_charp(line, ""); if (obuf->in_bold && !hidden_bold) Strcat_charp(line, ""); + if (obuf->in_italic && !hidden_italic) + Strcat_charp(line, ""); if (obuf->in_under && !hidden_under) Strcat_charp(line, ""); @@ -2822,6 +2833,8 @@ } if (!hidden_bold && obuf->in_bold) push_tag(obuf, "", HTML_B); + if (!hidden_italic && obuf->in_italic) + push_tag(obuf, "", HTML_I); if (!hidden_under && obuf->in_under) push_tag(obuf, "", HTML_U); } @@ -2934,6 +2947,8 @@ obuf->fontstat_sp++; if (obuf->in_bold) push_tag(obuf, "", HTML_N_B); + if (obuf->in_italic) + push_tag(obuf, "", HTML_N_I); if (obuf->in_under) push_tag(obuf, "", HTML_N_U); bzero(obuf->fontstat, FONTSTAT_SIZE); @@ -2949,6 +2964,8 @@ FONTSTAT_SIZE); if (obuf->in_bold) push_tag(obuf, "", HTML_B); + if (obuf->in_italic) + push_tag(obuf, "", HTML_I); if (obuf->in_under) push_tag(obuf, "", HTML_U); } @@ -4104,6 +4121,20 @@ return 0; } return 1; + case HTML_I: + obuf->in_italic++; + if (obuf->in_italic > 1) + return 1; + return 0; + case HTML_N_I: + if (obuf->in_italic == 1 && close_effect0(obuf, HTML_I)) + obuf->in_italic = 0; + if (obuf->in_italic > 0) { + obuf->in_italic--; + if (obuf->in_italic == 0) + return 0; + } + return 1; case HTML_U: obuf->in_under++; if (obuf->in_under > 1) @@ -4119,9 +4150,15 @@ } return 1; case HTML_EM: - HTMLlineproc1("", h_env); + HTMLlineproc1("", h_env); return 1; case HTML_N_EM: + HTMLlineproc1("", h_env); + return 1; + case HTML_STRONG: + HTMLlineproc1("", h_env); + return 1; + case HTML_N_STRONG: HTMLlineproc1("", h_env); return 1; case HTML_Q: @@ -4934,7 +4971,7 @@ static int out_size = 0; Anchor *a_href = NULL, *a_img = NULL, *a_form = NULL; char *p, *q, *r, *s, *t, *str; - Lineprop mode, effect; + Lineprop mode, effect, ex_effect; int pos; int nlines; #ifdef DEBUG @@ -4981,6 +5018,7 @@ #endif effect = 0; + ex_effect = 0; nlines = 0; while ((line = feed()) != NULL) { #ifdef DEBUG @@ -5005,7 +5043,7 @@ while (str < endp) { PSIZE; mode = get_mctype(str); - if (effect & PC_SYMBOL && *str != '<') { + if ((effect | ex_effect) & PC_SYMBOL && *str != '<') { #ifdef USE_M17N char **buf = set_symbol(symbol_width0); int len; @@ -5013,16 +5051,16 @@ p = buf[(int)symbol]; len = get_mclen(p); mode = get_mctype(p); - PPUSH(mode | effect, *(p++)); + PPUSH(mode | effect | ex_effect, *(p++)); if (--len) { mode = (mode & ~PC_WCHAR1) | PC_WCHAR2; while (len--) { PSIZE; - PPUSH(mode | effect, *(p++)); + PPUSH(mode | effect | ex_effect, *(p++)); } } #else - PPUSH(PC_ASCII | effect, SYMBOL_BASE + symbol); + PPUSH(PC_ASCII | effect | ex_effect, SYMBOL_BASE + symbol); #endif str += symbol_width; } @@ -5031,12 +5069,12 @@ #else else if (mode == PC_CTRL || IS_INTSPACE(*str)) { #endif - PPUSH(PC_ASCII | effect, ' '); + PPUSH(PC_ASCII | effect | ex_effect, ' '); str++; } #ifdef USE_M17N else if (mode & PC_UNKNOWN) { - PPUSH(PC_ASCII | effect, ' '); + PPUSH(PC_ASCII | effect | ex_effect, ' '); str += get_mclen(str); } #endif @@ -5044,13 +5082,13 @@ #ifdef USE_M17N int len = get_mclen(str); #endif - PPUSH(mode | effect, *(str++)); + PPUSH(mode | effect | ex_effect, *(str++)); #ifdef USE_M17N if (--len) { mode = (mode & ~PC_WCHAR1) | PC_WCHAR2; while (len--) { PSIZE; - PPUSH(mode | effect, *(str++)); + PPUSH(mode | effect | ex_effect, *(str++)); } } #endif @@ -5068,12 +5106,12 @@ #else if (mode == PC_CTRL || IS_INTSPACE(*str)) { #endif - PPUSH(PC_ASCII | effect, ' '); + PPUSH(PC_ASCII | effect | ex_effect, ' '); p++; } #ifdef USE_M17N else if (mode & PC_UNKNOWN) { - PPUSH(PC_ASCII | effect, ' '); + PPUSH(PC_ASCII | effect | ex_effect, ' '); p += get_mclen(p); } #endif @@ -5081,13 +5119,13 @@ #ifdef USE_M17N int len = get_mclen(p); #endif - PPUSH(mode | effect, *(p++)); + PPUSH(mode | effect | ex_effect, *(p++)); #ifdef USE_M17N if (--len) { mode = (mode & ~PC_WCHAR1) | PC_WCHAR2; while (len--) { PSIZE; - PPUSH(mode | effect, *(p++)); + PPUSH(mode | effect | ex_effect, *(p++)); } } #endif @@ -5106,6 +5144,12 @@ case HTML_N_B: effect &= ~PE_BOLD; break; + case HTML_I: + ex_effect |= PE_EX_ITALIC; + break; + case HTML_N_I: + ex_effect &= ~PE_EX_ITALIC; + break; case HTML_U: effect |= PE_UNDER; break; @@ -6347,6 +6391,7 @@ bzero((void *)&obuf->anchor, sizeof(obuf->anchor)); obuf->img_alt = 0; obuf->in_bold = 0; + obuf->in_italic = 0; obuf->in_under = 0; obuf->prev_ctype = PC_ASCII; obuf->tag_sp = 0; @@ -6382,6 +6427,10 @@ push_tag(obuf, "", HTML_N_B); obuf->in_bold = 0; } + if (obuf->in_italic) { + push_tag(obuf, "", HTML_N_I); + obuf->in_italic = 0; + } if (obuf->in_under) { push_tag(obuf, "", HTML_N_U); obuf->in_under = 0; --- w3m-0.5.1/fm.h~ 2004-04-16 18:47:19 +0000 +++ w3m-0.5.1/fm.h 2006-12-08 01:04:52 +0000 @@ -166,6 +166,9 @@ #define PE_ACTIVE 0x80 #define PE_VISITED 0x4000 +/* Extra effect */ +#define PE_EX_ITALIC PE_BOLD + #define CharType(c) ((c)&P_CHARTYPE) #define CharEffect(c) ((c)&(P_EFFECT|PC_SYMBOL)) #define SetCharType(v,c) ((v)=(((v)&~P_CHARTYPE)|(c))) @@ -535,7 +538,7 @@ #define FONT_STACK_SIZE 5 -#define FONTSTAT_SIZE 4 +#define FONTSTAT_SIZE 5 #define _INIT_BUFFER_WIDTH (COLS - (showLineNum ? 6 : 1)) #define INIT_BUFFER_WIDTH ((_INIT_BUFFER_WIDTH > 0) ? _INIT_BUFFER_WIDTH : 0) @@ -583,7 +586,8 @@ #define in_bold fontstat[0] #define in_under fontstat[1] -#define in_stand fontstat[2] +#define in_italic fontstat[2] +#define in_stand fontstat[3] #define RB_PRE 0x01 #define RB_SCRIPT 0x02 --- w3m-0.5.1/html.c~ 2003-09-26 20:48:21 +0000 +++ w3m-0.5.1/html.c 2006-12-08 01:04:52 +0000 @@ -231,34 +231,44 @@ {"/s", NULL, 0, TFLG_END}, /* 106 HTML_N_S */ {"q", NULL, 0, 0}, /* 107 HTML_Q */ {"/q", NULL, 0, TFLG_END}, /* 108 HTML_N_Q */ - {NULL, NULL, 0, 0}, /* 109 Undefined */ + {"i", NULL, 0, 0}, /* 109 HTML_I */ + {"/i", NULL, 0, TFLG_END}, /* 110 HTML_N_I */ + {"strong", NULL, 0, 0}, /* 111 HTML_STRONG */ + {"/strong", NULL, 0, TFLG_END}, /* 112 HTML_N_STRONG */ + {NULL, NULL, 0, 0}, /* 113 Undefined */ + {NULL, NULL, 0, 0}, /* 114 Undefined */ + {NULL, NULL, 0, 0}, /* 115 Undefined */ + {NULL, NULL, 0, 0}, /* 116 Undefined */ + {NULL, NULL, 0, 0}, /* 117 Undefined */ + {NULL, NULL, 0, 0}, /* 118 Undefined */ + {NULL, NULL, 0, 0}, /* 119 Undefined */ /* pseudo tag */ - {"select_int", ALST_SELECT_INT, MAXA_SELECT_INT, TFLG_INT}, /* 110 HTML_SELECT_INT */ - {"/select_int", NULL, 0, TFLG_INT | TFLG_END}, /* 111 HTML_N_SELECT_INT */ - {"option_int", ALST_OPTION, MAXA_OPTION, TFLG_INT}, /* 112 HTML_OPTION_INT */ - {"textarea_int", ALST_TEXTAREA_INT, MAXA_TEXTAREA_INT, TFLG_INT}, /* 113 HTML_TEXTAREA_INT */ - {"/textarea_int", NULL, 0, TFLG_INT | TFLG_END}, /* 114 HTML_N_TEXTAREA_INT */ - {"table_alt", ALST_TABLE_ALT, MAXA_TABLE_ALT, TFLG_INT}, /* 115 HTML_TABLE_ALT */ - {"symbol", ALST_SYMBOL, MAXA_SYMBOL, TFLG_INT}, /* 116 HTML_SYMBOL */ - {"/symbol", NULL, 0, TFLG_INT | TFLG_END}, /* 117 HTML_N_SYMBOL */ - {"pre_int", NULL, 0, TFLG_INT}, /* 118 HTML_PRE_INT */ - {"/pre_int", NULL, 0, TFLG_INT | TFLG_END}, /* 119 HTML_N_PRE_INT */ - {"title_alt", ALST_TITLE_ALT, MAXA_TITLE_ALT, TFLG_INT}, /* 120 HTML_TITLE_ALT */ - {"form_int", ALST_FORM_INT, MAXA_FORM_INT, TFLG_INT}, /* 121 HTML_FORM_INT */ - {"/form_int", NULL, 0, TFLG_INT | TFLG_END}, /* 122 HTML_N_FORM_INT */ - {"dl_compact", NULL, 0, TFLG_INT}, /* 123 HTML_DL_COMPACT */ - {"input_alt", ALST_INPUT_ALT, MAXA_INPUT_ALT, TFLG_INT}, /* 124 HTML_INPUT_ALT */ - {"/input_alt", NULL, 0, TFLG_INT | TFLG_END}, /* 125 HTML_N_INPUT_ALT */ - {"img_alt", ALST_IMG_ALT, MAXA_IMG_ALT, TFLG_INT}, /* 126 HTML_IMG_ALT */ - {"/img_alt", NULL, 0, TFLG_INT | TFLG_END}, /* 127 HTML_N_IMG_ALT */ - {" ", ALST_NOP, MAXA_NOP, TFLG_INT}, /* 128 HTML_NOP */ - {"pre_plain", NULL, 0, TFLG_INT}, /* 129 HTML_PRE_PLAIN */ - {"/pre_plain", NULL, 0, TFLG_INT | TFLG_END}, /* 130 HTML_N_PRE_PLAIN */ - {"internal", NULL, 0, TFLG_INT}, /* 131 HTML_INTERNAL */ - {"/internal", NULL, 0, TFLG_INT | TFLG_END}, /* 132 HTML_N_INTERNAL */ - {"div_int", ALST_P, MAXA_P, TFLG_INT}, /* 133 HTML_DIV_INT */ - {"/div_int", NULL, 0, TFLG_INT | TFLG_END}, /* 134 HTML_N_DIV_INT */ + {"select_int", ALST_SELECT_INT, MAXA_SELECT_INT, TFLG_INT}, /* 120 HTML_SELECT_INT */ + {"/select_int", NULL, 0, TFLG_INT | TFLG_END}, /* 121 HTML_N_SELECT_INT */ + {"option_int", ALST_OPTION, MAXA_OPTION, TFLG_INT}, /* 122 HTML_OPTION_INT */ + {"textarea_int", ALST_TEXTAREA_INT, MAXA_TEXTAREA_INT, TFLG_INT}, /* 123 HTML_TEXTAREA_INT */ + {"/textarea_int", NULL, 0, TFLG_INT | TFLG_END}, /* 124 HTML_N_TEXTAREA_INT */ + {"table_alt", ALST_TABLE_ALT, MAXA_TABLE_ALT, TFLG_INT}, /* 125 HTML_TABLE_ALT */ + {"symbol", ALST_SYMBOL, MAXA_SYMBOL, TFLG_INT}, /* 126 HTML_SYMBOL */ + {"/symbol", NULL, 0, TFLG_INT | TFLG_END}, /* 127 HTML_N_SYMBOL */ + {"pre_int", NULL, 0, TFLG_INT}, /* 128 HTML_PRE_INT */ + {"/pre_int", NULL, 0, TFLG_INT | TFLG_END}, /* 129 HTML_N_PRE_INT */ + {"title_alt", ALST_TITLE_ALT, MAXA_TITLE_ALT, TFLG_INT}, /* 130 HTML_TITLE_ALT */ + {"form_int", ALST_FORM_INT, MAXA_FORM_INT, TFLG_INT}, /* 131 HTML_FORM_INT */ + {"/form_int", NULL, 0, TFLG_INT | TFLG_END}, /* 132 HTML_N_FORM_INT */ + {"dl_compact", NULL, 0, TFLG_INT}, /* 133 HTML_DL_COMPACT */ + {"input_alt", ALST_INPUT_ALT, MAXA_INPUT_ALT, TFLG_INT}, /* 134 HTML_INPUT_ALT */ + {"/input_alt", NULL, 0, TFLG_INT | TFLG_END}, /* 135 HTML_N_INPUT_ALT */ + {"img_alt", ALST_IMG_ALT, MAXA_IMG_ALT, TFLG_INT}, /* 136 HTML_IMG_ALT */ + {"/img_alt", NULL, 0, TFLG_INT | TFLG_END}, /* 137 HTML_N_IMG_ALT */ + {" ", ALST_NOP, MAXA_NOP, TFLG_INT}, /* 138 HTML_NOP */ + {"pre_plain", NULL, 0, TFLG_INT}, /* 139 HTML_PRE_PLAIN */ + {"/pre_plain", NULL, 0, TFLG_INT | TFLG_END}, /* 140 HTML_N_PRE_PLAIN */ + {"internal", NULL, 0, TFLG_INT}, /* 141 HTML_INTERNAL */ + {"/internal", NULL, 0, TFLG_INT | TFLG_END}, /* 142 HTML_N_INTERNAL */ + {"div_int", ALST_P, MAXA_P, TFLG_INT}, /* 143 HTML_DIV_INT */ + {"/div_int", NULL, 0, TFLG_INT | TFLG_END}, /* 144 HTML_N_DIV_INT */ }; TagAttrInfo AttrMAP[MAX_TAGATTR] = { --- w3m-0.5.1/html.h~ 2003-10-20 16:41:56 +0000 +++ w3m-0.5.1/html.h 2006-12-08 01:04:52 +0000 @@ -197,35 +197,39 @@ #define HTML_N_S 106 #define HTML_Q 107 #define HTML_N_Q 108 +#define HTML_I 109 +#define HTML_N_I 110 +#define HTML_STRONG 111 +#define HTML_N_STRONG 112 /* pseudo tag */ -#define HTML_SELECT_INT 110 -#define HTML_N_SELECT_INT 111 -#define HTML_OPTION_INT 112 -#define HTML_TEXTAREA_INT 113 -#define HTML_N_TEXTAREA_INT 114 -#define HTML_TABLE_ALT 115 -#define HTML_SYMBOL 116 -#define HTML_N_SYMBOL 117 -#define HTML_PRE_INT 118 -#define HTML_N_PRE_INT 119 -#define HTML_TITLE_ALT 120 -#define HTML_FORM_INT 121 -#define HTML_N_FORM_INT 122 -#define HTML_DL_COMPACT 123 -#define HTML_INPUT_ALT 124 -#define HTML_N_INPUT_ALT 125 -#define HTML_IMG_ALT 126 -#define HTML_N_IMG_ALT 127 -#define HTML_NOP 128 -#define HTML_PRE_PLAIN 129 -#define HTML_N_PRE_PLAIN 130 -#define HTML_INTERNAL 131 -#define HTML_N_INTERNAL 132 -#define HTML_DIV_INT 133 -#define HTML_N_DIV_INT 134 +#define HTML_SELECT_INT 120 +#define HTML_N_SELECT_INT 121 +#define HTML_OPTION_INT 122 +#define HTML_TEXTAREA_INT 123 +#define HTML_N_TEXTAREA_INT 124 +#define HTML_TABLE_ALT 125 +#define HTML_SYMBOL 126 +#define HTML_N_SYMBOL 127 +#define HTML_PRE_INT 128 +#define HTML_N_PRE_INT 129 +#define HTML_TITLE_ALT 130 +#define HTML_FORM_INT 131 +#define HTML_N_FORM_INT 132 +#define HTML_DL_COMPACT 133 +#define HTML_INPUT_ALT 134 +#define HTML_N_INPUT_ALT 135 +#define HTML_IMG_ALT 136 +#define HTML_N_IMG_ALT 137 +#define HTML_NOP 138 +#define HTML_PRE_PLAIN 139 +#define HTML_N_PRE_PLAIN 140 +#define HTML_INTERNAL 141 +#define HTML_N_INTERNAL 142 +#define HTML_DIV_INT 143 +#define HTML_N_DIV_INT 144 -#define MAX_HTMLTAG 135 +#define MAX_HTMLTAG 145 /* Tag attribute */ --- w3m-0.5.1/tagtable.tab~ 2003-09-22 21:02:22 +0000 +++ w3m-0.5.1/tagtable.tab 2006-12-08 01:04:52 +0000 @@ -21,8 +21,8 @@ br HTML_BR b HTML_B /b HTML_N_B -i HTML_NOP -/i HTML_NOP +i HTML_I +/i HTML_N_I tt HTML_NOP /tt HTML_NOP ul HTML_UL @@ -60,8 +60,8 @@ /kbd HTML_NOP samp HTML_NOP /samp HTML_NOP -strong HTML_EM -/strong HTML_N_EM +strong HTML_STRONG +/strong HTML_N_STRONG var HTML_NOP /var HTML_NOP address HTML_BR w3m-el-snapshot-1.4.609+0.20171225.orig/patches/dot-domain.patch0000644000000000000000000000077410536136732022047 0ustar rootroot--- w3m-0.5.1/cookie.c~ 2003-09-26 17:59:51 +0000 +++ w3m-0.5.1/cookie.c 2006-12-08 01:04:52 +0000 @@ -65,6 +65,13 @@ if (domain[1] == '\0' || contain_no_dots(host, domain_p)) return domain_p; } + /* + * special case for domainName = .hostName + * see nsCookieService.cpp in Firefox. + */ + else if (domain[0] == '.' && strcasecmp(host, &domain[1]) == 0) { + return host; + } /* [RFC 2109] s. 2, cases 2, 3 */ else { offset = (domain[0] != '.') ? 0 : strlen(host) - strlen(domain); w3m-el-snapshot-1.4.609+0.20171225.orig/patches/README0000644000000000000000000000214110536136732017641 0ustar rootrootYou can apply these patches to the released version of w3m in order to use some emacs-w3m functions that require the w3m functions under development. The patches listed here are lined in new order. * italic-text.patch This patch enables emacs-w3m to display italic text, was posted by Hiroyuki Ito in [w3m-dev 04185]. Formerly w3m simply stripped the ... tags in halfdump, so there was no way to display italic text by emacs-w3m. * dot-domain.patch This patch was first posted by Ren Lifeng in [emacs-w3m:08943] and improved by Hiroyuki Ito in [w3m-dev 04159] afterward. This enables the cookie to recognize that ".namazu.org" is a domain name of the hostname "namazu.org". * file-progress.patch This patch was posted by TSUCHIYA Masatoshi in [emacs-w3m:05823]. Because w3m that is applied this patch shows size of retrieved data asynchronously, this patch enables emacs-w3m to display status of retrieving process. Local Variables: mode: indented-text coding: ascii fill-column: 72 End: w3m-el-snapshot-1.4.609+0.20171225.orig/patches/file-progress.patch0000644000000000000000000000061110536136732022563 0ustar rootroot--- w3m-0.5.1/file.c~ 2004-04-16 18:47:19 +0000 +++ w3m-0.5.1/file.c 2006-12-08 01:04:52 +0000 @@ -6602,6 +6602,8 @@ if (src) Strfputs(lineBuf2, src); linelen += lineBuf2->length; + if (w3m_dump & DUMP_EXTRA) + printf("W3m-in-progress: %s\n", convert_size2(linelen, current_content_length, TRUE)); if (w3m_dump & DUMP_SOURCE) continue; showProgress(&linelen, &trbyte); w3m-el-snapshot-1.4.609+0.20171225.orig/icons30/0000755000000000000000000000000013224004712016577 5ustar rootrootw3m-el-snapshot-1.4.609+0.20171225.orig/icons30/state-00.xpm0000644000000000000000000000101707736774442020712 0ustar rootroot/* XPM */ static char *noname[] = { /* width height ncolors chars_per_pixel */ " 16 14 7 1", /* colors */ " c none", "# c #314030", "$ c #617f5f", "% c #485e47", "+ c #89b386", ". c #c4ffbf", "; c #b0e5ac", /* pixels */ " ", " ", " #### #### ", " %$#$# #$#$% ", "%%++$+$ $+$++%%", ";;;;+;+ +;+;;;;", "....+.+ +.+....", ";;;;+;+ +;+;;;;", "++++$;$ $;$++++", "%%%%#%# #%#%%%%", " %+#+# #+#+% ", " #### #### ", " ", " " }; w3m-el-snapshot-1.4.609+0.20171225.orig/icons30/open-up.xpm0000644000000000000000000000255507731754635020745 0ustar rootroot/* XPM */ static char *open-up[] = { /* width height num_colors chars_per_pixel */ " 32 30 9 1", /* colors */ ". c #b6b2b6 s backgroundToolBarColor", "# c #000000", "a c #efffc7", "b c #cfba96", "c c #f7ffbe", "d c #aeb2ae", "e c #a6a6a6", "f c #79b2f7", "g c #698eef", /* pixels */ "................................", "............#############.......", "...........#a#bccccccccc#dd.....", "..........#aa#bccccccccc#ed.....", ".........#a###bccccccccc#ed.....", ".........##bbbbccdcdddcc#ed.....", ".........#bccccccccccccc#ed.....", "......#..#cccccccccccccc#ed.....", "......##.#ccddccccddddcc#ed.....", "......#f##cccccccccccccc#ed.....", "...####gf#cccccccccccccc#ed.....", "...#fffggf#cdccddcccddcc#ed.....", "...#ggggggf#cccccccccccc#ed.....", "...#gggggg#ccccccccccccc#ed.....", "...####gg#ccddccddcdddcc#ed.....", "......#g##cccccccccccccc#ed.....", "......##.#cccccccccccccc#ed.....", "......#..#cccccccccccccc#ed.....", ".........#cccccccccccccc#ed.....", ".........################ed.....", "..........eeeeeeeeeeeeeeeed.....", ".......##.......................", "......#..#......................", ".....#....#.###...##..#.#.......", ".....#....#.#..#.#..#.##.#......", ".....#....#.#..#.####.#..#......", "......#..#..#..#.#....#..#......", ".......##...###...###.#..#......", "............#...................", "............#..................." }; w3m-el-snapshot-1.4.609+0.20171225.orig/icons30/state-10.xpm0000644000000000000000000000105507736774442020715 0ustar rootroot/* XPM */ static char *noname[] = { /* width height ncolors chars_per_pixel */ " 16 14 9 1", /* colors */ " c none", "# c #314030", "$ c #617F5F", "% c #485E47", "+ c #89B386", ". c #C4FFBF", "; c #B0E5AC", "! c #ff0000", "& c #ff7f7f", /* pixels */ " ", " &&!!!!&& ", " ####!!#### ", " %$#$#!!#$#$% ", "%%++$+$!!$+$++%%", ";;;;+;+!!+;+;;;;", "....+.+!!+.+....", ";;;;+;+!!+;+;;;;", "++++$;$!!$;$++++", "%%%%#%#!!#%#%%%%", " %+#+#!!#+#+% ", " ####!!#### ", " &&!!!!&& ", " " }; w3m-el-snapshot-1.4.609+0.20171225.orig/icons30/antenna-up.png0000644000000000000000000000051510556351575021375 0ustar rootrootPNG  IHDR"~!<&?PLTE恐8Iy｢q｢小墾08q焦iaΧ暁<:tRNS@聊fIDAT8豊听C0爻`Y-"Y{$Ums`w D4Ek.91[%,}o ▲C'!$来x臉*&K!Y#Q嚇0p拂M{m 褸5ht Pa掾,瞶Dqh%kd]6>nDHK~懾餝H盤*K@4DnIENDB`w3m-el-snapshot-1.4.609+0.20171225.orig/icons30/antenna-up.xpm0000644000000000000000000000314007731754635021417 0ustar rootroot/* XPM */ static char *antenna-up[] = { /* width height num_colors chars_per_pixel */ " 34 30 21 1", /* colors */ ". c #b6b2b6 s backgroundToolBarColor", "# c #fff749", "a c #000000", "b c #869661", "c c #96a679", "d c #b6c7be", "e c #303871", "f c #081018", "g c #8e9e69", "h c #8ea271", "i c #181c38", "j c #96aa86", "k c #9eae8e", "l c #000008", "m c #96aa9e", "n c #9eb296", "o c #a6b69e", "p c #a6baa6", "q c #8ea2c7", "r c #96bec7", "s c #aebeae", /* pixels */ "....##..##........................", ".....######.......................", "......#####.......................", ".......#..##......................", "...........#............aaa.......", ".............aaa......aabba.......", ".............acdae..aabbbaf.......", ".............aca..eeggggadf.......", "..............a.eahheeeadi........", "..............e.aeccccaddi........", "...............ejkejaaddl.........", "..............aekkkadddml.........", ".............anennaddmml..........", "............aooeaaddmlaa..........", "...........apppammmmlqqra.........", "..........assafmmmllqqqra.........", "..........aaaaaaal..aqqra.........", "....................aqqqra........", "...................aqqqqqra.......", "..................aqqqqqqqra......", "..................aaaaaaaaaa......", ".............a....................", "...a.........a....................", "...a...aaa..aaa..a..aaa..aaa..aa..", "..a.a..a..a..a..a.a.a..a.a..a...a.", "..aaa..a..a..a..aaa.a..a.a..a.aaa.", ".a...a.a..a..a..a...a..a.a..a.a.a.", ".a...a.a..a..a...aa.a..a.a..a.aa.a", "..................................", ".................................." }; w3m-el-snapshot-1.4.609+0.20171225.orig/icons30/parent-disabled.xpm0000644000000000000000000000252407731754635022414 0ustar rootroot/* XPM */ static char * parent_disabled_xpm[] = { " 32 30 12 1", " c #b6b2b6 s backgroundToolBarColor", "# c #606060", "a c #d7d7d7", "b c #c6c6c6", "c c #bebebe", "d c #b6b6b6", "e c #a9ada9", "f c #a1a5a1", "g c #999999", "h c #bebabe", "i c #898989", "j c #797979", /* pixels */ " ", " ", " ", " ", " ", " # ", " #a# ", " #aba# ", " #abbba# ", " #accccca# ", " #accccccca# ", " #addddddddda# ", " #####eeeee##### ", " hhhh#fffff#hhhh ", " #ggggg# ", " #iiiii# ", " #jjjjj# ", " ####### ", " hhhhhhh ", " ", " # # ", " # # ### ", " # # # # ", " # # # # ", " # # # # ", " ### ### ", " # ", " # ", " ", " "}; w3m-el-snapshot-1.4.609+0.20171225.orig/icons30/forward-up.xpm0000644000000000000000000000300507731754635021437 0ustar rootroot/* XPM */ static char * forward_up_xpm[] = { "34 30 15 1", " c #B6DAB2CAB6DA s backgroundToolBarColor", ". c #000000000000", "X c #C71BFFFF8617", "o c #5965F3CE0000", "O c #5144E79D0000", "+ c #4924DB6C0000", "@ c #4103CF3C0000", "# c #38E3C71B0000", "$ c #AEBAAAAAAEBA", "% c #28A2BAEA0000", "& c #8E388A288E38", "* c #2081AEBA0000", "= c #1861A2890000", "- c #10409A690000", "; c #08208E380000", " ", " ", " ", " . ", " .. ", " .X. ", " .oX. ", " ......OOX. ", " .XXXXX+++X. ", " .@@@@@@@@@X. ", " .##########X. $ ", " .%%%%%%%%%%.&$ ", " .*********.& ", " ......===.&$ ", " &&&&.--.&$ ", " .;.&$ ", " ..&$ ", " .& ", " & ", " ", " .... . ", " . . ", " . .. . .. . . .. . . ... ", " .... . . .. . . . . . .. . . ", " . . . . . . . ... . . . ", " . . . . . . . . . . . ", " . .. . . . .. .. ... ", " ", " ", " "}; w3m-el-snapshot-1.4.609+0.20171225.orig/icons30/parent-up.png0000644000000000000000000000034210556351575021240 0ustar rootrootPNG  IHDR $!PLTE恐YA 8I(Q?tRNS@聊foIDATc`!`Apr@S@PE 岑U(JVZI F )qqq66vqA(IKs//wKK@2sLTpA6b,xS?豼8` QpS@"WDl("'館L[荊N2鶚|]{+U=ZN_回X bA`f柑/ aY4l^IENDB`w3m-el-snapshot-1.4.609+0.20171225.orig/icons30/copy-up.png0000644000000000000000000000037310556351575020725 0ustar rootrootPNG  IHDR $PLTE恐暁荻ΖB璋tRNS@聊fIDAT 0 E-3 N猜+::駘Kpo@I ,]|>4^p儘&6(In xC1` NrBl尨偵ysd,#``dF_;@g`狆 蕨#蕚IENDB`w3m-el-snapshot-1.4.609+0.20171225.orig/icons30/forward-disabled.png0000644000000000000000000000042710556351575022542 0ustar rootrootPNG  IHDR"姿'-PLTE恐供ァyyy篤鴇松昇抄橋```忻廬5%tRNS@聊fIDAT(c`\!rC剳(\淹wo堯(}醺*E嫉`"^Ax$7 T皿 +a`9j4^CU>'x錢0Ex/頏^pD驀@( $pH!D@p  wx?”與IENDB`w3m-el-snapshot-1.4.609+0.20171225.orig/icons30/back-disabled.png0000644000000000000000000000042110556351575021770 0ustar rootrootPNG  IHDR $-PLTE恐供　yyy篤鴇松昇抄橋```忻彈ktRNS@聊fIDATc` \@笂 C}&p竡飮 ^z鉈$`/B "8/).稿@`$p $后7gD`8y a @@Ps8 @RSI]cv*t艸鎭2癲Ug A3p4]]PNM Q})=慍ld1*T.m`杭f崩觝NEB 瓏!(,b函噴Sq勞~]{7Wa醤_H切6 5p&ぉB 4?銜 h+YIENDB`w3m-el-snapshot-1.4.609+0.20171225.orig/icons30/history-up.xpm0000644000000000000000000000254507731754635021504 0ustar rootroot/* XPM */ static char * history_up_xpm[] = { /* width height num_colors chars_per_pixel */ " 34 30 4 1", /* colors */ " c #b6b2b6 s backgroundToolBarColor", "% c #6992cf", "# c #30009e", "$ c #000000", /* pixels */ " ", " ################# ", " #%%%%%%%%%%%%%%%# ", " ################# ", " ", " ################# ", " #%%%%%%%%%%%%%%%# ", " ################# ", " ", " ################# ", " #%%%%%%%%%%%%%%%# ", " ################# ", " ", " ################# ", " #%%%%%%%%%%%%%%%# ", " ################# ", " ", " #################", " #%%%%%%%%%%%%%%%#", " #################", " ", " $ $ $ $ ", " $ $ $ ", " $ $ $$ $$$ $$$ $$ $ $ $ $ ", " $$$$$ $ $ $ $ $ $$ $ $ ", " $ $ $ $$ $ $ $ $ $ $ ", " $ $ $ $ $ $ $ $ $$$ ", " $ $ $$$ $$$ $ $$ $ $ ", " $$ ", " "}; w3m-el-snapshot-1.4.609+0.20171225.orig/icons30/state-01.xpm0000644000000000000000000000102207736774442020707 0ustar rootroot/* XPM */ static char *noname[] = { /* width height num_colors chars_per_pixel */ " 16 14 7 1", /* colors */ " c none", "# c #403700", "$ c #7f6e00", "% c #5e5100", "+ c #b39b00", ". c #fffafa", "; c #e5c600", /* pixels */ " ", " ", " #### #### ", " %$#$# #$#$% ", "%%++$+$ $+$++%%", ";;;;+;+ +;+;;;;", "....+.+ +.+....", ";;;;+;+ +;+;;;;", "++++$;$ $;$++++", "%%%%#%# #%#%%%%", " %+#+# #+#+% ", " #### #### ", " ", " " }; w3m-el-snapshot-1.4.609+0.20171225.orig/icons30/back-up.xpm0000644000000000000000000000270507731754635020701 0ustar rootroot/* XPM */ static char * back_up_xpm[] = { "32 30 15 1", " c #B6DAB2CAB6DA s backgroundToolBarColor", ". c #000000000000", "X c #C71BFFFF8617", "o c #5965F3CE0000", "O c #5144E79D0000", "+ c #4924DB6C0000", "@ c #8E388A288E38", "# c #4103CF3C0000", "$ c #38E3C71B0000", "% c #28A2BAEA0000", "& c #2081AEBA0000", "* c #AEBAAAAAAEBA", "= c #1861A2890000", "- c #10409A690000", "; c #08208E380000", " ", " ", " ", " . ", " .. ", " .X. ", " .Xo. ", " .XOO...... ", " .X+++XXXXX.@ ", " .X#########.@ ", " .X$$$$$$$$$$.@ ", " @.%%%%%%%%%%.@ ", " @.&&&&&&&&&.@ ", " *@.===......@ ", " *@.--.@@@@@@ ", " *@.;. ", " *@.. ", " @. ", " @ ", " ", " .... . ", " . . . ", " . . .. .. . . ", " .... . . . . . . ", " . . ... . .. ", " . . . . . . . . ", " .... .. . .. . . ", " ", " ", " "}; w3m-el-snapshot-1.4.609+0.20171225.orig/icons30/reload-up.png0000644000000000000000000000044410556351575021220 0ustar rootrootPNG  IHDR $!PLTE狂eiQwvQ堪ex韄徐RtRNS@聊fIDATP 0 dG勲勦^ @& )I+hM}QlBP I黝 r舮DP /u?)<6Qu嶽鶩g{T!q 暸30)5BL)29|{O冖l呟^8k\I. 逝b4~hf&dcF孫XIDDUIENDB`w3m-el-snapshot-1.4.609+0.20171225.orig/icons30/weather-up.png0000644000000000000000000000045310556351575021411 0ustar rootrootPNG  IHDR z夛 c #69A69248E79D", "< c #69A68A28E79D", "1 c #965896589658", "2 c #AEBAAEBAAEBA", " .... ", " ..XXXX.. ", " .XoO+++Oo. ", " .Xo+@@#$%+o. ", " .Xo+$@@&&*$+o. ", " .XO%*=-;-=*%O. ", " .X+$&-:>:-&$+. ", " .X+#&;><>;&#+. ", " ..X$&-:>:-&$.. ", " .1.%*=-;-=*.1. ", " .2..*&&&..2.1 ", " .@@....22.11 ", " ..@@@2..11 ", " 1.....111 ", " 1..111111 ", " 1..1111 ", " 1..11 ", " 1..1 ", " 1..11 ", " @@.1 ", " ", " .... . . ", " . . ", " . . . . ... ", " .... . .. . . . ", " . . . . . . ", " . . . . . . ", " . . . . ... ", " ", " "}; w3m-el-snapshot-1.4.609+0.20171225.orig/icons30/state-10.png0000644000000000000000000000031210556351575020660 0ustar rootrootPNG  IHDRPLTE医H^Ga_1@0誄FtRNS@聊f]IDATc(rc,---pMh )gp hta``hdRJJBJJAVVAA67r把61dV@*#{aIENDB`w3m-el-snapshot-1.4.609+0.20171225.orig/icons30/weather-up.xpm0000644000000000000000000000302507731754635021434 0ustar rootroot/* XPM */ static char *weather-up[] = { /* width height num_colors chars_per_pixel */ " 32 30 20 1", /* colors */ ". c #b6b2b6 s backgroundToolBarColor", "# c #ffaa61", "a c #ffeb9e", "b c #ffdb96", "c c #ffc786", "d c #ffb679", "e c #ffa271", "f c #ff9269", "g c #ff7d61", "h c #ffffff", "i c #ff6d59", "j c #efefef", "k c #ff5951", "l c #dfdfdf", "m c #cfd3cf", "n c #bec3be", "o c #aeb2ae", "p c #9ea29e", "q c #969696", "r c #000000", /* pixels */ "................................", "............#...................", "............#...................", ".....#......#......#............", "......#....###....#.............", ".......##..###..##..............", ".......###.aaa.###..............", "........#bbbbbbb#...............", ".........ccccccc................", "......##ddddddddd##.............", "...#####eeeeeeeee#####..........", "......##fffffffff##.............", ".........gggggghhh..hhh..hhh....", "........#iiiiijjjjjjjjjjjjjjj...", ".......###.kklllllllllllllllll..", ".......##..##mmmmmmmmmmmmmmmmm..", "......#....##nnnnnnnnnnnnnnnnn..", ".....#......#ooooooooooooooooo..", "............#.ppppppppppppppp...", "............#..qqq..qqq..qqq....", "................................", "................r..r............", ".r..r..r........r..r............", ".r..r..r.r..rr.rrr.rrr...r..r.r.", ".r..r.r.r.r...r.r..r..r.r.r.rr..", "..rr.rr.rrr.rrr.r..r..r.rrr.r...", "..r..r..r...r.r.r..r..r.r...r...", "..r..r...rr.rr.r.r.r..r..rr.r...", "................................", "................................" }; w3m-el-snapshot-1.4.609+0.20171225.orig/icons30/db-history-up.png0000644000000000000000000000035110556351575022033 0ustar rootrootPNG  IHDR"姿'PLTE恐iI0J瓧tRNS@聊fIDAT(} D.?m"$qJ橙',&K踊<}9rR(■K\8hd[]''D<{9蹲sg+!塩TTP '$H粫M9焔簾r;H? ^%{wcIENDB`w3m-el-snapshot-1.4.609+0.20171225.orig/icons30/copy-up.xpm0000644000000000000000000000246707731754635020760 0ustar rootroot/* XPM */ static char *copy_up_xpm[] = { /* width height ncolors chars_per_pixel */ "32 30 7 1", /* colors */ " c #b6b2b6 s backgroundToolBarColor", "# c #000000", "a c #aeb2ae", "b c #c7ff86", "c c #f7ffbe", "d c #aeb2ae", "e c #a6a6a6", /* pixels */ " ", " #########ed ", " #ccccccc##ed ", " #ccccccc#c#ed ", " #caaaaac####ed ", " #cccccccccc#ed ", " #caaaaccccc#ed ", " #cccccccccc#ed ", " #ccccc#########ed ", " #c##cc#bbbbbbb##ed ", " #ccccc#bbbbbbb#b#ed ", " #ccccc#baaaaab####ed ", " #ccccc#bbbbbbbbbb#ed ", " #ccccc#baaaabbbbb#ed ", " #######bbbbbbbbbb#ed ", " eeeee#bbbbbbbbbb#ed ", " dddd#baaaaaaabb#ed ", " #bbbbbbbbbb#ed ", " #bbbbbbbbbb#ed ", " #bbbbbbbbbb#ed ", " #bbbbbbbbbb#ed ", " ############ed ", " eeeeeeeeeeeed ", " ### dddddddddddd ", " # # ## ### # # ", " # # # # # # # ", " # # # # # # # ", " # # # # # # ## ", " ### ## ### # ", " # # " }; w3m-el-snapshot-1.4.609+0.20171225.orig/icons30/reload-up.xpm0000644000000000000000000000261507731754635021247 0ustar rootroot/* XPM */ static char *reload-up[] = { /* width height num_colors chars_per_pixel */ " 32 30 11 1", /* colors */ ". c #b6b8b6 s backgroundToolBarColor", "# c #aeb4ae", "a c #000000", "b c #6580c9", "c c #6984d7", "d c #7788d7", "e c #768cdf", "f c #788fe7", "g c #6580e7", "h c #5195ef", "i c #5197f7", /* pixels */ "................................", "..............#aaaaa............", ".............aabbbbbaa..........", "............abbbbbbbbba.........", "...........accccaaacccca........", "..........#addda###addda#.......", "..........aeeea#####aeeea.......", "..........afffa#..aaafffaaa.....", "..........aaaaa....aggggga#.....", "......##a...........ahhha##.....", ".....##aia...........aia##......", "....##ahhha...........a##.......", "....#aggggga....aaaaa...........", "....aaafffaaa..#afffa...........", "......aeeea#####aeeea...........", "......#addda###addda#...........", ".......accccaaacccca............", "........abbbbbbbbba.............", ".........aabbbbbaa..............", "...........aaaaa#...............", "................................", "..aaaa.......a..............a...", "..a...a......a..............a...", "..a...a..aa..a..aa...aa...aaa...", "..aaaa..a..a.a.a..a.a..a.a..a...", "..a...a.aaaa.a.a..a..aaa.a..a...", "..a...a.a....a.a..a.a..a.a..a...", "..a...a..aaa.a..aa...aa.a.aaa...", "................................", "................................" }; w3m-el-snapshot-1.4.609+0.20171225.orig/icons30/forward-disabled.xpm0000644000000000000000000000301407731754635022562 0ustar rootroot/* XPM */ static char *forward-disabled[] = { /* width height num_colors chars_per_pixel */ " 34 30 15 1", /* colors */ ". c #b6b2b6 s backgroundToolBarColor", "# c #606060", "a c #d7d7d7", "b c #c6c6c6", "c c #bebebe", "d c #b6b6b6", "e c #a9ada9", "f c #a1a5a1", "g c #aeaaae", "h c #999999", "i c #bebabe", "j c #919191", "k c #898989", "l c #818181", "m c #797979", /* pixels */ "..................................", "..................................", "..................................", "................#.................", "................##................", "................#a#...............", "................#ba#..............", "...........######cca#.............", "...........#aaaaaddda#............", "...........#eeeeeeeeea#...........", "...........#ffffffffffa#.g........", "...........#hhhhhhhhhh#ig.........", "...........#jjjjjjjjj#i...........", "...........######kkk#ig...........", "............iiii#ll#ig............", "................#m#ig.............", "................##ig..............", "................#i................", "................i.................", "..................................", ".####..........................#..", ".#.............................#..", ".#.....##..#.##.#.#..##..#.#.###..", ".####.#..#.##.#.#.#.#..#.##.#..#..", ".#....#..#.#..#.#.#..###.#..#..#..", ".#....#..#.#...#.#..#..#.#..#..#..", ".#.....##..#...#.#...##.##...###..", "..................................", "..................................", ".................................." }; w3m-el-snapshot-1.4.609+0.20171225.orig/icons30/save-up.xpm0000644000000000000000000000261712507124426020723 0ustar rootroot/* XPM */ static char *save-up[] = { /* width height ncolors chars_per_pixel */ "32 30 15 1", /* colors */ " c #B3D6E3", ". c #EAFAFD", "X c #FDFEFF", "o c White", "O c #80CCD5", "+ c #5CB6CC", "@ c #B7E5F1", "# c #DEF4F9", "$ c #98D7E5", "% c #74CEE4", "& c #ABDDE9", "* c #54B2CC", "= c #D3F6FC", "- c #68C1D7", "B c Black", /* pixels */ "-+ +-", "* oooooooooooooooooooooooooo@. *", "* ooooooooooX..#$$ #XooooooX+@ *", "* oooooooX.=====++++- XoooooXo *", "* oooooo.=======++++++-#oooooo *", "* ooooo.========++++++++@ooooo *", "* oooo.=======#=OO-++++++@oooo *", "* ooo.=======.oooo#+++++++#ooo *", "* ooX========.oooo#+++++++OXoo *", "* oo#@=======.oooo#++++++-%@oo *", "* oo@@@@=====.oooo#++++-%%%$Xo *", "* o.@@@@@@===.oooo#++-%%%%%%#o *", "* o#@@@@@@@==.oooo#+-%%%%%%%=o *", "* o=@@@@@@@@@.oooo#%%%%%%%%%@o *", "* o=@@@@@@@==.oooo#$$%%%%%%%&o *", "* o=@@@@@@@XooooooooX$%%%%%%&o *", "* o=@@@@@@@#oooooooo@%%%%%%%@o *", "* o#@@@@@@@@.oooooo#%%%%%%%%=o *", "* o.@@@@@@&&@XooooX$$$%%%%%%.o *", "* oo@@@@oooo&@oooo@$$$$$%%%$oo *", "* oo#@@ooBBo&&#oo#$$$$$$$%%=oo *", "* ooX@&oBoooooooooooooo$$$&Xoo *", "* ooo.&oBoooBBooBoBooBoo$$.ooo *", "* oooo#ooBooooBoBoBoBoBo$=oooo *", "* ooooo#ooBoBBBoBoBoBBBo=ooooo *", "* ooooooooBoBoBoBoBoBooooooooo *", "* ooooooBBooBBoBoBoooBBooooooo *", "* oooooooooooooooooooooooooooo *", "* oooooooooooooooooooooooooooo *", "-+ +-" }; w3m-el-snapshot-1.4.609+0.20171225.orig/icons30/state-01.png0000644000000000000000000000027410556351575020667 0ustar rootrootPNG  IHDRPLTEn^Q綟@70%tRNS@聊fUIDATcp-- 田71!PQ農P%c窶WSccWV  q4 ePRJJqSSRbpQMMq B6.r)蔚)IENDB`w3m-el-snapshot-1.4.609+0.20171225.orig/icons30/spinner.gif0000644000000000000000000000067107756536161020775 0ustar rootrootGIF89a謂随階悶_q^^^GT^@@@桐09@! NETSCAPE2.0! ,cIifUb0pc$RA,B[Q澄@aBr`$@@` @Q0x .#XptB 0 $* ! ,cIifUb0(c$RA( G[Q@aBr`$`` P0x .#Y(tB 0 $* ! ,cIifUb0涜-c$RApB[Q叩@a Br`$C` S0x .#園,tB 0 $* ;w3m-el-snapshot-1.4.609+0.20171225.orig/icons30/db-history-up.xpm0000644000000000000000000000256707731754635022073 0ustar rootroot/* XPM */ static char * db_history_up_xpm[] = { /* width height num_colors chars_per_pixel */ " 34 30 5 1", /* colors */ " c #b6b2b6 s backgroundToolBarColor", "* c #fff749", "% c #6992cf", "# c #30009e", "$ c #000000", /* pixels */ " ", " ####################### ", " #%%%%%%%%%%%%%%%%%%## ", " ################### ", " ", " ################# ", " #%%%%%%%%%%%%%%%# ", " ################# ", " ", " ################### ", " #%%%%%%%%%%%%%%%%%%## ", "############################ ", "#****##*****# ", "##*##*##*###*################# ", " #*###*#*###*#%%%%%%%%%%%%%%%# ", " #*###*#****################## ", " #*###*#*###*# ", "##*##*##*###*############### ", "#****##*****#%%%%%%%%%%%## ", "######################## ", " ", " $ $ $ $ ", " $ $ $ ", " $ $ $$ $$$ $$$ $$ $ $ $ $ ", " $$$$$ $ $ $ $ $ $$ $ $ ", " $ $ $ $$ $ $ $ $ $ $ ", " $ $ $ $ $ $ $ $ $$$ ", " $ $ $$$ $$$ $ $$ $ $ ", " $$ ", " "}; w3m-el-snapshot-1.4.609+0.20171225.orig/icons30/back-disabled.xpm0000644000000000000000000000271507731754635022025 0ustar rootroot/* XPM */ static char *back-disabled[] = { /* width height num_colors chars_per_pixel */ " 32 30 15 1", /* colors */ ". c #b6b2b6 s backgroundToolBarColor", "# c #606060", "a c #d7d7d7", "b c #c6c6c6", "c c #bebebe", "d c #b6b6b6", "e c #bebabe", "f c #a9ada9", "g c #a1a1a1", "h c #999999", "i c #919191", "j c #aeaaae", "k c #898989", "l c #818181", "m c #797979", /* pixels */ "................................", "................................", "................................", "................#...............", "...............##...............", "..............#a#...............", ".............#ab#...............", "............#acc######..........", "...........#adddaaaaa#e.........", "..........#afffffffff#e.........", ".........#agggggggggg#e.........", ".........e#hhhhhhhhhh#e.........", "..........e#iiiiiiiii#e.........", "..........je#kkk######e.........", "...........je#ll#eeeeee.........", "............je#m#...............", ".............je##...............", "...............e#...............", "................e...............", "................................", "......####............#.........", "......#...#...........#.........", "......#...#..##...##..#..#......", "......####..#..#.#..#.#.#.......", "......#...#..###.#....##........", "......#...#.#..#.#..#.#.#.......", "......####...##.#.##..#..#......", "................................", "................................", "................................" }; w3m-el-snapshot-1.4.609+0.20171225.orig/w3m-ems.el0000644000000000000000000014375613127150703017157 0ustar rootroot;;; w3m-ems.el --- GNU Emacs stuff for emacs-w3m ;; Copyright (C) 2001-2013, 2016, 2017 TSUCHIYA Masatoshi ;; Authors: Yuuichi Teranishi , ;; TSUCHIYA Masatoshi , ;; 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 file contains GNU Emacs stuff that emacs-w3m uses. For more ;; detail about emacs-w3m, see: ;; ;; http://emacs-w3m.namazu.org/ ;; ;; We can use w3m-static- switches to make the byte code differ between ;; Emacs 2[12] and 2[34], if anything, it is impossible to share the byte ;; code with those versions of Emacsen. ;;; Code: (eval-when-compile (require 'cl)) (require 'w3m-util) (require 'w3m-proc) (require 'w3m-image) (require 'w3m-favicon) (require 'w3m-ccl) (require 'wid-edit) ;; Functions and variables which should be defined in the other module ;; at run-time. (eval-when-compile (defvar w3m-add-tab-number) (defvar w3m-coding-system) (defvar w3m-current-process) (defvar w3m-current-title) (defvar w3m-current-url) (defvar w3m-default-coding-system) (defvar w3m-display-inline-images) (defvar w3m-favicon-image) (defvar w3m-form-input-textarea-coding-system) (defvar w3m-form-use-fancy-faces) (defvar w3m-icon-directory) (defvar w3m-image-default-background) (defvar w3m-mode-map) (defvar w3m-modeline-process-status-on) (defvar w3m-new-session-in-background) (defvar w3m-process-queue) (defvar w3m-show-graphic-icons-in-header-line) (defvar w3m-show-graphic-icons-in-mode-line) (defvar w3m-toolbar) (defvar w3m-toolbar-buttons) (defvar w3m-use-favicon) (defvar w3m-use-header-line) (defvar w3m-use-header-line-title) (defvar w3m-use-tab) ;; `w3m-tab-move-right' calls the inline function `w3m-buffer-set-number' ;; which uses it. (defvar w3m-use-title-buffer-name) (defvar w3m-work-buffer-list) (defvar w3m-work-buffer-name) (autoload 'w3m-copy-buffer "w3m") (autoload 'w3m-delete-buffer "w3m") (autoload 'w3m-image-type "w3m") (autoload 'w3m-retrieve "w3m") (autoload 'w3m-select-buffer-update "w3m") (unless (fboundp 'image-animate) (defalias 'image-animate 'ignore) (defalias 'image-multi-frame-p 'ignore))) (eval-and-compile (unless (fboundp 'frame-current-scroll-bars) (defalias 'frame-current-scroll-bars 'ignore)) (unless (fboundp 'window-fringes) (defalias 'window-fringes 'ignore)) (unless (fboundp 'unencodable-char-position) (defalias 'unencodable-char-position 'ignore))) ;;; Coding system and charset. (defsubst w3m-find-coding-system (obj) "Return OBJ if it is a coding-system." (if (coding-system-p obj) obj)) (defun w3m-detect-coding-region (start end &optional priority-list) "Detect coding system of the text in the region between START and END. Return the first possible coding system. PRIORITY-LIST is a list of coding systems ordered by priority." (w3m-static-if (fboundp 'with-coding-priority) (with-coding-priority priority-list (car (detect-coding-region start end))) (let (category categories) (dolist (codesys priority-list) (setq category (coding-system-category codesys)) (unless (or (null category) (assq category categories)) (push (cons category codesys) categories))) (car (detect-coding-with-priority start end (nreverse categories)))))) (defun w3m-mule-unicode-p () "Check the existence as charsets of mule-unicode." (and (charsetp 'mule-unicode-0100-24ff) (charsetp 'mule-unicode-2500-33ff) (charsetp 'mule-unicode-e000-ffff))) (defalias 'w3m-make-ccl-coding-system (if (fboundp 'define-coding-system) (eval-when-compile (funcall (if (and (fboundp 'define-coding-system) (featurep 'bytecomp)) 'byte-compile 'identity) '(lambda (coding-system mnemonic docstring decoder encoder) "\ Define a new CODING-SYSTEM by CCL programs DECODER and ENCODER. CODING-SYSTEM, DECODER and ENCODER must be symbols. This function is an interface to `define-coding-system'." (define-coding-system coding-system docstring :mnemonic mnemonic :coding-type 'ccl :ccl-decoder decoder :ccl-encoder encoder)))) (eval-when-compile (funcall (if (featurep 'bytecomp) (lambda (form) (let ((byte-compile-warnings (if (or (get 'make-coding-system 'byte-obsolete-info) (eq (get 'make-coding-system 'byte-compile) 'byte-compile-obsolete)) (delq 'obsolete (copy-sequence (cond ((consp byte-compile-warnings) byte-compile-warnings) (byte-compile-warnings byte-compile-warning-types) (t nil)))) byte-compile-warnings))) (byte-compile form))) 'identity) '(lambda (coding-system mnemonic docstring decoder encoder) "\ Define a new CODING-SYSTEM by CCL programs DECODER and ENCODER. CODING-SYSTEM, DECODER and ENCODER must be symbols. This function is an interface to `make-coding-system'." (make-coding-system coding-system 4 mnemonic docstring (cons decoder encoder))))))) ;; For Emacsen of which the `mule-version' is 5.x, redefine the ccl ;; programs that been defined in w3m-ccl.el. (w3m-static-when (string-match "\\`5\\." mule-version) (let ((source ;; CCL program to convert multibyte char to ucs with emacs-unicode. `((if (r1 == ,(charset-id 'latin-iso8859-1)) ((r1 = (r0 + 128))) (if (r1 == ,(charset-id 'mule-unicode-0100-24ff)) ((r1 = ((((r0 & #x3f80) >> 7) - 32) * 96)) (r0 &= #x7f) (r1 += (r0 + 224))) ; 224 == -32 + #x0100 (if (r1 == ,(charset-id 'mule-unicode-2500-33ff)) ((r1 = ((((r0 & #x3f80) >> 7) - 32) * 96)) (r0 &= #x7f) (r1 += (r0 + 9440))) ; 9440 == -32 + #x2500 (if (r1 == ,(charset-id 'mule-unicode-e000-ffff)) ((r1 = ((((r0 & #x3f80) >> 7) - 32) * 96)) (r0 &= #x7f) (r1 += (r0 + 57312))) ; 57312 == -32 + #xe000 ,(if (fboundp 'ccl-compile-lookup-character) '((lookup-character utf-subst-table-for-encode r1 r0) (if (r7 == 0) ; lookup failed (r1 = #xfffd))) '((r1 = #xfffd))))))) (if (r1 == #xfffd) (write-repeat ?~) ; unknown character. (r0 = r1))))) (if (get 'utf-translation-table-for-encode 'translation-table-id) ;; Emacs 21.3 and later. (progn (eval `(define-ccl-program w3m-euc-japan-encoder '(4 (loop ,@w3m-ccl-write-euc-japan-character (translate-character utf-translation-table-for-encode r1 r0) ,@source ,@w3m-ccl-generate-ncr)))) (eval `(define-ccl-program w3m-iso-latin-1-encoder '(4 (loop ,@w3m-ccl-write-iso-latin-1-character (translate-character utf-translation-table-for-encode r1 r0) ,@source ,@w3m-ccl-generate-ncr))))) ;; Emacs 21.2 and earlier. (eval `(define-ccl-program w3m-euc-japan-encoder '(4 (loop ,@w3m-ccl-write-euc-japan-character ,@source ,@w3m-ccl-generate-ncr)))) (eval `(define-ccl-program w3m-iso-latin-1-encoder '(4 (loop ,@w3m-ccl-write-iso-latin-1-character ,@source ,@w3m-ccl-generate-ncr))))))) ;; This might be redefined by w3m-ucs.el. (defun w3m-ucs-to-char (codepoint) (or (decode-char 'ucs codepoint) ?~)) ;; Function which returns non-nil when the current display device can ;; show images inline. (defalias 'w3m-display-graphic-p 'display-images-p) (defun w3m-display-inline-images-p () "Returns non-nil when images can be displayed under the present circumstances." (and w3m-display-inline-images (display-images-p))) ;; Animation. (defcustom w3m-image-animate-seconds 10 "Animate images (if possible) for this many seconds. If nil, don't play the animation. If t, loop forever." :group 'w3m :type '(choice (integer :tag "Animate for (seconds)") (const :tag "Inhibit animation" nil) (const :tag "Animate forever" t))) (eval-and-compile (defalias 'w3m-image-multi-frame-p (if (fboundp 'image-multi-frame-p) (lambda (image) (cdr (image-multi-frame-p image))) 'image-animated-p))) (defun w3m-image-animate (image) "Start animating IMAGE if possible. Return IMAGE." (when (and (fboundp 'image-animate) w3m-image-animate-seconds (w3m-image-multi-frame-p image)) (image-animate image nil w3m-image-animate-seconds) ;; Reset an image to the initial one after playing the animation. ;; FIXME: Is there a better way? (when (numberp w3m-image-animate-seconds) (run-with-timer (1+ w3m-image-animate-seconds) nil (lambda (image) (image-animate image 0 0)) image))) image) (defun w3m-create-image (url &optional no-cache referer size handler) "Retrieve data from URL and create an image object. If optional argument NO-CACHE is non-nil, cache is not used. If second optional argument REFERER is non-nil, it is used as Referer: field. If third optional argument SIZE is non-nil, its car element is used as width and its cdr element is used as height." (if (not handler) (w3m-process-with-wait-handler (w3m-create-image url no-cache referer size handler)) (lexical-let ((cur (current-buffer)) (set-size size) (url url) image size) (w3m-process-do-with-temp-buffer (type (progn (set-buffer-multibyte nil) (w3m-retrieve url nil no-cache nil referer handler))) (goto-char (point-min)) (when (w3m-image-type-available-p (setq type (or (and (let (case-fold-search) (looking-at "\\(GIF8\\)\\|\\(\377\330\\)\\|\211PNG\r\n")) (cond ((match-beginning 1) 'gif) ((match-beginning 2) 'jpeg) (t 'png))) (w3m-image-type type)))) (setq image (create-image (buffer-string) type t :ascent 'center :background w3m-image-default-background)) (if (and w3m-resize-images set-size) (progn (set-buffer-multibyte t) (setq size (image-size image 'pixels)) (if (and (null (car set-size)) (cdr set-size)) (setcar set-size (/ (* (car size) (cdr set-size)) (cdr size)))) (if (and (null (cdr set-size)) (car set-size)) (setcdr set-size (/ (* (cdr size) (car set-size)) (car size)))) (if (or (not (eq (car size) (car set-size))) ; width is different (not (eq (cdr size) (cdr set-size)))) ; height is different (lexical-let ((image image)) (w3m-process-do (resized (w3m-resize-image (plist-get (cdr image) :data) (car set-size)(cdr set-size) handler)) (if resized (plist-put (cdr image) :data resized))))))) (with-current-buffer cur (w3m-image-animate image))))))) (defun w3m-create-resized-image (url rate &optional referer size handler) "Resize an cached image object. URL is the image file's url. RATE is resize percentage. If REFERER is non-nil, it is used as Referer: field. If SIZE is non-nil, its car element is used as width and its cdr element is used as height." (if (not handler) (w3m-process-with-wait-handler (w3m-create-image url nil referer size handler)) (lexical-let ((url url) (rate rate) image) (w3m-process-do-with-temp-buffer (type (progn (set-buffer-multibyte nil) (w3m-retrieve url nil nil nil referer handler))) (when (w3m-image-type-available-p (setq type (w3m-image-type type))) (setq image (create-image (buffer-string) type t :ascent 'center)) (progn (set-buffer-multibyte t) (w3m-process-do (resized (w3m-resize-image-by-rate (plist-get (cdr image) :data) rate handler)) (if resized (plist-put (cdr image) :data resized)) image))))))) (defun w3m-insert-image (beg end image &rest args) "Display image on the current buffer. Buffer string between BEG and END are replaced with IMAGE." (let ((faces (get-text-property beg 'face)) (idx 0) orig len face) (add-text-properties beg end (list 'display image 'intangible image 'invisible nil)) ;; Hide underlines behind inline images. ;; Gerd Moellmann , the maintainer of Emacs 21, wrote in ;; the article <86heyi7vks.fsf@gerd.segv.de> in the list emacs-pretest- ;; bug@gnu.org on 18 May 2001 that to show an underline of a text even ;; if it has an image as a text property is the feature of Emacs 21. ;; However, that behavior is not welcome to the w3m buffers, so we do ;; to fix it with the following stuffs. (when faces (unless (listp faces) (setq faces (list faces))) (setq orig (copy-sequence faces) len (length orig)) (while (< idx len) (when (face-underline-p (setq face (nth idx orig))) (setq faces (delq face faces))) (setq idx (1+ idx))) (when (< (length faces) len) (put-text-property beg end 'face faces) (put-text-property beg end 'w3m-faces-with-underline orig))))) (defun w3m-remove-image (beg end) "Remove an image which is inserted between BEG and END." (remove-text-properties beg end '(display nil intangible nil)) (let ((underline (get-text-property beg 'w3m-faces-with-underline))) (when underline (add-text-properties beg end (list 'face underline 'w3m-faces-with-underline nil))))) (defun w3m-image-type-available-p (image-type) "Return non-nil if an image with IMAGE-TYPE can be displayed inline." (and (display-images-p) (image-type-available-p image-type))) ;;; Form buttons (defface w3m-form-button '((((type x w32 mac ns) (class color)) :background "lightgrey" :foreground "black" :box (:line-width 2 :style released-button)) (((class color) (background light)) (:foreground "cyan" :underline t)) (((class color) (background dark)) (:foreground "red" :underline t)) (t (:underline t))) "*Face to fontify buttons in forms." :group 'w3m-face) ;; backward-compatibility alias (put 'w3m-form-button-face 'face-alias 'w3m-form-button) (defface w3m-form-button-mouse '((((type x w32 mac ns) (class color)) :background "DarkSeaGreen1" :foreground "black" :box (:line-width 2 :style released-button)) (((class color) (background light)) (:foreground "cyan" :underline t)) (((class color) (background dark)) (:foreground "red" :underline t)) (t (:underline t))) "*Face to fontify focused buttons in forms." :group 'w3m-face) ;; backward-compatibility alias (put 'w3m-form-button-mouse-face 'face-alias 'w3m-form-button-mouse) (defface w3m-form-button-pressed '((((type x w32 mac ns) (class color)) :background "lightgrey" :foreground "black" :box (:line-width 2 :style pressed-button)) (((class color) (background light)) (:foreground "cyan" :underline t)) (((class color) (background dark)) (:foreground "red" :underline t)) (t (:underline t))) "*Face to fontify pressed buttons in forms." :group 'w3m-face) ;; backward-compatibility alias (put 'w3m-form-button-pressed-face 'face-alias 'w3m-form-button-pressed) (defvar w3m-form-button-keymap (let ((map (copy-keymap widget-keymap))) (substitute-key-definition 'widget-forward nil map) (substitute-key-definition 'widget-backward nil map) map)) (define-widget 'w3m-form-button 'push-button "Widget for w3m form button." :keymap w3m-form-button-keymap :action (function (lambda (widget &optional e) (eval (widget-get widget :w3m-form-action))))) (defun w3m-form-make-button (start end properties &optional readonly) "Make button on the region from START to END." (cond (readonly (w3m-add-text-properties start end (append '(face w3m-form-inactive w3m-form-readonly t) properties))) (w3m-form-use-fancy-faces (unless (memq (face-attribute 'w3m-form-button :box) '(nil unspecified)) (and (eq ?\[ (char-after start)) (eq ?\] (char-before end)) (save-excursion (goto-char start) (delete-char 1) (insert " ") (goto-char end) (delete-char -1) (insert " ") (setq start (1+ start) end (1- end))))) ;; Empty text won't be buttonized, so we fill it with something. ;; "submit" seems to be a proper choice in nine cases out of ten. (when (= start end) (goto-char start) (insert "submit") (setq end (point))) (let ((w (widget-convert-button 'w3m-form-button start end :w3m-form-action (plist-get properties 'w3m-action)))) (overlay-put (widget-get w :button-overlay) 'evaporate t)) (add-text-properties start end properties)) (t (w3m-add-text-properties start end (append '(face w3m-form) properties))))) (defun w3m-setup-widget-faces () (make-local-variable 'widget-button-face) (make-local-variable 'widget-mouse-face) (make-local-variable 'widget-button-pressed-face) (setq widget-button-face 'w3m-form-button) (setq widget-mouse-face 'w3m-form-button-mouse) (setq widget-button-pressed-face 'w3m-form-button-pressed)) ;;; Menu bar (defun w3m-menu-on-forefront (arg &optional curbuf) "Place emacs-w3m menus on the forfront of the menu bar if ARG is non-nil. If CURBUF is given, this function works only in the current buffer, otherwise works in all the emacs-w3m buffers." (if curbuf (if arg (let ((items (mapcar 'car (cdr (lookup-key global-map [menu-bar]))))) (when items (set (make-local-variable 'menu-bar-final-items) items))) (kill-local-variable 'menu-bar-final-items)) (save-current-buffer (dolist (buffer (w3m-list-buffers t)) (set-buffer buffer) (w3m-menu-on-forefront arg t))))) ;;; Toolbar (defcustom w3m-use-toolbar (and (featurep 'tool-bar) ;; Emacs 22 and greater return t for `(featurep 'tool-bar)' ;; even if being launched with the -nw option. (display-images-p) (or (featurep 'gtk) (image-type-available-p 'xpm))) "Non-nil activates toolbar of w3m." :group 'w3m :type 'boolean) (defcustom w3m-toolbar-icon-preferred-image-types (if (featurep 'gtk) '(png) '(xpm)) "List of image types that you prefer to use for the tool bar icons. By default, `png' is most preferred for Emacs built with GTK and `xpm' is for others." :group 'w3m :type '(repeat (symbol :tag "Image type")) :set (lambda (symbol value) (prog1 (custom-set-default symbol value) (when (and (not noninteractive) (boundp 'w3m-toolbar-buttons)) (w3m-update-toolbars))))) (defcustom w3m-toolbar-use-single-image-per-icon nil "Non-nil means use single image (named *-up) per icon. If it is nil, subsidiaries, e.g., *-down and *-disabled, if any, are used together. Note that this option will be ignored if running Emacs built with Gtk+ and every button will use a single icon image." :group 'w3m :type 'boolean :set (lambda (symbol value) (prog1 (custom-set-default symbol value) (when (and (not noninteractive) (boundp 'w3m-toolbar-buttons)) (w3m-update-toolbars))))) (defcustom w3m-toolbar-configurations `((tool-bar-button-margin . global) ,@(unless (featurep 'gtk) '((tool-bar-button-relief . global)))) "Alist of the variables and the values controls the tool bar appearance. The value `global' means to use the global value of the variable. If you're annoyed with changing of the frame height of Emacs built for GTK because of the difference of the sizes between the emacs-w3m tool bar icons and the ones that Emacs natively uses, try customizing this variable or both the value of this variable and the global value of `tool-bar-button-margin'. For examples: ;; The case where the emacs-w3m icons are smaller than the others. \(setq w3m-toolbar-configurations '((tool-bar-button-margin . 5))) ;; The case where the emacs-w3m icons are bigger than the others. \(setq w3m-toolbar-configurations '((tool-bar-button-margin . 0)) tool-bar-button-margin 7)" :group 'w3m :type '(repeat (cons :format "%v" (symbol :tag "Variable") (radio :format "%v" (const :format "%v " global) (sexp :tag "Local Value")))) :set (lambda (symbol value) (prog1 (custom-set-default symbol value) (when (and (not noninteractive) (featurep 'w3m)) (w3m-toolbar-set-configurations))))) (defun w3m-toolbar-define-keys (keymap defs) ;; Invalidate the default bindings. (let ((keys (cdr (key-binding [tool-bar] t))) item) (unless (eq (caar keys) 'keymap) ;; Emacs >= 24 (while (setq item (pop keys)) (when (setq item (car-safe item)) (define-key keymap (vector 'tool-bar item) 'undefined))))) (let ((n (length defs)) def) (while (>= n 0) (setq n (1- n) def (nth n defs)) (define-key keymap (vector 'tool-bar (aref def 1)) (list 'menu-item (aref def 3) (aref def 1) :enable (aref def 2) :image (symbol-value (aref def 0))))))) (defun w3m-find-image (name &optional directory) "Find image file for NAME and return cons of file name and type. This function searches only in DIRECTORY, that defaults to the value of `w3m-icon-directory', for an image file of which the base name is NAME. Files of types that Emacs does not support are ignored." (unless directory (setq directory w3m-icon-directory)) (when (and directory (file-directory-p directory) (display-images-p)) (let* ((case-fold-search nil) (files (directory-files directory t (concat "\\`" (regexp-quote name) "\\."))) (types (append w3m-toolbar-icon-preferred-image-types image-types)) file type rest) (while files (when (string-match "\\.\\([^.]+\\)\\'" (setq file (pop files))) (setq type (intern (downcase (match-string 1 file)))) (setq type (or (cdr (assq type '((tif . tiff) (jpg . jpeg) (ps . postscript) (pgm . pbm) (ppm . pbm)))) type)) (push (cons file (memq type types)) rest))) (setq rest (car (sort rest (lambda (a b) (> (length a) (length b)))))) (when (cdr rest) (cons (car rest) (cadr rest)))))) (defun w3m-toolbar-make-buttons (buttons &optional force) (let ((xpm-props '(:color-symbols (("backgroundToolBarColor" . "None")))) button icon down disabled up) (while buttons (setq button (pop buttons) icon (intern (concat "w3m-toolbar-" button "-icon"))) (when (or force (not (boundp icon))) (setq down (w3m-find-image (concat button "-down")) disabled (w3m-find-image (concat button "-disabled"))) (if (setq up (or (w3m-find-image (concat button "-up")) (prog1 (or down disabled (w3m-find-image button)) (setq down nil disabled nil)))) (progn (setq up (apply 'create-image (car up) (cdr up) nil :ascent 'center (when (eq (cdr up) 'xpm) xpm-props))) (if (or (boundp 'gtk-version-string) w3m-toolbar-use-single-image-per-icon (not (or down disabled))) (set icon up) (when down (setq down (apply 'create-image (car down) (cdr down) nil :ascent 'center (when (eq (cdr up) 'xpm) xpm-props)))) (when disabled (setq disabled (apply 'create-image (car disabled) (cdr disabled) nil :ascent 'center (when (eq (cdr disabled) 'xpm) xpm-props)))) (set icon (vector down up disabled disabled)))) (error "Icon file %s-up.* not found" button)))))) (defun w3m-toolbar-set-configurations (&optional curbuf) "Set values of variables according to `w3m-toolbar-configurations'. If CURBUF is given, this function works only in the current buffer, otherwise works in all the emacs-w3m buffers." (if curbuf (dolist (config w3m-toolbar-configurations) (if (eq (cdr config) 'global) (kill-local-variable (car config)) (set (make-local-variable (car config)) (cdr config)))) (let ((cur (selected-frame)) buffer buffers) (walk-windows (lambda (window) (setq buffer (window-buffer window)) (unless (memq buffer buffers) (set-buffer buffer) (when (eq major-mode 'w3m-mode) (push buffer buffers) (select-frame (window-frame window)) ;;(set-buffer buffer) (w3m-toolbar-set-configurations t)))) 'ignore 'visible) (select-frame-set-input-focus cur) (save-current-buffer (dolist (buffer (w3m-list-buffers t)) (unless (memq buffer buffers) (set-buffer buffer) (w3m-toolbar-set-configurations t)))) (select-frame-set-input-focus cur)))) (defun w3m-setup-toolbar () (when (and w3m-use-toolbar (w3m-find-image "antenna-up")) (w3m-toolbar-make-buttons w3m-toolbar-buttons) (w3m-toolbar-set-configurations t) (w3m-toolbar-define-keys w3m-mode-map w3m-toolbar))) (defalias 'w3m-update-toolbar 'ignore) (defun w3m-update-toolbars () (when (and w3m-use-toolbar (w3m-find-image "antenna-up")) (w3m-toolbar-make-buttons w3m-toolbar-buttons t) (w3m-toolbar-set-configurations) (w3m-toolbar-define-keys w3m-mode-map w3m-toolbar))) ;;; Header line & Tabs (defcustom w3m-tab-width 16 "w3m tab width." :group 'w3m :set (lambda (symbol value) (custom-set-default symbol (if (and (numberp value) (> value 0)) value 16))) :type 'integer) (defface w3m-tab-unselected '((((type x w32 mac ns) (class color)) :background "Gray70" :foreground "Gray20" :box (:line-width -1 :style released-button)) (((class color)) (:background "blue" :foreground "black"))) "*Face to fontify unselected tabs." :group 'w3m-face) ;; backward-compatibility alias (put 'w3m-tab-unselected-face 'face-alias 'w3m-tab-unselected) (defface w3m-tab-unselected-retrieving '((((type x w32 mac ns) (class color)) :background "Gray70" :foreground "OrangeRed" :box (:line-width -1 :style released-button)) (((class color)) (:background "blue" :foreground "OrangeRed"))) "*Face to fontify unselected tabs which are retrieving their pages." :group 'w3m-face) ;; backward-compatibility alias (put 'w3m-tab-unselected-retrieving-face 'face-alias 'w3m-tab-unselected-retrieving) (defface w3m-tab-unselected-unseen '((((type x w32 mac ns) (class color)) :background "Gray70" :foreground "Gray20" :box (:line-width -1 :style released-button)) (((class color)) (:background "blue" :foreground "gray60"))) "*Face to fontify unselected and unseen tabs." :group 'w3m-face) ;; backward-compatibility alias (put 'w3m-tab-unselected-unseen-face 'face-alias 'w3m-tab-unselected-unseen) (defface w3m-tab-selected '((((type x w32 mac ns) (class color)) :background "Gray90" :foreground "black" :box (:line-width -1 :style released-button)) (((class color)) (:background "cyan" :foreground "black")) (t (:underline t))) "*Face to fontify selected tab." :group 'w3m-face) ;; backward-compatibility alias (put 'w3m-tab-selected-face 'face-alias 'w3m-tab-selected) (defface w3m-tab-selected-retrieving '((((type x w32 mac ns) (class color)) :background "Gray90" :foreground "red" :box (:line-width -1 :style released-button)) (((class color)) (:background "cyan" :foreground "red")) (t (:underline t))) "*Face to fontify selected tab which is retrieving its page." :group 'w3m-face) ;; backward-compatibility alias (put 'w3m-tab-selected-retrieving-face 'face-alias 'w3m-tab-selected-retrieving) (defface w3m-tab-background '((((type x w32 mac ns) (class color)) :background "LightSteelBlue" :foreground "black") (((class color)) (:background "white" :foreground "black"))) "*Face to fontify background of tab line." :group 'w3m-face) ;; backward-compatibility alias (put 'w3m-tab-background-face 'face-alias 'w3m-tab-background) (defface w3m-tab-selected-background '((((type x w32 mac ns) (class color)) :background "LightSteelBlue" :foreground "black") (((class color)) (:background "white" :foreground "black"))) "*Face to fontify selected background tab." :group 'w3m-face) ;; backward-compatibility alias (put 'w3m-tab-selected-background-face 'face-alias 'w3m-tab-selected-background) (defface w3m-tab-mouse '((((type x w32 mac ns) (class color)) :background "Gray75" :foreground "white" :box (:line-width -1 :style released-button))) "*Face used to highlight tabs under the mouse." :group 'w3m-face) ;; backward-compatibility alias (put 'w3m-tab-mouse-face 'face-alias 'w3m-tab-mouse) (defvar w3m-modeline-spinner-map nil "Keymap used on the spinner in the mode-line.") (defvar w3m-spinner-map-help-echo "mouse-2 kills the current process" "String used for the :help-echo property on the spinner.") (defun w3m-setup-header-line () (setq header-line-format (cond (w3m-use-tab '(:eval (w3m-tab-line))) (w3m-use-header-line (list (if w3m-use-header-line-title (list (propertize "Title: " 'face (list 'w3m-header-line-location-title)) `(:eval (propertize (replace-regexp-in-string "%" "%%" (w3m-current-title)) 'face (list 'w3m-header-line-location-content) 'mouse-face '(highlight :foreground ,(face-foreground 'default)) 'local-map (let ((map (make-sparse-keymap))) (define-key map [header-line mouse-2] 'w3m-goto-url) map) 'help-echo "mouse-2 prompts to input URL")) ", ") "") (propertize "Location: " 'face (list 'w3m-header-line-location-title)) `(:eval (propertize (if (stringp w3m-current-url) (replace-regexp-in-string "%" "%%" w3m-current-url) "") 'face (list 'w3m-header-line-location-content) 'mouse-face '(highlight :foreground ,(face-foreground 'default)) 'local-map (let ((map (make-sparse-keymap))) (define-key map [header-line mouse-2] 'w3m-goto-url) map) 'help-echo "mouse-2 prompts to input URL"))))))) (eval-when-compile ;; Shut up the byte-compiler for old Emacsen. (unless (fboundp 'force-window-update) (defalias 'force-window-update 'ignore))) (eval-and-compile (defalias 'w3m-force-window-update (if (and (fboundp 'force-window-update) (not (eq (symbol-function 'force-window-update) 'ignore))) (lambda (&optional window) "\ Force redisplay of WINDOW which defaults to the selected window." (force-window-update (or window (selected-window))) (sit-for 0)) (lambda (&optional ignore) "\ Wobble the selected window to force redisplay of the header-line." (save-window-excursion (split-window-vertically)))))) (defun w3m-tab-drag-mouse-function (event buffer) (let ((window (posn-window (event-end event))) mpos) (when (framep window) ; dropped at outside of the frame. (setq window nil mpos (mouse-position)) (and (framep (car mpos)) (car (cdr mpos)) (cdr (cdr mpos)) (setq window (window-at (car (cdr mpos)) (cdr (cdr mpos)) (car mpos)))) (unless window (when (one-window-p 'nomini) (split-window)) (setq window (next-window)))) (unless (eq (window-buffer window) buffer) (select-window window) (switch-to-buffer buffer) (w3m-force-window-update window)))) (defun w3m-tab-click-mouse-function (event buffer) (let ((window (posn-window (event-start event)))) (select-window window) (switch-to-buffer buffer) (w3m-force-window-update window))) (defun w3m-tab-double-click-mouse1-function (event buffer) (let ((window (posn-window (event-start event)))) (when (eq major-mode 'w3m-mode) (if w3m-new-session-in-background (save-window-excursion (w3m-copy-buffer)) (w3m-copy-buffer))) (w3m-force-window-update window))) (defun w3m-tab-double-click-mouse2-function (event buffer) (let ((window (posn-window (event-start event)))) (when (eq major-mode 'w3m-mode) (w3m-delete-buffer)) (w3m-force-window-update window))) (defcustom w3m-tab-track-mouse t "Say whether to make the mouse track the selected tab. It controls the behavior of the commands `w3m-tab-previous-buffer', `w3m-tab-next-buffer', `w3m-tab-move-right', and `w3m-tab-move-left' invoked by the mouse. You may want to set this to nil if you use a proportional font for the tab faces. See also `w3m-tab-mouse-position-adjuster'." :group 'w3m :type 'boolean) (defcustom w3m-tab-mouse-position-adjuster '(0.5 . -4) "Values used to adjust the mouse position on tabs. It is used when the command `w3m-tab-previous-buffer', `w3m-tab-next-buffer', `w3m-tab-move-right', or `w3m-tab-move-left' is invoked by the mouse. The value consists of the cons of a floating point number M and an integer N that are applied to calculating of the mouse position, which is given in pixel units, as follows: (TAB_WIDTH + M) * ORDER + N Where TAB_WIDTH is the pixel width of a tab and ORDER is the order number in tabs. The result is rounded towards zero. Note that the calculation will always fail if you use a proportional font for the tab faces. See also `w3m-tab-track-mouse'." :group 'w3m :type '(cons (number :tag "M") (integer :tag "N"))) (defun w3m-tab-mouse-track-selected-tab (event order &optional decelerate) "Make the mouse track the selected tab. EVENT is a command event. ORDER is the order number in tabs. The optional DECELERATE if it is non-nil means not to respond to too fast operation of mouse wheel." (when (and w3m-use-tab window-system w3m-tab-track-mouse (consp event) (symbolp (car event))) (let ((e (get (car event) 'event-symbol-elements)) (len (* (car w3m-tab-mouse-position-adjuster) order)) (fcw (frame-char-width)) posn tab start end disp next) (when (and (consp e) (symbolp (car e)) (or (memq (car e) '(mouse-4 mouse-5 wheel-up wheel-down)) (string-match "\\`mouse-" (symbol-name (car e))))) ;; Ignore values gotten by the mouse pointing to other frames. ;; It might happen if the frame in question gets out of focus ;; by a certain desktop tool such as unclutter. (let ((frame (selected-frame))) (while (not (cadr (setq posn (mouse-pixel-position)))) (select-frame-set-input-focus frame))) ;; Update the header line. (setq tab (w3m-tab-line)) (with-temp-buffer (insert tab) (setq start (point-min) end (point)) (while (and (> order 0) (setq start (text-property-any start end 'tab-separator t)) (setq start (text-property-not-all start end 'tab-separator t))) (setq order (1- order))) (setq end (1- start) start (point-min) next start disp (get-text-property start 'display)) (while (and (< next end) (setq next (next-single-property-change start 'display nil end))) (setq len (+ (cond ((eq (car disp) 'image) (or (car w3m-favicon-size) (frame-char-height))) ((eq (car disp) 'space) (* (or (plist-get (cdr disp) :width) 1) fcw)) (t (* (string-width (buffer-substring start next)) fcw))) len) start next disp (get-text-property start 'display)))) (set-mouse-pixel-position (car posn) (truncate (+ len (cdr w3m-tab-mouse-position-adjuster))) (cddr posn)) (when decelerate (sleep-for 0.1)) (discard-input))))) (defun w3m-tab-next-buffer (&optional n event) "Turn N pages of emacs-w3m buffers ahead." (interactive (list (prefix-numeric-value current-prefix-arg) last-command-event)) (unless n (setq n 1)) (when (and (/= n 0) (eq major-mode 'w3m-mode)) (let ((buffers (w3m-list-buffers))) (switch-to-buffer (nth (mod (+ n (w3m-buffer-number (current-buffer)) -1) (length buffers)) buffers)) (run-hooks 'w3m-select-buffer-hook) (w3m-select-buffer-update) (w3m-tab-mouse-track-selected-tab event (w3m-buffer-number (current-buffer)))))) (defun w3m-tab-previous-buffer (&optional n event) "Turn N pages of emacs-w3m buffers behind." (interactive (list (prefix-numeric-value current-prefix-arg) last-command-event)) (w3m-tab-next-buffer (- (or n 1)) event)) (defun w3m-tab-move-right (&optional n event) "Move this tab N times to the right (to the left if N is negative)." (interactive (list (prefix-numeric-value current-prefix-arg) last-command-event)) (unless n (setq n 1)) (when (and (/= n 0) (eq major-mode 'w3m-mode)) (let* ((buffers (if (> n 0) (w3m-list-buffers) (setq n (- n)) (nreverse (w3m-list-buffers)))) (dest (or (nth n (memq (current-buffer) buffers)) (car (last buffers)))) (next (w3m-buffer-number dest)) (cur (w3m-buffer-number (current-buffer))) e posn start) (rename-buffer "*w3m*<0>") (w3m-buffer-set-number dest cur) (w3m-buffer-set-number (current-buffer) next) (w3m-select-buffer-update) (w3m-tab-mouse-track-selected-tab event next t)))) (defun w3m-tab-move-left (&optional n event) "Move this tab N times to the left (to the right if N is negative)." (interactive (list (prefix-numeric-value current-prefix-arg) last-command-event)) (w3m-tab-move-right (- n) event)) (defvar w3m-tab-map nil) (make-variable-buffer-local 'w3m-tab-map) (defvar w3m-tab-spinner-map nil) (make-variable-buffer-local 'w3m-tab-spinner-map) (defun w3m-tab-make-keymap () (unless w3m-tab-map (setq w3m-tab-map (make-sparse-keymap)) (let* ((cur (current-buffer)) (f1 (lambda (fn) `(lambda (e) (interactive "e") (,fn e ,cur)))) (f2 (lambda (fn) `(lambda (e) (interactive "e") (select-window (posn-window (event-start e))) (switch-to-buffer ,cur) (setq this-command ',fn) (,fn 1 e)))) (drag-action (funcall f1 'w3m-tab-drag-mouse-function)) (single-action (funcall f1 'w3m-tab-click-mouse-function)) (double-action1 (funcall f1 'w3m-tab-double-click-mouse1-function)) (double-action2 (funcall f1 'w3m-tab-double-click-mouse2-function)) (menu-action (funcall f1 'w3m-tab-button-menu)) (menu-action2 (funcall f1 'w3m-tab-button-menu2)) (next-buffer-action (funcall f2 'w3m-tab-next-buffer)) (previous-buffer-action (funcall f2 'w3m-tab-previous-buffer)) (move-left-action (funcall f2 'w3m-tab-move-left)) (move-right-action (funcall f2 'w3m-tab-move-right))) (define-key w3m-tab-map [header-line down-mouse-1] 'ignore) (define-key w3m-tab-map [header-line down-mouse-2] 'ignore) (define-key w3m-tab-map [header-line mouse-1] single-action) (define-key w3m-tab-map [header-line mouse-2] single-action) (define-key w3m-tab-map [header-line drag-mouse-1] drag-action) (define-key w3m-tab-map [header-line drag-mouse-2] drag-action) (define-key w3m-tab-map [header-line double-mouse-1] double-action1) (define-key w3m-tab-map [header-line double-mouse-2] double-action2) (define-key w3m-tab-map [header-line mouse-3] menu-action) (define-key w3m-tab-map [header-line wheel-up] previous-buffer-action) (define-key w3m-tab-map [header-line wheel-down] next-buffer-action) (define-key w3m-tab-map [header-line mouse-4] previous-buffer-action) (define-key w3m-tab-map [header-line mouse-5] next-buffer-action) (define-key w3m-tab-map [header-line C-wheel-up] move-left-action) (define-key w3m-tab-map [header-line C-wheel-down] move-right-action) (define-key w3m-tab-map [header-line C-mouse-4] move-left-action) (define-key w3m-tab-map [header-line C-mouse-5] move-right-action) (define-key w3m-mode-map [header-line double-mouse-1] 'w3m-goto-new-session-url) (define-key w3m-mode-map [header-line mouse-3] menu-action2) ;; The following bindings in `w3m-mode-map', not `w3m-tab-map', ;; are required for some platforms, in which mouse wheel events ;; sometimes pass by `w3m-tab-map' for the unresolved reason and ;; see `w3m-mode-map', or else the `undefined' errors will arise. (define-key w3m-mode-map [header-line mouse-4] 'w3m-tab-previous-buffer) (define-key w3m-mode-map [header-line mouse-5] 'w3m-tab-next-buffer) (define-key w3m-mode-map [header-line wheel-up] 'w3m-tab-previous-buffer) (define-key w3m-mode-map [header-line wheel-down] 'w3m-tab-next-buffer) (define-key w3m-mode-map [header-line C-wheel-up] 'w3m-tab-move-left) (define-key w3m-mode-map [header-line C-wheel-down] 'w3m-tab-move-right) (define-key w3m-mode-map [header-line C-mouse-4] 'w3m-tab-move-left) (define-key w3m-mode-map [header-line C-mouse-5] 'w3m-tab-move-right)) (unless w3m-tab-spinner-map (setq w3m-tab-spinner-map (make-sparse-keymap)) (define-key w3m-tab-spinner-map [header-line mouse-2] `(lambda (e) (interactive "e") (save-current-buffer ;; Why the `(w3m-process-stop BUFFER)' doesn't work? (set-buffer ,(current-buffer)) (call-interactively 'w3m-process-stop))))))) (defvar w3m-tab-half-space (propertize " " 'display '(space :width 0.5)) "The space of half width.") (defvar w3m-tab-separator-map nil) (unless w3m-tab-separator-map (let ((map (make-sparse-keymap))) (setq w3m-tab-separator-map map) (define-key map [header-line wheel-up] 'w3m-tab-previous-buffer) (define-key map [header-line wheel-down] 'w3m-tab-next-buffer) (define-key map [header-line mouse-4] 'w3m-tab-previous-buffer) (define-key map [header-line mouse-5] 'w3m-tab-next-buffer) (define-key map [header-line C-wheel-up] 'w3m-tab-move-left) (define-key map [header-line C-wheel-down] 'w3m-tab-move-right) (define-key map [header-line C-mouse-4] 'w3m-tab-move-left) (define-key map [header-line C-mouse-5] 'w3m-tab-move-right))) (defvar w3m-tab-separator (propertize " " 'face (list 'w3m-tab-background) 'mouse-face 'w3m-tab-selected-background 'display '(space :width 0.5) 'tab-separator t 'local-map w3m-tab-separator-map) "String used to separate tabs.") (defun w3m-tab-line () (let* ((current (current-buffer)) (buffers (w3m-list-buffers)) (breadth 1) (number 0) (fringes (window-fringes)) (width (+ (window-width) (/ (float (+ (or (car fringes) 0) (or (nth 1 fringes) 0))) (frame-char-width)) ;; Assume that the vertical scroll-bar has ;; the width of two space characters. (if (car (frame-current-scroll-bars)) 2 0))) (nbuf (length buffers)) (graphic (and window-system w3m-show-graphic-icons-in-header-line)) (margin (if window-system (+ (if graphic 3.0 0.5) ;; Right and left shadows. (/ 2.0 (frame-char-width))) 1)) (spinner (when w3m-process-queue (w3m-make-spinner-image))) buffer title data datum process unseen favicon keymap face icon line) (save-current-buffer (while buffers (set-buffer (setq buffer (pop buffers))) (setq number (1+ number)) (setq title (if w3m-add-tab-number (format "%d.%s" number (w3m-current-title)) (w3m-current-title))) (setq breadth (max breadth ;; There may be a wide character in the beginning of ;; the title. (if (> (length title) 0) (char-width (aref title 0)) 0))) (push (list (eq current buffer) w3m-current-process (w3m-unseen-buffer-p buffer) title (when w3m-use-favicon w3m-favicon-image) w3m-tab-map) data))) (setq width (if (> (* nbuf (+ margin w3m-tab-width)) width) (max (truncate (- (/ width nbuf) margin)) breadth) w3m-tab-width)) (while data (setq datum (pop data) current (car datum) process (nth 1 datum) unseen (nth 2 datum) title (nth 3 datum) favicon (nth 4 datum) keymap (nth 5 datum) face (list (if process (if current 'w3m-tab-selected-retrieving 'w3m-tab-unselected-retrieving) (if current 'w3m-tab-selected (if unseen 'w3m-tab-unselected-unseen 'w3m-tab-unselected)))) icon (when graphic (cond (process (when spinner (propertize " " 'display spinner 'face face 'local-map w3m-tab-spinner-map 'help-echo w3m-spinner-map-help-echo))) (favicon (propertize " " 'display favicon 'face face 'local-map keymap 'help-echo title)))) breadth (cond (icon width) (graphic (+ 2 width)) (t width))) (push (list icon (propertize (concat (when graphic w3m-tab-half-space) (replace-regexp-in-string "%" "%%" (if (and (> (string-width title) breadth) (> breadth 6)) (truncate-string-to-width (concat (truncate-string-to-width title (- breadth 3)) "...") breadth nil ?.) (truncate-string-to-width title breadth nil ?\ )))) 'face face 'mouse-face 'w3m-tab-mouse 'local-map keymap 'help-echo title) w3m-tab-separator) line)) (concat (apply 'concat (apply 'nconc line)) (propertize (make-string (window-width) ?\ ) 'face (list 'w3m-tab-background) 'mouse-face 'w3m-tab-selected-background 'local-map w3m-tab-separator-map)))) (add-hook 'w3m-mode-setup-functions 'w3m-tab-make-keymap) (add-hook 'w3m-mode-setup-functions 'w3m-setup-header-line) (add-hook 'w3m-mode-setup-functions 'w3m-setup-widget-faces) (add-hook 'w3m-select-buffer-hook 'w3m-force-window-update) ;; Graphic icons. (defcustom w3m-space-before-modeline-icon "" "String of space character(s) to be put in front of the mode-line icon. It may be better to use one or more spaces if you are using oblique or italic font in the modeline." :group 'w3m :type 'string) (defvar w3m-spinner-image-file nil "Image file used to show a spinner in the header-line.") (defvar w3m-spinner-image-frames 3 "Number of frames which the spinner image contains.") (defvar w3m-spinner-image-index 0 "Counter used to rotate spinner images. This is a buffer-local variable.") (make-variable-buffer-local 'w3m-spinner-image-index) ;; Images to be displayed in the modeline. (defvar w3m-modeline-process-status-on-icon nil) (defvar w3m-modeline-image-status-on-icon nil) (defvar w3m-modeline-status-off-icon nil) (defvar w3m-modeline-ssl-image-status-on-icon nil) (defvar w3m-modeline-ssl-status-off-icon nil) (defun w3m-initialize-graphic-icons (&optional force) "Make icon images which will be displayed in the mode-line." (interactive "P") (when (or (image-type-available-p 'xpm) (image-type-available-p 'png)) ;; Prefer xpm icons rather than png icons since Emacs doesn't display ;; background colors of icon images other than xpm images transparently ;; in the mode line. (let* ((w3m-toolbar-icon-preferred-image-types (if (image-type-available-p 'xpm) '(xpm) '(png))) (defs `((w3m-modeline-status-off-icon ,(w3m-find-image "state-00") w3m-modeline-status-off) (w3m-modeline-image-status-on-icon ,(w3m-find-image "state-01") w3m-modeline-image-status-on) (w3m-modeline-ssl-status-off-icon ,(w3m-find-image "state-10") w3m-modeline-ssl-status-off) (w3m-modeline-ssl-image-status-on-icon ,(w3m-find-image "state-11") w3m-modeline-ssl-image-status-on))) def icon file type status keymap) (while defs (setq def (car defs) defs (cdr defs) icon (car def) file (car (nth 1 def)) type (cdr (nth 1 def)) status (nth 2 def)) (if (and w3m-show-graphic-icons-in-mode-line file) (progn (when (or force (not (symbol-value icon))) (unless keymap (setq keymap (make-mode-line-mouse-map 'mouse-2 'w3m-reload-this-page))) (set icon (propertize " " 'display (create-image file type nil :ascent 'center) 'local-map keymap 'mouse-face 'mode-line-highlight 'help-echo "mouse-2 reloads this page")) (put icon 'risky-local-variable t) (put status 'risky-local-variable t)) (when (stringp (symbol-value status)) ;; Save the original status strings as properties. (put status 'string (symbol-value status))) (set status (list "" 'w3m-space-before-modeline-icon icon))) ;; Don't use graphic icons. (when (get status 'string) (set status (get status 'string))))))) (let (file) ;; Spinner (when (and (or force (not w3m-spinner-image-file)) (image-type-available-p 'gif) w3m-icon-directory (file-directory-p w3m-icon-directory) (file-exists-p (setq file (expand-file-name "spinner.gif" w3m-icon-directory)))) (setq w3m-spinner-image-file file) (define-key (setq w3m-modeline-spinner-map (make-sparse-keymap)) [mode-line mouse-2] 'w3m-process-stop) (put 'w3m-modeline-process-status-on 'risky-local-variable t) (put 'w3m-modeline-process-status-on-icon 'risky-local-variable t)) (if (and window-system w3m-show-graphic-icons-in-mode-line w3m-spinner-image-file) (progn (when (stringp w3m-modeline-process-status-on) ;; Save the original status strings as properties. (put 'w3m-modeline-process-status-on 'string w3m-modeline-process-status-on)) (setq w3m-modeline-process-status-on '("" w3m-space-before-modeline-icon w3m-modeline-process-status-on-icon))) (when (get 'w3m-modeline-process-status-on 'string) (setq w3m-modeline-process-status-on (get 'w3m-modeline-process-status-on 'string)))))) (defun w3m-make-spinner-image () "Make an image used to show a spinner. It should be called periodically in order to spin the spinner." (when w3m-spinner-image-file (unless (< (incf w3m-spinner-image-index) w3m-spinner-image-frames) (setq w3m-spinner-image-index 0)) (let ((image (create-image w3m-spinner-image-file 'gif nil :ascent 'center :mask 'heuristic :index w3m-spinner-image-index))) (setq w3m-modeline-process-status-on-icon (propertize " " 'display image 'local-map w3m-modeline-spinner-map 'help-echo w3m-spinner-map-help-echo)) image))) (defun w3m-form-coding-system-accept-region-p (&optional from to coding-system) "Check whether `coding-system' can encode specified region." (let ((from (or from (point-min))) (to (or to (point-max))) (coding-system (or coding-system w3m-form-input-textarea-coding-system))) (if (fboundp 'unencodable-char-position) (let ((pos (unencodable-char-position from to coding-system))) (or (not pos) (y-or-n-p (format "\"%c\" would not be accepted. Continue? " (char-after pos))))) (let ((select-safe-coding-system-accept-default-p nil)) (or (eq (select-safe-coding-system from to coding-system) coding-system) (y-or-n-p "This text may cause coding-system problem. Continue? ")))))) (provide 'w3m-ems) ;;; w3m-ems.el ends here w3m-el-snapshot-1.4.609+0.20171225.orig/w3m-dtree.el0000644000000000000000000002017513127150703017463 0ustar rootroot;;; w3m-dtree.el --- The add-on program to display local directory tree. ;; Copyright (C) 2001, 2002, 2003, 2005, 2006, 2007, 2009, 2017 ;; TSUCHIYA Masatoshi ;; Author: Hideyuki SHIRAI , ;; TSUCHIYA Masatoshi ;; Keywords: w3m, WWW, hypermedia, directory, tree ;; 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-dtree.el is the add-on program of emacs-w3m to display local ;; directory tree. For more detail about emacs-w3m, see: ;; ;; http://emacs-w3m.namazu.org/ ;;; Code: (require 'w3m) (defcustom w3m-dtree-default-allfiles nil "*If non-nil, set 'allfiles' to default." :group 'w3m :type 'boolean) (defcustom w3m-dtree-directory-depth 8 "*Interger of a depth of the viewing directory." :group 'w3m :type '(choice (const :tag "No limit" nil) (integer :format "%t: %v\n" :tag "depth" 10))) (defcustom w3m-dtree-indent-strings ["|-" "+-" "| " " "] "*Vector of strings to be used for indentation with w3m-dtree. If use default value or choice 'ASCII', display like this, /home/shirai/work/emacs-w3m/ |-CVS/ |-icons/ | +-CVS/ +-shimbun/ +-CVS/ If you care for another style, set manually and try it :-). " :group 'w3m :type '(radio (const :format "ASCII: " ["|-" "+-" "| " " "]) (vector :convert-widget w3m-widget-type-convert-widget (let ((defaults (if (equal w3m-language "Japanese") (vconcat (mapcar (lambda (s) (decode-coding-string s 'iso-2022-7bit)) '("\e$B('\e(B" "\e$B(&\e(B" "\e$B(\"\e(B" "\e$B!!\e(B"))) ["|-" "+-" "| " " "]))) `(:format "Others:\n%v" :indent 4 (string :format "%{|-%} %v\n" :sample-face widget-field-face :value ,(aref defaults 0)) (string :format "%{+-%} %v\n" :sample-face widget-field-face :value ,(aref defaults 1)) (string :format "%{| %} %v\n" :sample-face widget-field-face :value ,(aref defaults 2)) (string :format "%{ %} %v" :sample-face widget-field-face :value ,(aref defaults 3))))))) (defcustom w3m-dtree-stop-strings ["|=" "+="] "*Vector of strings to be used for indentation when a depth of directory over the 'w3m-dtree-directory-depth'." :group 'w3m :type '(radio (const :format "ASCII: " ["|=" "+="]) (const :format "ASCII Bold: " ["|-" "+-"]) (vector :convert-widget w3m-widget-type-convert-widget (let ((defaults (if (equal w3m-language "Japanese") (vconcat (mapcar (lambda (s) (decode-coding-string s 'iso-2022-7bit)) '("\e$B(<\e(B" "\e$B(1\e(B"))) ["|=" "+="]))) `(:format "Others:\n%v" :indent 4 (string :format "|= %{|=%} %v\n" :sample-face bold :value ,(aref defaults 0)) (string :format "+= %{+=%} %v\n" :sample-face bold :value ,(aref defaults 1))))))) (defun w3m-dtree-expand-file-name (path) (if (string-match "^\\(.\\):\\(.*\\)" path) (if w3m-use-cygdrive (concat "/cygdrive/" (match-string 1 path) (match-string 2 path)) (concat "/" (match-string 1 path) "|" (match-string 2 path))) path)) (defun w3m-dtree-directory-name (path) (when (and w3m-treat-drive-letter (string-match "^/\\(?:\\([A-Za-z]\\)[|:]?\\|cygdrive/\\([A-Za-z]\\)\\)/" path)) (setq path (concat (or (match-string 1 path) (match-string 2 path)) ":/" (substring path (match-end 0))))) path) (defmacro w3m-dtree-has-child (path) `(let ((w32-get-true-file-link-count t)) ;; true link count for Meadow (and (nth 1 (file-attributes ,path)) (/= (nth 1 (file-attributes ,path)) 2)))) (defun w3m-dtree-create-sub (path allfiles dirprefix fileprefix indent depth) (let* ((files (directory-files path t)) (limit (and (integerp w3m-dtree-directory-depth) (>= depth w3m-dtree-directory-depth))) (indent-sub1 (if limit (aref w3m-dtree-stop-strings 0) (aref w3m-dtree-indent-strings 0))) (indent-sub2 (aref w3m-dtree-indent-strings 2)) file fullpath tmp) (setq files (delete (concat (file-name-as-directory path) ".") (delete (concat (file-name-as-directory path) "..") files))) (unless allfiles (setq tmp files) (while (setq file (car tmp)) (unless (file-directory-p file) (setq files (delete file files))) (setq tmp (cdr tmp)))) (while (setq fullpath (car files)) (when (= (length files) 1) (if limit (setq indent-sub1 (aref w3m-dtree-stop-strings 1)) (setq indent-sub1 (aref w3m-dtree-indent-strings 1))) (setq indent-sub2 (aref w3m-dtree-indent-strings 3))) (setq file (file-name-nondirectory fullpath)) (cond ((or (not allfiles) (file-directory-p fullpath)) (insert (format "%s%s%s%s\n" indent indent-sub1 (if allfiles "[d]" "") dirprefix (w3m-dtree-expand-file-name (file-name-as-directory fullpath)) (concat file "/"))) (when (and (null limit) (or allfiles (w3m-dtree-has-child fullpath))) (w3m-dtree-create-sub fullpath allfiles dirprefix fileprefix (concat indent indent-sub2) (1+ depth)))) ((and allfiles (file-exists-p fullpath)) (insert (format "%s%s%s%s\n" indent indent-sub1 (if allfiles "(f)" "") fileprefix (w3m-dtree-expand-file-name fullpath) file)))) (setq files (cdr files))))) (defun w3m-dtree-create (path allfiles dirprefix fileprefix) (let ((charset (or (car (rassq w3m-file-name-coding-system w3m-charset-coding-system-alist)) w3m-file-name-coding-system))) (insert "\n" "\n\n" "\n" "" path "\n\n\n
\n")
    (insert (format "%s%s\n"
		    dirprefix (w3m-dtree-expand-file-name path) path
		    (if allfiles " (allfiles)" "")))
    (if (file-directory-p path)
	(w3m-dtree-create-sub path allfiles dirprefix fileprefix " " 0)
      (insert (format "\n
Warning: Directory not found.
\n")))
    (insert "
\n\n\n"))) ;;;###autoload (defun w3m-about-dtree (url &optional nodecode allfiles &rest args) (let ((prelen (length "about://dtree")) (dirprefix "about://dtree") (fileprefix "file://") path) (if (string-match "\\?allfiles=\\(?:\\(true\\)\\|false\\)$" url) (progn (setq path (substring url prelen (match-beginning 0))) (if (match-beginning 1) (setq allfiles t))) (if w3m-dtree-default-allfiles (setq allfiles (not allfiles))) (setq path (substring url prelen))) ;; counter drive letter (setq path (file-name-as-directory (w3m-dtree-directory-name path))) (setq default-directory path) (w3m-message "Dtree (%s)..." path) (w3m-dtree-create path allfiles dirprefix fileprefix) (w3m-message "Dtree...done") "text/html")) ;;;###autoload (defun w3m-dtree (allfiles path) "Display directory tree on local file system. If called with 'prefix argument', display all directorys and files." (interactive "P\nDDtree directory: ") (if w3m-dtree-default-allfiles (setq allfiles (not allfiles))) (w3m-goto-url (format "about://dtree%s%s" (w3m-dtree-expand-file-name (file-name-as-directory (expand-file-name path))) (if allfiles "?allfiles=true" "")))) (provide 'w3m-dtree) ;;; w3m-dtree.el ends here w3m-el-snapshot-1.4.609+0.20171225.orig/w3m-save.el0000644000000000000000000002063013215724236017320 0ustar rootroot;;; w3m-save.el --- Save the page to the local files ;; Copyright (C) 2015-2017 TSUCHIYA Masatoshi ;; Author: 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 GNU Emacs. If not, see . ;;; Commentary: ;; Save the current page and its image data, if any, to a local file ;; PAGE.html and sub-directory PAGE-files/. PAGE.html and PAGE-files/ ;; are portable; you can move them to any place including a web site. ;;; Code: (eval-when-compile (require 'cl)) (require 'w3m) (defcustom w3m-save-buffer-directory (expand-file-name "saved/" w3m-default-save-directory) "Default directory for saved pages and their image files." :group 'w3m :type 'directory) (defcustom w3m-save-buffer-use-cache t "If non-nil, use cached data if available." :group 'w3m :type 'boolean) (defcustom w3m-save-buffer-html-only nil "Save images along with a web-page, or just html. If nil, `w3m-save-buffer' will save the images of a buffer in addition to the buffer's html. If the buffer was originally loaded without images, the images will now be retrieved. The value of this variable may be over-ridden at run-time by passing a prefix argument to function `w3m-save-buffer'." :group 'w3m :type 'boolean) (defun w3m-save-buffer (name &optional no-images) "Save the current w3m buffer. Save the current buffer as `w3m-save-buffer-directory'/NAME.html, and optionally save the buffer's associated image files in folder `w3m-save-buffer-directory'/NAME-files/. Use of `w3m-save-buffer-directory' may be over-ridden by including a folder path in NAME. Variable `w3m-save-buffer-html-only' determines whether images will be saved by default, but that setting may be toggled using the prefix argument (the optional NO-IMAGES). The saved page will be added to the history list, and be viewable using `w3m-next-page'." (interactive (if (and w3m-current-url (or (not (string-match "\\`[\C-@- ]*\\'\\|\\`about:\\|\\`file:" w3m-current-url)) (string-match "\\`about://\\(?:header\\|source\\)/" w3m-current-url))) (let ((name (or (and (stringp w3m-current-title) (not (string-match "\\`[\C-@- ]*\\'" w3m-current-title)) w3m-current-title) (and (not (string-match "\\`[\C-@- ]*\\'" w3m-current-url)) (file-name-nondirectory w3m-current-url)) (make-temp-name "w3m-"))) (case-fold-search t)) (setq name (w3m-replace-in-string name "[\C-@- \"*/:<>?\|]+" "_")) (list (read-file-name (if (not w3m-save-buffer-html-only) "Save this page (with images) to: " "Save this page (html only) to: ") (file-name-as-directory w3m-save-buffer-directory) name nil (concat name ".html")) current-prefix-arg)) (error "No valid url for this page"))) (when w3m-save-buffer-html-only (setq no-images (not no-images))) (let ((url w3m-current-url) (w3m-prefer-cache w3m-save-buffer-use-cache) (case-fold-search t) subdir type st base regexp sdir charset ibuf imgs nd img bads bname ext num bn) (unless (and url (or (not (string-match "\\`[\C-@- ]*\\'\\|\\`about:\\|\\`file:" url)) (and (string-match "\\`about://\\(?:header\\|source\\)/" url) (setq url (substring url (match-end 0))) (not (string-match "\\`[\C-@- ]*\\'" url))))) (error "No valid url for this page")) (cond ((or (not (stringp name)) (string-match "\\`[\C-@- ]*\\'" name)) (error "No valid file name")) ((not (string-match "\\.html?\\'" name)) (setq name (concat name ".html")))) (unless (file-name-directory name) (setq name (expand-file-name name w3m-save-buffer-directory))) (setq subdir (concat (file-name-sans-extension name) "-files")) (cond ((and (not no-images) (file-exists-p name) (file-exists-p subdir)) (if (yes-or-no-p (format "#1=%s and #1#-files/ already exist in %s, overwrite? " (file-name-nondirectory name) (file-name-directory name))) (progn (delete-file name) (delete-directory subdir t)) (keyboard-quit))) ((file-exists-p name) (if (yes-or-no-p (format "%s already exists, overwrite? " name)) (delete-file name) (keyboard-quit))) ((and (not no-images) (file-exists-p subdir)) (if (yes-or-no-p (format "%s already exists, overwrite? " subdir)) (delete-directory subdir t) (keyboard-quit)))) (with-temp-buffer (unless (setq type (w3m-retrieve url)) (error "Retrieving failed: %s" url)) (goto-char (point-min)) ;; Look for url. (setq base (if (and (re-search-forward "]" nil t) (progn (setq st (match-end 0)) (re-search-forward "]" nil t)) (re-search-backward "<\\(base\ \\(?:[\t\n ]+[^\t\n >]+\\)*[\t\n ]+href=\"\\([^\"]+\\)\"[^>]*\\)>" st t)) (prog1 (match-string 2) (replace-match "")) url)) (setq st (point)) ;; Make link urls absolute. (dolist (tag '(("a" . "href") ("form" . "action"))) (setq regexp (concat "<" (car tag) "\\(?:[\t\n ]+[^\t\n >]+\\)*[\t\n ]+" (cdr tag) "=\"\\([^\"]+\\)")) (while (re-search-forward regexp nil t) (insert (prog1 (condition-case nil (w3m-expand-url (match-string 1) base) (error (match-string 1))) (delete-region (match-beginning 1) (match-end 1))))) (goto-char st)) ;; Save images into `subdir'. (unless no-images (make-directory subdir t) (setq sdir (file-name-nondirectory (directory-file-name subdir))) (when (and (setq charset (or (w3m-arrived-content-charset url) (w3m-content-charset url) (and (equal "text/html" type) (w3m-detect-meta-charset)) (w3m-detect-xml-charset))) (setq charset (w3m-charset-to-coding-system charset))) (setq sdir (encode-coding-string sdir charset))) (unwind-protect (while (re-search-forward "]+\\)*[\t\n ]+src=\"\\([^\"?]+\\)" nil t) (setq st (match-beginning 1) nd (match-end 1) img (w3m-expand-url (match-string 1) base)) (when (cond ((member img bads) nil) ((assoc img imgs) (setq bname (cadr (assoc img imgs)) ext (caddr (assoc img imgs))) t) (t (with-current-buffer (or ibuf (setq ibuf (generate-new-buffer " *temp*"))) (erase-buffer) (if (setq type (w3m-retrieve img)) (progn (push (list img) imgs) (setq img (file-name-nondirectory img) bname (file-name-sans-extension img) ext (file-name-extension img) num 1) (if (zerop (length ext)) (when (setq ext (assoc type w3m-image-type-alist)) (setq ext (concat "." (symbol-name (cdr ext))))) (setq ext (concat "." ext))) (setq bname (w3m-replace-in-string bname "[\C-@- \"*/:<>?\|]+" "_")) (when (file-exists-p (expand-file-name (concat bname ext) subdir)) (while (progn (setq bn (concat bname "-" (number-to-string num))) (file-exists-p (expand-file-name (concat bn ext) subdir))) (setq num (1+ num))) (setq bname bn)) (setcdr (car imgs) (list bname ext)) (write-region (point-min) (point-max) (expand-file-name (concat bname ext) subdir)) t) (push img bads) nil)))) (delete-region (goto-char st) nd) (insert sdir "/" bname (or ext "")))) (when ibuf (kill-buffer ibuf)) (unless imgs (delete-directory subdir)))) (unless (file-exists-p (file-name-directory name)) (make-directory (file-name-directory name) t)) (write-region (point-min) (point-max) name)) (w3m-history-set-current (prog1 (cadar w3m-history) (w3m-history-push (w3m-expand-file-name-as-url name) (list :title (or w3m-current-title ""))))) name)) (provide 'w3m-save) ;; w3m-save.el ends here w3m-el-snapshot-1.4.609+0.20171225.orig/attic/0000755000000000000000000000000013224004712016425 5ustar rootrootw3m-el-snapshot-1.4.609+0.20171225.orig/attic/addpath.el0000644000000000000000000001244510216576033020372 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.609+0.20171225.orig/attic/rfc2368.el0000644000000000000000000001072610444127745020067 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.609+0.20171225.orig/w3m-antenna.el0000644000000000000000000005407413127150703020011 0ustar rootroot;;; w3m-antenna.el --- Utility to detect changes of WEB ;; Copyright (C) 2001, 2002, 2003, 2004, 2005, 2007, 2017 ;; 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-antenna.el is the add-on utility of emacs-w3m to detect changes ;; of WEB pages. For more detail about emacs-w3m, see: ;; ;; http://emacs-w3m.namazu.org/ ;;; How to install: ;; Please put this file to appropriate directory, and if you want ;; byte-compile it. And add following lisp expressions to your ;; ~/.emacs. ;; ;; (autoload 'w3m-antenna "w3m-antenna" "Report changes of WEB sites." t) ;;; Code: (eval-when-compile (require 'cl)) (require 'w3m-util) (require 'w3m-rss) (require 'w3m) (defgroup w3m-antenna nil "w3m-antenna - Utility to detect changes of WEB." :group 'w3m :prefix "w3m-antenna-") (define-widget 'w3m-antenna-string 'string "String widget with default value. When creating a new widget, its value is given by an expression specified with :value-from." :tag "URL" :value-from nil :create 'w3m-antenna-string-create) (defun w3m-antenna-string-create (widget) (if (string= "" (widget-get widget :value)) ;; No value is given. (widget-put widget :value (let* ((symbol (widget-get widget :value-from)) (value (eval symbol))) (if value (set symbol nil) (setq value "")) value))) (widget-default-create widget)) (eval-when-compile ;; Compiler warning in Emacs 19. (autoload 'widget-default-get "wid-edit")) (apply 'define-widget 'w3m-antenna-function 'function "Bug-fixed version of the `function' widget. In Emacs 20.7 through 21.4 and XEmacs, it doesn't represent a value as a string internally, converts it into a string in the customization buffer, and provides the default value as `ignore'." (if (and (fboundp 'widget-default-get) (widget-default-get '(function :value-to-external ignore :value foo))) '(:value-create (lambda (widget) (widget-put widget :value (widget-sexp-value-to-internal widget value)) (widget-field-value-create widget)) :value-to-internal (lambda (widget value) value) :value ignore))) (defvar w3m-antenna-alist nil "A list of site information (internal variable). nil means that antenna database is not initialized. Each site information is a list that consists of: 0. Format string of URL. 1. Title. 2. Class (Normal, HNS or TIME). 3. Real URL. 4. Last modification time. 5. Size in bytes. 6. Time when size modification is detected. ") (defmacro w3m-antenna-site-key (site) `(car ,site)) (defmacro w3m-antenna-site-title (site) `(nth 1 ,site)) (defmacro w3m-antenna-site-class (site) `(nth 2 ,site)) (defmacro w3m-antenna-site-url (site) `(nth 3 ,site)) (defmacro w3m-antenna-site-last-modified (site) `(nth 4 ,site)) (defmacro w3m-antenna-site-size (site) `(nth 5 ,site)) (defmacro w3m-antenna-site-size-detected (site) `(nth 6 ,site)) (defcustom w3m-antenna-file (expand-file-name ".antenna" w3m-profile-directory) "File which has list of antenna URLs." :group 'w3m-antenna :type 'file) (defcustom w3m-antenna-refresh-interval nil "Interval time to update (to refresh) the antenna page automatically. The value should be a positive integer in seconds, or nil which means not to update the page." :group 'w3m-antenna :type '(choice (const :tag "Not reload." nil) (integer :tag "Interval second."))) (defcustom w3m-antenna-sites (unless noninteractive (mapcar (lambda (site) (list (w3m-antenna-site-key site) (w3m-antenna-site-title site) (w3m-antenna-site-class site))) (w3m-load-list w3m-antenna-file))) "List of WEB sites, watched by `w3m-antenna'." :group 'w3m-antenna :type `(repeat (group :indent 7 (w3m-antenna-string :format "URL: %v\n" :value-from w3m-antenna-tmp-url) (w3m-antenna-string :format "Title: %v\n" :value-from w3m-antenna-tmp-title) (choice :tag "Procedure" (const :tag "Check either its last modified time or its size" nil) (const :tag "Check its last modified time only" time) (const :tag "Check its current date provided by Hyper Nikki System" hns) (list :tag "Check RSS" (function-item :format "" w3m-antenna-check-rss) (string :format "URL: %v\n" :value "")) (list :tag "Check the another changelog page" (function-item :format "" w3m-antenna-check-another-page) (string :format "URL: %v\n" :value "")) (list :tag "Check the page linked by the anchor that matches" (function-item :format "" w3m-antenna-check-anchor) (regexp :value "") (integer :value 0)) (cons :tag "Check with a user defined function" (w3m-antenna-function :match (lambda (widget value) (and (functionp value) (not (memq value '(w3m-antenna-check-rss w3m-antenna-check-another-page w3m-antenna-check-anchor)))))) (repeat :tag "Arguments" sexp)))))) (defcustom w3m-antenna-html-skelton (eval-when-compile (concat "\n" "\n\nAntenna\n%R\n\n" "

Antenna

\n

Checked at %D.

\n" "

Updated

\n
    \n%C
\n" "

Visited

\n
    \n%U
\n" "\n\n")) "HTML skelton of antenna." :group 'w3m-antenna :type 'string) (defcustom w3m-antenna-make-summary-function 'w3m-antenna-make-summary-like-natsumican "Function to make summary of site information." :group 'w3m-antenna :type '(choice :format "%{%t%}:\n %[Value Menu%] %v" (function-item :tag "Simple style." w3m-antenna-make-summary) (function-item :tag "Natsumican style." w3m-antenna-make-summary-like-natsumican) (function :format "User function: %v\n"))) (defcustom w3m-antenna-sort-changed-sites-function 'w3m-antenna-sort-sites-by-time "Function to sort list of changed sites." :group 'w3m-antenna :type '(choice :format "%{%t%}:\n %[Value Menu%] %v" (function-item :tag "Sort by last modification time." w3m-antenna-sort-sites-by-time) (function-item :tag "Sort by title." w3m-antenna-sort-sites-by-title) (function-item :tag "Do nothing." identity) (function :format "User function: %v\n"))) (defcustom w3m-antenna-sort-unchanged-sites-function 'w3m-antenna-sort-sites-by-time "Function to sort list of unchanged sites." :group 'w3m-antenna :type '(choice :format "%{%t%}:\n %[Value Menu%] %v" (function-item :tag "Sort by last modification time." w3m-antenna-sort-sites-by-time) (function-item :tag "Sort by title." w3m-antenna-sort-sites-by-title) (function-item :tag "Do nothing." identity) (function :format "User function: %v\n"))) (defun w3m-antenna-alist () (let ((alist (w3m-load-list w3m-antenna-file))) (mapcar (lambda (site) (let ((l (assoc (w3m-antenna-site-key site) alist))) (if l (progn (setf (w3m-antenna-site-class l) (w3m-antenna-site-class site)) l) (append site (list nil nil nil nil))))) w3m-antenna-sites))) (defun w3m-antenna-hns-last-modified (url handler) (w3m-process-do-with-temp-buffer (type (w3m-retrieve (w3m-expand-url "di.cgi" url) nil t nil nil handler)) (when type (or (let (start str) ;; Process a line such as "Tue, 27 Mar 2001 12:43:16 GMT
". (goto-char (point-min)) (and (search-forward "\nLast-Modified: " nil t) (setq start (match-end 0)) (search-forward "
" nil t) (setq str (buffer-substring start (match-beginning 0))) ;; Ignore format such as "2001, 27 03 GMT", which is used ;; by old HNS. (not (string-match " *[0-9][0-9][0-9][0-9], +[0-9][0-9] +[0-9][0-9] +" str)) (w3m-time-parse-string str))) (progn ;; Process a line such as "newest day is 2001/03/15". (goto-char (point-min)) (and (re-search-forward "\ ^newest day is \\([0-9][0-9][0-9][0-9]\\)/\\([0-9][0-9]\\)/\\([0-9][0-9]\\)$" nil t) (encode-time 0 0 0 (string-to-number (match-string 3)) (string-to-number (match-string 2)) (string-to-number (match-string 1)) 32400))))))) (defun w3m-antenna-check-hns (site handler) "Check the page served by HNS (Hyper Nikki System) asynchronously." (lexical-let ((site site)) (w3m-process-do (time (w3m-antenna-hns-last-modified (w3m-antenna-site-key site) handler)) (if time (w3m-antenna-site-update site (w3m-antenna-site-key site) time nil) (w3m-antenna-check-page site handler))))) (defun w3m-antenna-check-rss (site handler url) "Check RSS to detect change of SITE asynchronously. In order to use this function, `xml.el' is required." (lexical-let ((url url) (site site)) (w3m-process-do-with-temp-buffer (type (w3m-retrieve url nil t nil nil handler)) (let (link date dates) (when type (w3m-decode-buffer url) (let* ((xml (ignore-errors (xml-parse-region (point-min) (point-max)))) (dc-ns (w3m-rss-get-namespace-prefix xml "http://purl.org/dc/elements/1.1/")) (rss-ns (w3m-rss-get-namespace-prefix xml "http://purl.org/rss/1.0/")) (channel (car (w3m-rss-find-el (intern (concat rss-ns "channel")) xml))) (items (w3m-rss-find-el (intern (concat rss-ns "item")) xml))) (setq link (nth 2 (car (w3m-rss-find-el (intern (concat rss-ns "link")) channel)))) (setq dates (append (w3m-rss-find-el (intern (concat dc-ns "date")) channel) (w3m-rss-find-el (intern (concat dc-ns "date")) items) (w3m-rss-find-el 'pubDate channel) (w3m-rss-find-el 'pubDate items))) (when dates ;; Ignore future entries to display site announcements. (let ((now (current-time))) (let ((low (+ (nth 1 now) 3600))) ; 3600 = clock skew margin (setq now (if (>= low 65536) (list (1+ (car now)) (- low 65536) (nth 2 now)) (list (car now) low (nth 2 now))))) (setq date '(0 0)) (dolist (tmp dates) (setq tmp (w3m-rss-parse-date-string (nth 2 tmp))) (and (w3m-time-newer-p tmp date) (w3m-time-newer-p now tmp) (setq date tmp))))))) (if (and link date) (w3m-antenna-site-update site link date nil) (w3m-antenna-check-page site handler)))))) (defun w3m-antenna-check-another-page (site handler url) "Check the another page to detect change of SITE asynchronously. This function checks the another page specified by the URL before checking the SITE itself. This function is useful when the SITE's owner either maintains the page which describes the change of the SITE." (lexical-let ((site site)) (w3m-process-do-with-temp-buffer (time (w3m-last-modified url t handler)) (if time (w3m-antenna-site-update site (w3m-antenna-site-key site) time nil) (w3m-antenna-check-page site handler))))) (defun w3m-antenna-check-anchor (site handler regexp number) "Check the page linked from SITE asynchronously. This function checks the page linked by an anchor that matches REGEXP from the page that is specified by SITE's key attribute." (lexical-let ((site site) (regexp regexp) (number (or number 0))) (w3m-process-do-with-temp-buffer (type (w3m-retrieve (w3m-antenna-site-key site) nil nil nil nil handler)) (w3m-antenna-check-page site handler (when type (w3m-decode-buffer (w3m-antenna-site-key site)) (goto-char (point-min)) (when (re-search-forward regexp nil t) (w3m-expand-url (match-string number) (w3m-antenna-site-key site)))))))) ;; To avoid byte-compile warning. (eval-and-compile (autoload 'w3m-filter "w3m-filter")) (defun w3m-antenna-check-page (site handler &optional url) "Check SITE with the generic procedure. It consists of 3 steps: \(1\) Check the time when the SITE was last modified with HEAD request. \(2\) Check the size of the SITE with HEAD request. \(3\) Get the real content of the SITE, and check its size. " (lexical-let ((site site) (url (or url (w3m-antenna-site-url site) (w3m-antenna-site-key site)))) (w3m-process-do (attr (w3m-attributes url t handler)) (when attr (if (nth 4 attr) ; Use the value of Last-modified header. (w3m-antenna-site-update site url (nth 4 attr) (nth 2 attr)) (unless (eq 'time (w3m-antenna-site-class site)) (if (nth 2 attr) ; Use the value of Content-Length header. (w3m-antenna-site-update site url nil (nth 2 attr)) ;; Get the real content of the SITE, and calculate its size. (w3m-process-do-with-temp-buffer (type (w3m-retrieve url nil t nil nil handler)) (when type (w3m-decode-buffer url nil type) (w3m-remove-comments) (when w3m-use-filter (w3m-filter url)) (w3m-antenna-site-update site url nil (buffer-size))))))))))) (defun w3m-antenna-site-update (site url time size) "Update SITE's status information with specified TIME and SIZE." ;; (w3m-antenna-site-size-detected site) keeps the time when SITE's ;; size attribute is checked. (setf (w3m-antenna-site-size-detected site) (when size (or (when (and url (w3m-antenna-site-url site) (string= url (w3m-antenna-site-url site)) (w3m-antenna-site-size site) (= size (w3m-antenna-site-size site))) (w3m-antenna-site-size-detected site)) (current-time)))) (setf (w3m-antenna-site-url site) url) (setf (w3m-antenna-site-last-modified site) time) (setf (w3m-antenna-site-size site) size) site) (defun w3m-antenna-check-site (site handler) "Check SITE asynchronously. If a class attribute of the SITE is a list that consists of a function to check SITE and its options, call it. When a class attribute of the SITE is equal to the symbol `hns', call `w3m-antenna-check-hns'. Otherwise, call `w3m-antenna-check-page'." (if (and (listp (w3m-antenna-site-class site)) (functionp (car (w3m-antenna-site-class site)))) (apply (car (w3m-antenna-site-class site)) site handler (cdr (w3m-antenna-site-class site))) (if (eq 'hns (w3m-antenna-site-class site)) (w3m-antenna-check-hns site handler) (w3m-antenna-check-page site handler (format-time-string (w3m-antenna-site-key site) (current-time)))))) (defun w3m-antenna-mapcar (function sequence handler) "Apply FUNCTION to each element of SEQUENCE asynchronously, and make a list of the results." (let ((index -1) (table (make-symbol "table")) (buffer (make-symbol "buffer"))) (set table (make-vector (length sequence) nil)) (set buffer (current-buffer)) (dolist (element sequence) (aset (symbol-value table) (incf index) (funcall function element (cons `(lambda (x) (aset ,table ,index x) (w3m-antenna-mapcar-after ,table ,buffer)) handler)))) (w3m-antenna-mapcar-after (symbol-value table) (symbol-value buffer)))) (defun w3m-antenna-mapcar-after (result buffer) "Handler function of `w3m-antenna-mapcar'. If all asynchronous processes have finished, return a list of the results for the further handler functions. Otherwise, return an asynchronous process that has not finished yet." (or (catch 'found-proces (let ((index -1)) (while (< (incf index) (length result)) (when (w3m-process-p (aref result index)) (throw 'found-proces (aref result index)))))) (progn (set-buffer buffer) (append result nil)))) (defun w3m-antenna-check-all-sites (&optional handler) "Check all sites specified in `w3m-antenna-sites'." (unless w3m-antenna-alist (setq w3m-antenna-alist (w3m-antenna-alist))) (if (not handler) (w3m-process-with-wait-handler (w3m-antenna-check-all-sites handler)) (w3m-process-do (result (w3m-antenna-mapcar 'w3m-antenna-check-site w3m-antenna-alist handler)) (prog1 w3m-antenna-alist (w3m-save-list w3m-antenna-file w3m-antenna-alist) (setq w3m-antenna-alist nil))))) (defun w3m-antenna-make-summary (site) (format "
  • %s %s" (or (w3m-antenna-site-url site) (w3m-antenna-site-key site)) (w3m-antenna-site-title site) (cond ((w3m-antenna-site-last-modified site) (current-time-string (w3m-antenna-site-last-modified site))) ((w3m-antenna-site-size site) "Size") (t "")))) (defun w3m-antenna-make-summary-like-natsumican (site) (let ((t1 (w3m-antenna-site-last-modified site)) (t2 (w3m-antenna-site-size-detected site))) (format "
  • %20s  (%s)  %s" (if (or t1 t2) (format-time-string "%Y/%m/%d %R" (or t1 t2)) "----/--/-- --:--") (cond (t1 "T") (t2 "S") (t "?")) (or (w3m-antenna-site-url site) (w3m-antenna-site-key site)) (w3m-antenna-site-title site)))) (defun w3m-antenna-sort-sites-by-time (sites) (sort sites (lambda (a b) (w3m-time-newer-p (or (w3m-antenna-site-last-modified a) (w3m-antenna-site-size-detected a)) (or (w3m-antenna-site-last-modified b) (w3m-antenna-site-size-detected b)))))) (defun w3m-antenna-sort-sites-by-title (sites) (sort sites (lambda (a b) (string< (w3m-antenna-site-title a) (w3m-antenna-site-title b))))) (defun w3m-antenna-make-contents (changed-sites unchanged-sites) (insert w3m-antenna-html-skelton) (goto-char (point-min)) (while (re-search-forward "%\\(.\\)" nil t) (let ((c (char-after (match-beginning 1)))) (cond ((memq c '(?C ?U)) (save-restriction (narrow-to-region (match-beginning 0) (match-end 0)) (delete-region (point-min) (point-max)) (goto-char (point-min)) (dolist (site (if (eq c ?C) changed-sites unchanged-sites)) (insert (funcall w3m-antenna-make-summary-function site) "\n")) (goto-char (point-max)))) ((eq c '?D) (goto-char (match-beginning 0)) (delete-region (match-beginning 0) (match-end 0)) (insert (let ((time (nth 5 (file-attributes w3m-antenna-file)))) (if time (current-time-string time) "(unknown)")))) ((eq c '?R) (save-restriction (narrow-to-region (match-beginning 0) (match-end 0)) (delete-region (point-min) (point-max)) (when (and w3m-antenna-refresh-interval (integerp w3m-antenna-refresh-interval) (< 0 w3m-antenna-refresh-interval)) (insert (format "\n" w3m-antenna-refresh-interval))))))))) ;;;###autoload (defun w3m-about-antenna (url &optional no-decode no-cache post-data referer handler) (w3m-process-do (alist (if no-cache (w3m-antenna-check-all-sites handler) (or w3m-antenna-alist (w3m-antenna-alist)))) (let (changed unchanged) (dolist (site alist) (if (w3m-time-newer-p (or (w3m-antenna-site-last-modified site) (w3m-antenna-site-size-detected site)) (or (w3m-arrived-last-modified (w3m-antenna-site-url site)) (w3m-arrived-time (w3m-antenna-site-url site)))) (progn (w3m-cache-remove (w3m-antenna-site-url site)) (push site changed)) (push site unchanged))) (w3m-antenna-make-contents (funcall w3m-antenna-sort-changed-sites-function (nreverse changed)) (funcall w3m-antenna-sort-unchanged-sites-function (nreverse unchanged))) "text/html"))) ;;;###autoload (defun w3m-antenna (&optional no-cache) "Report changes of WEB sites, which is specified in `w3m-antenna-sites'." (interactive "P") (w3m-goto-url "about://antenna/" no-cache)) (defvar w3m-antenna-tmp-url nil) (defvar w3m-antenna-tmp-title nil) (defun w3m-antenna-add-current-url (&optional arg) "Add link of current page to antenna. With prefix, ask new url to add instead of current page." (interactive "P") (w3m-antenna-add (if arg (w3m-input-url) w3m-current-url) (w3m-encode-specials-string w3m-current-title))) (defun w3m-antenna-add (url &optional title) "Add URL to antenna. Optional argument TITLE is title of link." (setq w3m-antenna-tmp-url url) (setq w3m-antenna-tmp-title title) (customize-variable 'w3m-antenna-sites) ;; dirty... (goto-char (point-max)) (re-search-backward "INS") (widget-button-press (point)) (re-search-forward "State:\\|\\(\\[State\\]:\\)") (backward-char (if (match-beginning 1) 3 2))) (defvar w3m-antenna-mode-map (let ((map (make-sparse-keymap))) (substitute-key-definition 'w3m-edit-current-url 'w3m-antenna-edit map w3m-mode-map) map) "*Keymap for `w3m-antenna-mode'.") (defvar w3m-antenna-mode nil "Non-nil if w3m antenna mode is enabled.") (make-variable-buffer-local 'w3m-antenna-mode) (unless (assq 'w3m-antenna-mode minor-mode-alist) (push (list 'w3m-antenna-mode " antenna") minor-mode-alist)) (unless (assq 'w3m-antenna-mode minor-mode-map-alist) (push (cons 'w3m-antenna-mode w3m-antenna-mode-map) minor-mode-map-alist)) (defun w3m-antenna-mode (&optional arg) "\\ Minor mode to edit antenna. \\[w3m-antenna-edit] Customize `w3m-antenna-sites'. " (interactive "P") (when (setq w3m-antenna-mode (if arg (> (prefix-numeric-value arg) 0) (not w3m-antenna-mode))) (run-hooks 'w3m-antenna-mode-hook))) (defun w3m-antenna-mode-setter (url) "Activate `w3m-antenna-mode', when visiting page shows antenna." (w3m-antenna-mode (if (string-match "\\`about://antenna/" url) (progn (setq default-directory (file-name-directory w3m-antenna-file)) 1) 0))) (add-hook 'w3m-display-functions 'w3m-antenna-mode-setter) (defun w3m-antenna-edit () "Start customize of `w3m-antenna-sites'." (interactive) (customize-variable 'w3m-antenna-sites)) (provide 'w3m-antenna) ;;; w3m-antenna.el ends here w3m-el-snapshot-1.4.609+0.20171225.orig/w3m-search.el0000644000000000000000000003131213215724236017626 0ustar rootroot;;; w3m-search.el --- functions convenient to access web search engines ;; Copyright (C) 2001--2012, 2017 TSUCHIYA Masatoshi ;; Authors: Keisuke Nishida , ;; Shun-ichi GOTO , ;; TSUCHIYA Masatoshi , ;; Romain FRANCOISE ;; 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 contains the `w3m-search' command and some utilities ;; to improve your cyberlife. For more detail about emacs-w3m, see: ;; ;; http://emacs-w3m.namazu.org/ ;;; Code: (eval-when-compile (require 'cl)) (require 'w3m) (defcustom w3m-search-engine-alist (let* ((ja (equal "Japanese" w3m-language)) (utf-8 (or (and (boundp 'mule-version) (not (string< (symbol-value 'mule-version) "6.0"))) (featurep 'un-define) (fboundp 'utf-translate-cjk-mode) (and (not ja) (w3m-find-coding-system 'utf-8))))) `(,@(if ja '(("yahoo" "https://search.yahoo.co.jp/bin/search?p=%s" euc-japan) ("yahoo-en" "https://search.yahoo.com/bin/search?p=%s")) '(("yahoo" "https://search.yahoo.com/bin/search?p=%s") ("yahoo-ja" "https://search.yahoo.co.jp/bin/search?p=%s" euc-japan))) ("alc" "https://eow.alc.co.jp/%s/UTF-8/" utf-8) ,@(cond ((and ja utf-8) '(("blog" "https://blogsearch.google.com/blogsearch?q=%s&hl=ja&lr=lang_ja&oe=utf-8&ie=utf-8" utf-8) ("blog-en" "https://blogsearch.google.com/blogsearch?q=%s&hl=en&oe=utf-8&ie=utf-8" utf-8))) (ja '(("blog" "https://blogsearch.google.com/blogsearch?q=%s&hl=ja&lr=lang_ja&ie=Shift_JIS&oe=Shift_JIS" shift_jis) ("blog-en" "https://blogsearch.google.com/blogsearch?q=%s&hl=en"))) (utf-8 '(("blog" "https://blogsearch.google.com/blogsearch?q=%s&oe=utf-8&ie=utf-8" utf-8) ("blog-en" "https://blogsearch.google.com/blogsearch?q=%s&hl=en&oe=utf-8&ie=utf-8" utf-8))) (t '(("blog" "https://blogsearch.google.com/blogsearch?q=%s") ("blog-ja" "https://blogsearch.google.com/blogsearch?q=%s&lr=lang_ja&ie=Shift_JIS&oe=Shift_JIS" shift_jis)))) ,@(cond ((and ja utf-8) '(("google" "https://www.google.com/search?q=%s&hl=ja&lr=lang_ja&ie=utf-8&oe=utf-8" utf-8) ("google-en" "https://www.google.com/search?q=%s&hl=en&ie=utf-8&oe=utf-8" utf-8))) (ja '(("google" "https://www.google.com/search?q=%s&hl=ja&lr=lang_ja&ie=Shift_JIS&oe=Shift_JIS" shift_jis) ("google-en" "https://www.google.com/search?q=%s&hl=en"))) (utf-8 '(("google" "https://www.google.com/search?q=%s&ie=utf-8&oe=utf-8" utf-8) ("google-en" "https://www.google.com/search?q=%s&hl=en&ie=utf-8&oe=utf-8" utf-8))) (t '(("google" "https://www.google.com/search?q=%s") ("google-ja" "https://www.google.com/search?q=%s&hl=ja&lr=lang_ja&ie=Shift_JIS&oe=Shift_JIS" shift_jis)))) ,@(cond ((and ja utf-8) '(("google news" "https://news.google.co.jp/news?q=%s&hl=ja&ie=utf-8&oe=utf-8" utf-8) ("google news-en" "https://news.google.com/news?q=%s&hl=en"))) (ja '(("google news" "https://news.google.co.jp/news?q=%s&hl=ja&ie=Shift_JIS&oe=Shift_JIS" shift_jis) ("google news-en" "https://news.google.com/news?q=%s&hl=en"))) (utf-8 '(("google news" "https://news.google.com/news?q=%s&ie=utf-8&oe=utf-8" utf-8) ("google news-en" "https://news.google.com/news?q=%s&hl=en&ie=utf-8&oe=utf-8"))) (t '(("google news" "https://news.google.com/news?q=%s") ("google news-ja" "https://news.google.co.jp/news?q=%s&hl=ja&ie=Shift_JIS&oe=Shift_JIS" shift_jis)))) ,@(if ja '(("technorati" "https://www.technorati.jp/search/search.html?query=%s&language=ja" utf-8) ("technorati-en" "https://www.technorati.com/search/%s" utf-8)) '(("technorati" "https://www.technorati.com/search/%s" utf-8) ("technorati-ja" "https://www.technorati.jp/search/search.html?query=%s&language=ja" utf-8))) ("technorati-tag" "https://www.technorati.com/tag/%s" utf-8) ("goo-ja" "https://search.goo.ne.jp/web.jsp?MT=%s" euc-japan) ("excite-ja" "https://www.excite.co.jp/search.gw?target=combined&look=excite_jp\ &lang=jp&tsug=-1&csug=-1&search=%s" shift_jis) ("altavista" "https://altavista.com/sites/search/web?q=\"%s\"&kl=ja&search=Search") ("rpmfind" "https://rpmfind.net/linux/rpm2html/search.php?query=%s" nil) ("debian-pkg" "https://packages.debian.org/search\ ?&searchon=names&suite=stable§ion=all&arch=amd64&keywords=%s") ("debian-bts" "https://bugs.debian.org/cgi-bin/pkgreport.cgi?archive=yes&pkg=%s") ("freebsd-users-jp" "https://home.jp.FreeBSD.org/cgi-bin/namazu.cgi?key=\"%s\"&whence=0\ &max=50&format=long&sort=score&dbname=FreeBSD-users-jp" euc-japan) ("iij-archie" "https://www.iij.ad.jp/cgi-bin/archieplexform?query=%s\ &type=Case+Insensitive+Substring+Match&order=host&server=archie1.iij.ad.jp\ &hits=95&nice=Nice") ("waei" "https://dictionary.goo.ne.jp/search.php?MT=%s&kind=je" euc-japan) ("eiwa" "https://dictionary.goo.ne.jp/search.php?MT=%s&kind=ej") ("kokugo" "https://dictionary.goo.ne.jp/search.php?MT=%s&kind=jn" euc-japan) ("eiei" "https://www.dictionary.com/cgi-bin/dict.pl?term=%s&r=67") ,@(if ja '(("amazon" "https://www.amazon.co.jp/gp/search?\ __mk_ja_JP=%%83J%%83%%5E%%83J%%83i&url=search-alias%%3Daps&field-keywords=%s" shift_jis) ("amazon-en" "https://www.amazon.com/exec/obidos/search-handle-form/\ 250-7496892-7797857" iso-8859-1 "url=index=blended&field-keywords=%s")) '(("amazon" "https://www.amazon.com/exec/obidos/search-handle-form/\ 250-7496892-7797857" iso-8859-1 "url=index=blended&field-keywords=%s") ("amazon-ja" "https://www.amazon.co.jp/gp/search?\ __mk_ja_JP=%%83J%%83%%5E%%83J%%83i&url=search-alias%%3Daps&field-keywords=%s" shift_jis))) ("emacswiki" "https://www.emacswiki.org/cgi-bin/wiki?search=%s") ("en.wikipedia" "https://en.wikipedia.org/wiki/Special:Search?search=%s") ("de.wikipedia" "https://de.wikipedia.org/wiki/Spezial:Search?search=%s" utf-8) ("ja.wikipedia" "https://ja.wikipedia.org/wiki/Special:Search?search=%s" utf-8) ("msdn" "https://search.msdn.microsoft.com/search/default.aspx?query=%s") ("duckduckgo" "https://duckduckgo.com/?q=%s" utf-8))) "*An alist of search engines. Each element looks like (ENGINE ACTION CODING POST-DATA) ENGINE is a string, the name of the search engine. ACTION is a string, the URL that performs a search. ACTION must contain a \"%s\", which is substituted by a query string. CODING is optional value which is coding system for query string. POST-DATA is optional value which is a string for POST method search engine. If CODING is omitted, it defaults to `w3m-default-coding-system'." :group 'w3m :type `(repeat (group :indent 2 (string :format "Engine: %v\n") (string :format " Action: %v\n") (coding-system :format "%t: %v\n") (checklist :inline t :entry-format ,(if (w3m-device-on-window-system-p) "%b %v" "%b %v") (string :format "PostData: %v\n"))))) (defcustom w3m-search-default-engine "google" "*Name of the default search engine. See also `w3m-search-engine-alist'." :group 'w3m :type 'string) (defcustom w3m-search-word-at-point t "*Non-nil means that the word at point is used as an initial string. If Transient Mark mode, this option is ignored and the region is used as an initial string." :group 'w3m :type 'boolean) (defvar w3m-search-engine-history nil "History variable used by `w3m-search' for prompting a search engine.") (defvar w3m-search-thing-at-point-arg 'word "Argument for `thing-at-point' used in `w3m-search-read-query'") (defun w3m-search-escape-query-string (str &optional coding) (mapconcat (lambda (s) (w3m-url-encode-string s coding)) (split-string str) "+")) (defun w3m-search-read-query (prompt prompt-with-default &optional history) "Read a query from the minibuffer, prompting with string PROMPT. When a default value for the query is discovered, prompt with string PROMPT-WITH-DEFAULT instead of string PROMPT." (let ((default (if (w3m-region-active-p) (buffer-substring (region-beginning) (region-end)) (unless (and (eq major-mode 'w3m-mode) (listp (get-text-property (point-at-bol) 'face)) (memq 'w3m-header-line-location-title (get-text-property (point-at-bol) 'face))) (thing-at-point w3m-search-thing-at-point-arg)))) initial) (when default (set-text-properties 0 (length default) nil default) (when (or w3m-search-word-at-point (w3m-region-active-p)) (setq initial default default nil)) (when (w3m-region-active-p) (w3m-deactivate-region))) (read-string (if default (format prompt-with-default default) prompt) initial history default))) (defun w3m-search-read-variables (where) "Ask for a search engine and words to query and return them as a list. WHERE is a string which should have the value \"current\" is the calling function intends for the search results to be presented in the current buffer, or \"new\" if in a new buffer." (when w3m-current-process (error "%s" (substitute-command-keys " Cannot run two w3m processes simultaneously \ \(Type `\\\\[w3m-process-stop]' to stop asynchronous process)"))) (let* ((prompt-prefix (format "Search in %s buffer. " where)) (search-engine (if current-prefix-arg (let ((default (or (car w3m-search-engine-history) w3m-search-default-engine)) (completion-ignore-case t)) (completing-read (format "%sWhich engine? (default %s): " prompt-prefix default) w3m-search-engine-alist nil t nil 'w3m-search-engine-history default)) w3m-search-default-engine)) (query (w3m-search-read-query (format "%s %s search: " prompt-prefix search-engine) (format "%s search (default %%s): " search-engine)))) (list search-engine query))) (defun w3m-search-do-search (w3m-goto-function search-engine query) "Call W3M-GOTO-FUNCTION with the URL for the search." (unless (string= query "") (let ((info (assoc search-engine w3m-search-engine-alist))) (if info (let ((query-string (w3m-search-escape-query-string query (caddr info))) (post-data (cadddr info))) (w3m-history-store-position) (funcall w3m-goto-function (format (cadr info) query-string) post-data nil (and post-data (format post-data query-string)))) (error "Unknown search engine: %s" search-engine))))) ;;;###autoload (defun w3m-search (search-engine query) "Search QUERY using SEARCH-ENGINE. Search results will appear in the current buffer. When called interactively with a prefix argument, you can choose one of the search engines defined in `w3m-search-engine-alist'. Otherwise use `w3m-search-default-engine'. If Transient Mark mode, use the region as an initial string of query and deactivate the mark." (interactive (w3m-search-read-variables "current")) (w3m-search-do-search 'w3m-goto-url search-engine query)) ;;;###autoload (defun w3m-search-new-session (search-engine query) "Like `w3m-search', but do the search in a new buffer." (interactive (w3m-search-read-variables "new")) (w3m-search-do-search 'w3m-goto-url-new-session search-engine query)) ;;;###autoload (defun w3m-search-uri-replace (uri engine) "Generate query string for ENGINE from URI matched by last search." (let ((query (substring uri (match-end 0))) (info (assoc engine w3m-search-engine-alist))) (when info (format (cadr info) (w3m-search-escape-query-string query (caddr info)))))) (provide 'w3m-search) ;;; w3m-search.el ends here w3m-el-snapshot-1.4.609+0.20171225.orig/w3m-symbol.el0000644000000000000000000002100713127150703017660 0ustar rootroot;;; w3m-symbol.el --- Stuffs to replace symbols for emacs-w3m -*- coding: iso-2022-7bit; -*- ;; Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2009, 2017 ;; ARISAWA Akihiro ;; Author: ARISAWA Akihiro ;; Keywords: w3m, WWW, hypermedia, i18n ;; This file 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 file 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: ;; ;;; Code: (eval-when-compile (require 'cl)) (eval-when-compile (defvar w3m-output-coding-system) (defvar w3m-language) (defvar w3m-use-symbol) (autoload 'w3m-mule-unicode-p "w3m")) (defgroup w3m-symbol nil "Symbols for w3m" :group 'w3m) (defvar w3m-symbol-custom-type '(list :convert-widget w3m-widget-type-convert-widget (let* ((w `(sexp :match (lambda (widget value) (stringp value)) :size 4 :value "" ,@(if (not (widget-get widget :copy)) ;; Emacs versions prior to 22. '(:value-to-internal (lambda (widget value) (if (string-match "\\`\".*\"\\'" value) value (prin1-to-string value))))))) (a `(,@w :format "%v ")) (b `(,@w :format "%v\n")) (c (list a a a a a a a b)) (d (list a a a a a b))) `(:indent 4 :tag "Customize" ,@c ,@c ,@c ,@c ,@d ,@d ,b ,b)))) (defcustom w3m-default-symbol '("-+" " |" "--" " +" "-|" " |" "-+" "" "--" " +" "--" "" "-+" "" "" "" "-+" " |" "--" " +" "-|" " |" "-+" "" "--" " +" "--" "" "-+" "" "" "" " *" " +" " o" " #" " @" " -" " =" " x" " %" " *" " o" " #" " #" "<=UpDn ") "List of symbol string, used by defaultly." :group 'w3m-symbol :type w3m-symbol-custom-type) (defcustom w3m-Chinese-BIG5-symbol '("$(0#3(B" "$(0#7(B" "$(0#5(B" "$(0#<(B" "$(0#6(B" "$(0#:(B" "$(0#=(B" "" "$(0#4(B" "$(0#>(B" "$(0#9(B" "" "$(0#?(B" "" "" "" "$(0#3(B" "$(0#7(B" "$(0#5(B" "$(0#<(B" "$(0#6(B" "$(0#:(B" "$(0#=(B" "" "$(0#4(B" "$(0#>(B" "$(0#9(B" "" "$(0#?(B" "" "" "" "$(0!&(B" "$(0!{(B" "$(0!w(B" "$(0!r(B" "$(0!|(B" "$(0!x(B" "$(0!v(B" "$(0!s(B" "$(0!t(B" "$(0!s(B" "$(0!r(B" "$(0!{(B" "$(0!s(B" "$(0!N"U"V(B") "List of symbol string, used in Chienese-BIG5 environment." :group 'w3m-symbol :type w3m-symbol-custom-type) (defcustom w3m-Chinese-CNS-symbol '("$(G#3(B" "$(G#7(B" "$(G#5(B" "$(G#<(B" "$(G#6(B" "$(G#:(B" "$(G#=(B" "" "$(G#4(B" "$(G#>(B" "$(G#9(B" "" "$(G#?(B" "" "" "" "$(G#3(B" "$(G#7(B" "$(G#5(B" "$(G#<(B" "$(G#6(B" "$(G#:(B" "$(G#=(B" "" "$(G#4(B" "$(G#>(B" "$(G#9(B" "" "$(G#?(B" "" "" "" "$(G!&(B" "$(G!{(B" "$(G!w(B" "$(G!r(B" "$(G!|(B" "$(G!x(B" "$(G!v(B" "$(G!s(B" "$(G!t(B" "$(G!s(B" "$(G!r(B" "$(G!{(B" "$(G!s(B" "$(G!N"U"V(B") "List of symbol string, used in Chienese-CNS environment." :group 'w3m-symbol :type w3m-symbol-custom-type) (defcustom w3m-Chinese-GB-symbol '("$A)`(B" "$A)@(B" "$A)P(B" "$A)0(B" "$A)H(B" "$A)&(B" "$A)4(B" "" "$A)X(B" "$A)8(B" "$A)$(B" "" "$A)<(B" "" "" "" "$A)`(B" "$A)D(B" "$A)S(B" "$A)3(B" "$A)L(B" "$A)'(B" "$A)7(B" "" "$A)[(B" "$A);(B" "$A)%(B" "" "$A)?(B" "" "" "" "$A!$(B" "$A!u(B" "$A!n(B" "$A!p(B" "$A!v(B" "$A!o(B" "$A!r(B" "$A!q(B" "$A!w(B" "$A!q(B" "$A!p(B" "$A!u(B" "$A!q(B" "$A!6!|!}(B") "List of symbol string, used in Chienese-GB environment." :group 'w3m-symbol :type w3m-symbol-custom-type) (defcustom w3m-Japanese-symbol '("$B(+(B" "$B('(B" "$B(((B" "$B(#(B" "$B()(B" "$B("(B" "$B($(B" "" "$B(*(B" "$B(&(B" "$B(!(B" "" "$B(%(B" "" "" "" "$B(+(B" "$B(7(B" "$B(8(B" "$B(.(B" "$B(9(B" "$B(-(B" "$B(/(B" "" "$B(:(B" "$B(1(B" "$B(,(B" "" "$B(0(B" "" "" "" "$B!&(B" "$B""(B" "$B!y(B" "$B!{(B" "$B"#(B" "$B!z(B" "$B!}(B" "$B!|(B" "$B"$(B" "$B!|(B" "$B!{(B" "$B""(B" "$B!|(B" "$B"c","-(B") "List of symbol string, used in Japanese environment." :group 'w3m-symbol :type w3m-symbol-custom-type) (defcustom w3m-Korean-symbol '("$(C&+(B" "$(C&'(B" "$(C&((B" "$(C&#(B" "$(C&)(B" "$(C&"(B" "$(C&$(B" "" "$(C&*(B" "$(C&&(B" "$(C&!(B" "" "$(C&%(B" "" "" "" "$(C&+(B" "$(C&7(B" "$(C&8(B" "$(C&.(B" "$(C&9(B" "$(C&-(B" "$(C&/(B" "" "$(C&:(B" "$(C&1(B" "$(C&,(B" "" "$(C&0(B" "" "" "" "$(C!$(B" "$(C!`(B" "$(C!Y(B" "$(C![(B" "$(C!a(B" "$(C!Z(B" "$(C!](B" "$(C!\(B" "$(C!b(B" "$(C!\(B" "$(C![(B" "$(C!`(B" "$(C!\(B" "$(C!l!h!i(B") "List of symbol string, used in Korean environment." :group 'w3m-symbol :type w3m-symbol-custom-type) (defcustom w3m-mule-unicode-symbol (when (w3m-mule-unicode-p) (append (mapcar (lambda (p) (if p (char-to-string (make-char (or (nth 2 p) 'mule-unicode-2500-33ff) (car p) (cadr p))) "")) '((32 92) (32 60) (32 76) (32 44) (32 68) (32 34) (32 48) nil (32 84) (32 52) (32 32) nil (32 56) nil nil nil (32 92) (32 64) (32 79) (32 47) (32 72) (32 35) (32 51) nil (32 87) (32 55) (32 33) nil (32 59) nil nil nil (115 34 mule-unicode-0100-24ff) (33 97) (34 102) (34 43) (33 96) (34 101) (34 46) (34 47) (33 115) (34 47) (34 43) (33 97) (34 47))) (list (format "%c %c %c " (make-char 'mule-unicode-0100-24ff 121 42) (make-char 'mule-unicode-0100-24ff 118 113) (make-char 'mule-unicode-0100-24ff 118 115))))) "List of symbol string, using mule-unicode characters." :group 'w3m-symbol :type (if (w3m-mule-unicode-p) w3m-symbol-custom-type '(const :format "%{%t%}: %v"))) (defcustom w3m-symbol nil "List of symbol string." :group 'w3m-symbol :type `(radio (const :format "Auto detect " nil) (const :tag "Default" w3m-default-symbol) (const :format "Chinese BIG5 " w3m-Chinese-BIG5-symbol) (const :format "Chinese CNS " w3m-Chinese-CNS-symbol) (const :tag "Chinese GB" w3m-Chinese-GB-symbol) (const :format "Japanese " w3m-Japanese-symbol) (const :format "Korean " w3m-Korean-symbol) ,@(when w3m-mule-unicode-symbol '((const :tag "Mule-Unicode" w3m-mule-unicode-symbol))) (variable :format "%t symbol: %v\n" :value w3m-default-symbol) ,w3m-symbol-custom-type)) (defun w3m-use-symbol () (cond ((functionp w3m-use-symbol) (funcall w3m-use-symbol)) (t w3m-use-symbol))) (eval-when-compile (defvar current-language-environment)) (defun w3m-symbol () (cond (w3m-symbol (if (symbolp w3m-symbol) (symbol-value w3m-symbol) w3m-symbol)) ((and (eq w3m-output-coding-system 'utf-8) w3m-mule-unicode-symbol)) ((let ((lang (or w3m-language (and (boundp 'current-language-environment) current-language-environment ;; In XEmacs 21.5 it may be the one like ;; "Japanese (UTF-8)". (if (string-match "[\t ]+(" current-language-environment) (substring current-language-environment 0 (match-beginning 0)) current-language-environment))))) (when (boundp (intern (format "w3m-%s-symbol" lang))) (symbol-value (intern (format "w3m-%s-symbol" lang)))))) (t w3m-default-symbol))) ;;;###autoload (defun w3m-replace-symbol () (when (w3m-use-symbol) (let ((symbol-list (w3m-symbol))) (save-excursion (goto-char (point-min)) (while (re-search-forward "<_SYMBOL TYPE=\\([0-9]+\\)>" nil t) (let ((symbol (nth (string-to-number (match-string 1)) symbol-list)) (start (point)) end symbol-cnt) (search-forward "" nil t) (setq end (match-beginning 0) symbol-cnt (/ (string-width (buffer-substring start end)) (string-width symbol))) (goto-char start) (delete-region start end) (insert (apply 'concat (make-list symbol-cnt symbol))))))))) (provide 'w3m-symbol) ;;; w3m-symbol.el ends here w3m-el-snapshot-1.4.609+0.20171225.orig/aclocal.m40000644000000000000000000002262613213222142017166 0ustar rootrootAC_DEFUN(AC_SET_VANILLA_FLAG, [dnl Determine arguments to run Emacs as vanilla. retval=`echo "${EMACS}"| "${EGREP}" xemacs| "${EGREP}" -v '^$'` if test -z "${retval}"; then VANILLA_FLAG="-q -no-site-file" else VANILLA_FLAG="-vanilla" fi AC_SUBST(VANILLA_FLAG)]) AC_DEFUN(AC_SET_XEMACSDEBUG, [dnl Set the XEMACSDEBUG environment variable, which is eval'd when dnl XEmacs 21.5 starts, in order to suppress warnings for Lisp shadows dnl when XEmacs 21.5 starts. if test "${VANILLA_FLAG}" = "-vanilla"; then XEMACSDEBUG='XEMACSDEBUG='\''(setq log-warning-minimum-level (quote error))'\' else XEMACSDEBUG= fi AC_SUBST(XEMACSDEBUG)]) AC_DEFUN(AC_EMACS_LISP, [ elisp="$2" if test -z "$3"; then AC_MSG_CHECKING(for $1) fi AC_CACHE_VAL(EMACS_cv_SYS_$1,[ OUTPUT=./conftest-$$ dnl echo "${XEMACSDEBUG} '${EMACS}' ${VANILLA_FLAG} -batch -eval '(let ((x ${elisp})) (write-region (format \"%s\" x) nil \"${OUTPUT}\" nil 5))'" >&6 eval "${XEMACSDEBUG} '${EMACS}' ${VANILLA_FLAG} -batch -eval '(let ((x ${elisp})) (write-region (format \"%s\" x) nil \"${OUTPUT}\" nil 5))'" >& AC_FD_CC 2>&1 retval="`cat ${OUTPUT}`" echo "=> ${retval}" >& AC_FD_CC 2>&1 rm -f ${OUTPUT} EMACS_cv_SYS_$1="${retval}" ]) $1="${EMACS_cv_SYS_$1}" if test -z "$3"; then AC_MSG_RESULT($$1) fi ]) AC_DEFUN(AC_PATH_CYGWIN, [dnl Do `cygpath -u' for the given argument when running on Cygwin. $1=$2 if test x"${CYGPATH}" != xno -a -n "`echo $$1| ${EGREP} '^[[A-Za-z]]:'`"; then $1=`"${CYGPATH}" -u "$$1"` fi]) AC_DEFUN(AC_PATH_EMACS, [dnl Check for Emacsen. dnl Apparently, if you run a shell window or a term window in Emacs, dnl it sets the EMACS environment variable to 't' or a version number dnl of Emacs. Lets undo the damage. test "${EMACS}" = "t" -o -n "${INSIDE_EMACS}" && EMACS= dnl Ignore cache. unset ac_cv_prog_EMACS; unset EMACS_cv_SYS_flavor; AC_ARG_WITH(emacs, [ --with-emacs=EMACS compile with EMACS [EMACS=emacs, xemacs...]], [if test "${withval}" = yes -o -z "${withval}"; then AC_PATH_PROGS(EMACS, emacs xemacs, emacs) else AC_PATH_PROG(EMACS, ${withval}, ${withval}, emacs) fi]) AC_ARG_WITH(xemacs, [ --with-xemacs=XEMACS compile with XEMACS [XEMACS=xemacs]], [if test x$withval = xyes -o x$withval = x; then AC_PATH_PROG(EMACS, xemacs, xemacs, xemacs) else AC_PATH_PROG(EMACS, $withval, $withval, xemacs) fi]) test -z "${EMACS}" && AC_PATH_PROGS(EMACS, emacs xemacs, emacs) AC_SUBST(EMACS) AC_SET_VANILLA_FLAG AC_SET_XEMACSDEBUG AC_MSG_CHECKING([what a flavor does ${EMACS} have]) AC_EMACS_LISP(flavor, (if (featurep (quote xemacs)) \"XEmacs\" (concat \"Emacs \" (mapconcat (function identity) (nreverse (cdr (nreverse (split-string emacs-version (concat (vector 92 46)))))) \".\"))), noecho) case "${flavor}" in XEmacs) EMACS_FLAVOR=xemacs;; Emacs\ 2[[1-9]]\.*) EMACS_FLAVOR=emacs;; *) EMACS_FLAVOR=unsupported;; esac AC_MSG_RESULT(${flavor}) if test ${EMACS_FLAVOR} = unsupported; then AC_MSG_ERROR(${flavor} is not supported.) exit 1 fi]) AC_DEFUN(AC_EXAMINE_PACKAGEDIR, [dnl Examine PACKAGEDIR. AC_EMACS_LISP(PACKAGEDIR, (let ((prefix \"${prefix}\")\ (dirs (append\ (cond ((boundp (quote early-package-hierarchies))\ (append (if early-package-load-path\ early-package-hierarchies)\ (if late-package-load-path\ late-package-hierarchies)\ (if last-package-load-path\ last-package-hierarchies)))\ ((boundp (quote early-packages))\ (append (if early-package-load-path\ early-packages)\ (if late-package-load-path\ late-packages)\ (if last-package-load-path\ last-packages))))\ (if (and (boundp (quote configure-package-path))\ (listp configure-package-path))\ (delete \"\" configure-package-path))))\ package-dir)\ (while (and dirs (not package-dir))\ (if (file-directory-p (car dirs))\ (setq package-dir (car dirs)\ dirs (cdr dirs))))\ (if package-dir\ (progn\ (if (string-match \"/\$\" package-dir)\ (setq package-dir (substring package-dir 0\ (match-beginning 0))))\ (if (and prefix\ (progn\ (setq prefix (file-name-as-directory prefix))\ (eq 0 (string-match (regexp-quote prefix)\ package-dir))))\ (replace-match \"\$(prefix)/\" nil nil package-dir)\ package-dir))\ \"NONE\")), noecho)]) AC_DEFUN(AC_PATH_PACKAGEDIR, [dnl Check for PACKAGEDIR. if test ${EMACS_FLAVOR} = xemacs; then AC_MSG_CHECKING([where the XEmacs package is]) AC_ARG_WITH(packagedir, [ --with-packagedir=DIR package DIR for XEmacs], [if test "${withval}" = yes -o -z "${withval}"; then AC_EXAMINE_PACKAGEDIR else PACKAGEDIR="${withval}" fi], AC_EXAMINE_PACKAGEDIR) if test -z "${PACKAGEDIR}"; then AC_MSG_RESULT(not found) else AC_MSG_RESULT(${PACKAGEDIR}) fi else PACKAGEDIR=NONE fi AC_SUBST(PACKAGEDIR)]) AC_DEFUN(AC_PATH_LISPDIR, [ if test ${EMACS_FLAVOR} = emacs; then tribe=emacs else tribe=${EMACS_FLAVOR} fi AC_MSG_CHECKING([prefix for ${EMACS}]) if test "${prefix}" = NONE; then AC_EMACS_LISP(prefix,(expand-file-name \"..\" invocation-directory),noecho) AC_PATH_CYGWIN(prefix,"${EMACS_cv_SYS_prefix}") fi AC_MSG_RESULT(${prefix}) AC_ARG_WITH(lispdir, [ --with-lispdir=DIR where lisp files should go (use --with-packagedir for XEmacs package)], lispdir="${withval}") AC_MSG_CHECKING([where lisp files should go]) if test -z "${lispdir}"; then dnl Set the default value. theprefix="${prefix}" if test "${theprefix}" = NONE; then theprefix=${ac_default_prefix} fi lispdir="\$(datadir)/${tribe}/site-lisp/w3m" for thedir in share lib; do potential= dnl The directory name should be quoted because it might contain spaces. if test -d "${theprefix}/${thedir}/${tribe}/site-lisp"; then lispdir="\$(prefix)/${thedir}/${tribe}/site-lisp/w3m" break fi done fi if test ${EMACS_FLAVOR} = xemacs; then AC_MSG_RESULT(${lispdir}/ (it will be ignored when \"make install-package\" is done)) else AC_MSG_RESULT(${lispdir}/) fi AC_SUBST(lispdir)]) AC_DEFUN(AC_PATH_ICONDIR, [dnl Examin icon directory. dnl Ignore cache. unset EMACS_cv_SYS_icondir; if test ${EMACS_FLAVOR} = xemacs -o ${EMACS_FLAVOR} = emacs; then AC_ARG_WITH(icondir, [ --with-icondir=ICONDIR directory for icons [\$(data-directory)/images/w3m]], ICONDIR="${withval}") AC_MSG_CHECKING([where icon files should go]) if test -z "${ICONDIR}"; then dnl Set the default value. AC_EMACS_LISP(icondir, (let ((prefix \"${prefix}\")\ (default (expand-file-name \"images/w3m\" data-directory)))\ (if (and prefix\ (progn\ (setq prefix (file-name-as-directory prefix))\ (eq 0 (string-match (regexp-quote prefix) default))))\ (replace-match \"\$(prefix)/\" nil nil default)\ default)), ${prefix},noecho) AC_PATH_CYGWIN(ICONDIR,"${EMACS_cv_SYS_icondir}") fi if test ${EMACS_FLAVOR} = xemacs; then AC_MSG_RESULT(${ICONDIR}/ (it will be ignored when \"make install-package\" is done)) else AC_MSG_RESULT(${ICONDIR}) fi else ICONDIR=NONE fi AC_SUBST(ICONDIR)]) AC_DEFUN(AC_ADD_LOAD_PATH, [dnl Check for additional load path. AC_ARG_WITH(addpath, [ --with-addpath=PATHs specify additional PATHs for load-path use colons to separate directory names], [AC_MSG_CHECKING([where to find the additional elisp libraries]) if test "x${withval}" != xyes -a "x${withval}" != x; then ADDITIONAL_LOAD_PATH="${withval}" else if test x"$USER" != xroot -a x"$HOME" != x -a -f "$HOME"/.emacs; then ADDITIONAL_LOAD_PATH=`${XEMACSDEBUG} \'${EMACS}\' -batch -l \'$HOME/.emacs\' -l w3mhack.el NONE -f w3mhack-load-path 2>/dev/null | \'${EGREP}\' -v \'^$\'` else ADDITIONAL_LOAD_PATH=`${XEMACSDEBUG} \'${EMACS}\' -batch -l w3mhack.el NONE -f w3mhack-load-path 2>/dev/null | \'${EGREP}\' -v \'^$\'` fi fi AC_MSG_RESULT(${ADDITIONAL_LOAD_PATH})], ADDITIONAL_LOAD_PATH=NONE) AC_ARG_WITH(attic, [ --with-attic use attic libraries for compiling [default: no] (it does not mean installing attic libraries)], [if test "x${withval}" = xyes; then if test x"$ADDITIONAL_LOAD_PATH" = xNONE; then ADDITIONAL_LOAD_PATH="`pwd`/attic" else ADDITIONAL_LOAD_PATH="${ADDITIONAL_LOAD_PATH}:`pwd`/attic" fi fi]) retval=`eval "${XEMACSDEBUG} '${EMACS}' ${VANILLA_FLAG} -batch -l w3mhack.el '${ADDITIONAL_LOAD_PATH}' -f w3mhack-print-status 2>/dev/null | '${EGREP}' -v '^$'"` if test x"$retval" != xOK; then AC_MSG_ERROR([Process couldn't proceed. See the above messages.]) fi AC_SUBST(ADDITIONAL_LOAD_PATH)]) AC_DEFUN(AC_COMPRESS_INSTALL, [dnl Check for the `--with(out)-compress-install' option. AC_PATH_PROG(GZIP_PROG, gzip) AC_ARG_WITH(compress-install, [ --without-compress-install do not compress .el and .info files when installing], [if test "${withval}" = no; then COMPRESS_INSTALL=no; else if test -n "${GZIP_PROG}"; then COMPRESS_INSTALL=yes; else COMPRESS_INSTALL=no; fi; fi], [if test -n "${GZIP_PROG}"; then COMPRESS_INSTALL=yes; else COMPRESS_INSTALL=no; fi]) AC_SUBST(COMPRESS_INSTALL)]) w3m-el-snapshot-1.4.609+0.20171225.orig/w3m-perldoc.el0000644000000000000000000001007413127150703020005 0ustar rootroot;;; w3m-perldoc.el --- The add-on program to view Perl documents. ;; Copyright (C) 2001, 2002, 2003, 2004, 2005, 2007, 2017 ;; TSUCHIYA Masatoshi ;; Author: TSUCHIYA Masatoshi ;; Keywords: w3m, perldoc ;; 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-perldoc.el is the add-on program of emacs-w3m to view Perl ;; documents. For more detail about emacs-w3m, see: ;; ;; http://emacs-w3m.namazu.org/ ;;; Code: (require 'w3m) (defgroup w3m-perldoc nil "Perldoc front-end for emacs-w3m." :group 'w3m :prefix "w3m-perldoc-") (defcustom w3m-perldoc-command "perldoc" "*Name of the executable file of perldoc." :group 'w3m-perldoc :type 'string) (defcustom w3m-perldoc-pod2html-command "pod2html" "*Name of the executable file of pod2html." :group 'w3m-perldoc :type 'string) (defcustom w3m-perldoc-pod2html-arguments '("--noindex") "*Arguments of pod2html." :group 'w3m-perldoc :type '(repeat (string :format "Argument: %v\n")) :get (lambda (symbol) (delq nil (delete "" (mapcar (lambda (x) (if (stringp x) x)) (default-value symbol))))) :set (lambda (symbol value) (custom-set-default symbol (delq nil (delete "" (mapcar (lambda (x) (if (stringp x) x)) value)))))) (defcustom w3m-perldoc-input-coding-system (if (string= "Japanese" w3m-language) 'euc-japan (if (w3m-find-coding-system 'utf-8) 'utf-8 'iso-latin-1)) "*Coding system used when writing to `w3m-perldoc-command'." :group 'w3m-perldoc :type 'coding-system) (defcustom w3m-perldoc-output-coding-system 'undecided "*Coding system used when reading from `w3m-perldoc-command'." :group 'w3m-perldoc :type 'coding-system) ;;;###autoload (defun w3m-about-perldoc (url &optional no-decode no-cache &rest args) (when (string-match "\\`about://perldoc/" url) (let ((docname (if (= (length url) (match-end 0)) "perl" (w3m-url-decode-string (substring url (match-end 0))))) (default-directory w3m-profile-directory) (process-environment (copy-sequence process-environment))) ;; To specify the place in which pod2html generates its cache files. (setenv "HOME" (expand-file-name w3m-profile-directory)) (and (let ((coding-system-for-read w3m-perldoc-output-coding-system)) (zerop (call-process w3m-perldoc-command nil t nil "-u" docname))) (let ((coding-system-for-write w3m-perldoc-input-coding-system) (coding-system-for-read w3m-perldoc-input-coding-system)) (zerop (apply (function call-process-region) (point-min) (point-max) w3m-perldoc-pod2html-command t '(t nil) nil (append w3m-perldoc-pod2html-arguments '("--htmlroot=about://perldoc"))))) (let ((case-fold-search t)) (goto-char (point-min)) (while (re-search-forward "" nil t) (delete-region (match-beginning 2) (match-end 2)) (save-restriction (narrow-to-region (match-beginning 1) (match-end 1)) (while (search-backward "/" nil t) (delete-char 1) (insert "::")) (goto-char (point-max)))) "text/html"))))) ;;;###autoload (defun w3m-perldoc (docname) "View Perl documents." (interactive "sDocument: ") (w3m-goto-url (concat "about://perldoc/" (w3m-url-encode-string docname)))) (provide 'w3m-perldoc) ;;; w3m-perldoc.el ends here. w3m-el-snapshot-1.4.609+0.20171225.orig/w3m-mail.el0000644000000000000000000003434612226503757017321 0ustar rootroot;;; w3m-mail.el --- an interface to mail-user-agent for sending web pages ;; Copyright (C) 2006, 2009, 2010, 2013 TSUCHIYA Masatoshi ;; Author: 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 provides the `w3m-mail' command which enables you to ;; send web pages as mails respecting those content types (typically ;; text/html). Currently this program works if and only if you set ;; the `mail-user-agent' variable to one of the following agents: ;; `gnus-user-agent' ;; `message-user-agent' ;; `mew-user-agent' ;; `vm-user-agent' ;; `wl-user-agent' ;; To send the page you are looking at, type `M-x w3m-mail' or click ;; the menu button, fill message headers properly, and type `C-c C-c'. ;;; Code: (require 'w3m) (defcustom w3m-mail-subject '("Emailing:" url) "A list of strings and symbols used to generate the subject header. Valid symbols include `url' which is replaced with the url of the page and `title' which is replaced with the page title. You can also use just a string for this variable." :group 'w3m :type '(radio (editable-list :format "\n%v%i\n" (radio-button-choice (const :format "%v " url) (const :format "%v " title) string)) string (const :format "no subject" nil))) (defvar w3m-mail-user-agent-compose-function-alist (let ((alist '((gnus-user-agent . w3m-mail-compose-with-mml) (message-user-agent . w3m-mail-compose-with-mml) (mew-user-agent . w3m-mail-compose-with-mew) (vm-user-agent . w3m-mail-compose-with-vm) (wl-user-agent . w3m-mail-compose-with-semi))) composer) (delq nil (mapcar (lambda (agent) (if (setq composer (cdr (assq agent alist))) (cons agent composer))) w3m-mail-user-agents))) "Alist of mail user agents and functions to compose a mail. The function will be called with the arguments `source', `url', `charset', `content-type', `to', `subject', and `other-headers'; where `source' is a string containing the page source, `url' is the url of the page, `charset' is a charset that the page uses, `content-type' is the one such as \"text/html\", and the rest are the same as those of `compose-mail'.") (eval-when-compile (autoload 'message-add-action "message") (autoload 'mml-insert-empty-tag "mml") (autoload 'vm-mime-attach-buffer "vm-mime") (condition-case nil (require 'mime-edit) (error (dolist (symbol '(encode-mime-charset-region detect-mime-charset-region std11-wrap-as-quoted-string mime-find-file-type mime-edit-insert-tag mime-edit-define-encoding mime-encode-region)) (defalias symbol 'ignore))))) (eval-and-compile (autoload 'mm-find-mime-charset-region "mm-util") (autoload 'w3m-mail-compose-with-mew "mew-w3m" "Compose a mail using Mew." t)) (defun w3m-mail-make-subject () "Return a string used for the Subject header." (cond ((consp w3m-mail-subject) (w3m-replace-in-string (w3m-replace-in-string (mapconcat (lambda (elem) (cond ((eq elem 'url) w3m-current-url) ((eq elem 'title) w3m-current-title) ((stringp elem) elem) (t (format "%s" elem)))) w3m-mail-subject " ") "[\t\n ]+" " ") "\\(?:\\` \\| \\'\\)" "")) ((stringp w3m-mail-subject) w3m-mail-subject) (t "(no subject)"))) (defun w3m-mail-compute-base-url () "Compute a base url of the page if it is not provided." (let ((url (substring w3m-current-url 15))) (unless (string-match "\\`about:" url) (save-excursion (goto-char (point-min)) (let ((case-fold-search t) start end) (unless (and (setq start (search-forward "" nil t)) (setq end (search-forward "" nil t)) (progn (goto-char start) (re-search-forward " (length href) 0))) (substring (w3m-expand-url "x" url) 0 -1))))))) (defun w3m-mail-embed-base-url (source base-url) "Embed BASE-URL in SOURCE." (with-temp-buffer (w3m-static-unless (featurep 'xemacs) (set-buffer-multibyte t)) (setq case-fold-search t) (insert source) (goto-char (point-min)) (while (search-forward "\r\n" nil t) (replace-match "\n")) (goto-char (point-min)) (let ((nohead t) (points (list (point-min) (point-min))) (margin 0)) (when (re-search-forward "\\(\\)[\t\n ]*" nil t) (setq points (list (match-end 1) (match-end 0)) margin (current-column))) (when (re-search-forward "\\(\\)[\t\n ]*" nil t) (setq nohead nil points (list (match-end 1) (match-end 0)) margin (current-column))) (setq margin (make-string margin ? )) (goto-char (car points)) (apply 'delete-region points) (if nohead (insert "\n" margin "\n" margin) (insert "\n" margin "\n" margin))) (buffer-string))) (defun w3m-mail-goto-body-and-clear-body () "Go to the beginning of the body and clear the body." (goto-char (point-min)) (if (re-search-forward (concat "^\\(?:" (regexp-quote mail-header-separator) "\\)?\n") nil 'move) (delete-region (point) (point-max)) (insert (if (bolp) "\n" "\n\n")))) (defun w3m-mail-position-point (bob) "Go to empty or bogus header, otherwise the beginning of the body BOB." (goto-char (point-min)) (when (re-search-forward "^\\(Subject: \\)(no subject)\\|\ ^\\([0-9A-Za-z-]+: ?\\)[\t ]*\n\\(?:[\t ]+\n\\)*[^\t ]" bob 'move) (goto-char (or (match-end 1) (match-end 2))))) (defun w3m-mail-compose-with-mml (source url charset content-type to subject other-headers) "Compose a mail using MML." (let ((buffer (generate-new-buffer " *w3m-mail*"))) (with-current-buffer buffer (w3m-static-unless (featurep 'xemacs) (set-buffer-multibyte (not (string-match "\\`image/" content-type)))) (insert source)) (if (eq mail-user-agent 'gnus-user-agent) (progn (require 'gnus) (let (gnus-newsgroup-name) (compose-mail to subject other-headers))) (compose-mail to subject other-headers)) (message-add-action `(kill-buffer ,buffer) 'exit 'kill 'postpone 'send) (w3m-mail-goto-body-and-clear-body) (w3m-mail-position-point (prog1 (point) (mml-insert-empty-tag 'part 'type content-type 'buffer (buffer-name buffer) ;; Use the base64 encoding if the body contains non-ASCII text ;; or very long lines which might be broken by MTAs. 'encoding "base64" 'charset (when charset (symbol-name charset)) 'disposition "inline" 'description url))))) ;; This function is implemented in mew-w3m.el. ;; (defun w3m-mail-compose-with-mew (source url charset content-type ;; to subject other-headers) ;; "Compose a mail using Mew.") (defvar mail-send-actions) (defun w3m-mail-compose-with-vm (source url charset content-type to subject other-headers) "Compose a mail using VM." (let* ((coding (and charset (w3m-charset-to-coding-system charset))) (multibytep (and (not coding) (or charset (and (not (string-match "\\`image/" content-type)) (w3m-static-if (featurep 'xemacs) (string-match "[^\000-\177]" source) (multibyte-string-p source)))))) (buffer (generate-new-buffer " *w3m-mail*"))) (with-current-buffer buffer (w3m-static-unless (featurep 'xemacs) (set-buffer-multibyte (and (not coding) multibytep))) (cond (coding (insert (encode-coding-string source coding))) (multibytep (insert source) (when (and (setq charset (car (mm-find-mime-charset-region (point-min) (point-max)))) (setq coding (w3m-charset-to-coding-system charset))) (w3m-static-if (featurep 'xemacs) (encode-coding-region (point-min) (point-max) coding) (insert (prog1 (encode-coding-string (buffer-string) coding) (erase-buffer) (set-buffer-multibyte nil)))))) (t (insert source)))) (require 'vm-startup) (compose-mail to subject other-headers) (add-to-list 'mail-send-actions `(kill-buffer ,buffer)) (w3m-make-local-hook 'kill-buffer-hook) (add-hook 'kill-buffer-hook `(lambda nil (kill-buffer ,buffer)) nil t) (w3m-mail-goto-body-and-clear-body) (w3m-mail-position-point (prog1 (point) (vm-mime-attach-buffer buffer content-type (when charset (symbol-name charset)) url))))) (defun w3m-mail-compose-with-semi (source url charset content-type to subject other-headers) "Compose a mail using SEMI." (require 'mime-edit) (let* ((content-type (and content-type (split-string (downcase content-type) "/"))) (basename (file-name-nondirectory (w3m-url-strip-query url))) (filename (cond ((and (string-match "^[\t ]*$" basename) (equal content-type '("text" "html"))) "index.html") ((string-match "^[\t ]*$" basename) "dummy") (t basename))) (type (or (nth 0 content-type) "text")) (subtype (or (nth 1 content-type) "html")) parameters (encoding "base64") (disposition-type "inline") disposition-params (guess (mime-find-file-type filename)) (textp (string= type "text"))) (when (and guess (string= (nth 0 guess) type) (string= (nth 1 guess) subtype)) (setq parameters (nth 2 guess) encoding (or (nth 3 guess) encoding) disposition-type (or (nth 4 guess) disposition-type) disposition-params (nth 5 guess))) (compose-mail to subject other-headers) (w3m-mail-goto-body-and-clear-body) (let ((parameters-to-string (lambda (parameters) (when parameters (mapconcat (lambda (parameter) (concat "; " (car parameter) "=" (if (eq (cdr parameter) 'file) (std11-wrap-as-quoted-string filename) (cdr parameter)))) parameters "")))) (body (point)) (edit-buffer (current-buffer)) work-buffer) (with-temp-buffer (if textp (progn (insert source) (unless charset (setq charset (detect-mime-charset-region (point-min) (point-max)))) (when charset (setq parameters (cons (cons "charset" (symbol-name charset)) parameters)) (encode-mime-charset-region (point-min) (point-max) charset))) (set-buffer-multibyte nil) (insert source)) (mime-encode-region (point-min) (point-max) encoding) (setq work-buffer (current-buffer)) (set-buffer edit-buffer) (mime-edit-insert-tag type subtype (concat (funcall parameters-to-string parameters) "\nContent-Disposition: " disposition-type (funcall parameters-to-string disposition-params) "\nContent-Description: " url)) (mime-edit-define-encoding encoding) (save-restriction (narrow-to-region (point) (point)) (insert-buffer-substring work-buffer) (unless (bolp) (insert "\n")) (when (or (string= disposition-type "attachment") (not (member encoding '("7bit" "8bit" "binary")))) (add-text-properties (point-min) (point-max) '(invisible t mime-edit-invisible t))))) (w3m-mail-position-point body)))) (defun w3m-mail (&optional headers) "Send a web page as a mail. By default the subject is generated according to `w3m-mail-subject'. The optional HEADERS is a list in which each element is a cons of the symbol of a header name and a string. Here is an example to use this function: \(w3m-mail '((To . \"foo@bar\") (Subject . \"The emacs-w3m home page\")))" (interactive (unless (eq major-mode 'w3m-mode) (error "`%s' must be invoked from an emacs-w3m buffer" this-command))) (let ((composer (cdr (assq mail-user-agent w3m-mail-user-agent-compose-function-alist))) ;; Don't move the history position. (w3m-history-reuse-history-elements t) source base url charset content-type to subject) (cond ((not composer) (error "`%s' is not supported (yet) by `w3m-mail'" mail-user-agent)) ((not w3m-current-url) (error "The source for this page is not available")) ((string-match "\\`about://source/" w3m-current-url) (setq source (buffer-string) base (w3m-mail-compute-base-url)) (w3m-view-source) (setq url w3m-current-url charset (w3m-coding-system-to-charset w3m-current-coding-system) content-type (or (w3m-arrived-content-type w3m-current-url) (w3m-content-type w3m-current-url))) (w3m-view-source)) ((string-match "\\`about://header/" w3m-current-url) (w3m-view-source) (setq source (buffer-string) base (w3m-mail-compute-base-url)) (w3m-view-source) (setq url w3m-current-url charset (w3m-coding-system-to-charset w3m-current-coding-system) content-type (or (w3m-arrived-content-type w3m-current-url) (w3m-content-type w3m-current-url))) (w3m-view-header)) (t (setq url w3m-current-url charset (w3m-coding-system-to-charset w3m-current-coding-system) content-type (or (w3m-arrived-content-type w3m-current-url) (w3m-content-type w3m-current-url))) (w3m-view-source) (setq source (buffer-string) base (w3m-mail-compute-base-url)) (w3m-view-source))) (when (and base (string= "text/html" content-type)) (setq source (w3m-mail-embed-base-url source base))) (setq to (or (assq 'To headers) (assq 'to headers)) subject (or (assq 'Subject headers) (assq 'subject headers))) (when (or to subject) (setq headers (delq to (delq subject (copy-sequence headers))) to (cdr to) subject (cdr subject))) (unless subject (setq subject (let ((w3m-current-url url)) (w3m-mail-make-subject)))) (funcall composer source url charset content-type to subject headers))) ;;; w3m-mail.el ends here w3m-el-snapshot-1.4.609+0.20171225.orig/w3m-filter.el0000644000000000000000000011201013213222142017624 0ustar rootroot;;; w3m-filter.el --- filtering utility of advertisements on WEB sites -*- coding: utf-8 -*- ;; Copyright (C) 2001-2008, 2012-2015, 2017 ;; 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) (t "Filter top and bottom cruft for rt.com" "\\`https://www.rt\\.com/" w3m-filter-rt) (t "Filter for slashdot" "\\`http[s]?://\\([a-z]+\\.\\)?slashdot\\.org/" w3m-filter-slashdot) (nil ("Remove garbage in http://www.geocities.co.jp/*" "http://www.geocities.co.jp/* с眼ゃ障") "\\`http://www\\.geocities\\.co\\.jp/" w3m-filter-geocities-remove-garbage) (nil ("Remove ADV in http://*.hp.infoseek.co.jp/*" "http://*.hp.infoseek.co.jp/* уゃ障") "\\`http://[a-z]+\\.hp\\.infoseek\\.co\\.jp/" w3m-filter-infoseek-remove-ads) (nil ("Remove ADV in http://linux.ascii24.com/linux/*" "http://linux.ascii24.com/linux/* уゃ障") "\\`http://linux\\.ascii24\\.com/linux/" w3m-filter-ascii24-remove-ads) (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 ".*") (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" :value "not a regexp") (string :format " End: %v\n" :value "not a regexp")) (function :tag "Filter with a user defined function" :format "Function: %v\n"))))) (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) (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)))))) (defvar w3m-filter-selection-history nil) ;;;###autoload (defun w3m-toggle-filtering (arg) "Toggle whether web pages will have their html modified by w3m's \ filters before being rendered. When called with a prefix argument, prompt for a single filter to toggle with completion (a function toggled last will first appear)." (interactive "P") (if (not arg) ;; toggle state for all filters (progn (setq w3m-use-filter (not w3m-use-filter)) (message (concat "web page filtering now " (if w3m-use-filter "enabled" "disabled")))) ;; the remainder of this function if for the case of toggling ;; an individual filter (let* ((selection-list (delq nil (mapcar (lambda (elem) (when (and (symbolp (nth 3 elem)) (fboundp (nth 3 elem))) (symbol-name (nth 3 elem)))) w3m-filter-configuration))) (choice (completing-read "Enter filter name: " selection-list nil t (or (car w3m-filter-selection-history) (car selection-list)) 'w3m-filter-selection-history)) (filters w3m-filter-configuration) elem) (unless (string= "" choice) (setq choice (intern choice)) (while (setq elem (pop filters)) (when (eq choice (nth 3 elem)) (setq filters nil) (setcar elem (not (car elem))) (when (car elem) (setq w3m-use-filter t)) (message "filter `%s' now %s" choice (if (car elem) "enabled" "disabled")))))))) (defmacro w3m-filter-delete-regions (url start end &optional without-start without-end use-regex start-pos end-pos count) "Delete regions surrounded with a START pattern and an END pattern. Return t if at least one region is deleted. If WITHOUT-START is non-nil, do not delete the START pattern. If WITHOUT-END is non-nil, do not delete the the END strings. If USE-REGEX is non-nil, treat START and END as regular expressions. START-POS is a position from which to begin deletions. END-POS is a position at which to stop deletions. COUNT is the maximum number of deletions to make." `(let (p (i 0)) (goto-char ,(or start-pos '(point-min))) (while (and ,@(if count `((< i ,count))) ,(if use-regex `(re-search-forward ,start ,end-pos t) `(search-forward ,start ,end-pos t)) (setq p ,(if without-start '(match-end 0) '(match-beginning 0))) ,(if use-regex `(re-search-forward ,end ,end-pos t) `(search-forward ,end ,end-pos t))) (delete-region p ,(if without-end '(match-beginning 0) '(match-end 0))) (setq i (1+ i))) (> i 0))) (defmacro w3m-filter-replace-regexp (url regexp to-string &optional start-pos end-pos count) "Replace all occurrences of REGEXP with TO-STRING. Return t if at least one replacement is made. Optional START-POS, END-POS, and COUNT limit the scope of the replacements." `(let ((i 0)) (goto-char ,(or start-pos '(point-min))) (while ,(if count `(and (< i ,count) #1=(re-search-forward ,regexp ,end-pos t)) `#1#) (replace-match ,to-string nil nil) (setq i (1+ i))) (> i 0))) ;; 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], [emacs-w3m:12339], [emacs-w3m:12422], ;; [emacs-w3m:12812], [emacs-w3m:12830] "Add name anchors that w3m can handle. This function adds ``    '' in front of ``FOO BAR'' in the current buffer." (let ((case-fold-search t) (maxregexps 10) names regexp i st nd) (goto-char (point-min)) (while (re-search-forward "]+[\t\n\r ]+\\)*\ href=\"#\\([^\"]+\\)\"" nil t) (add-to-list 'names (match-string 1))) (setq case-fold-search nil) (while names (setq regexp "[\t\n\r ]+[Ii][Dd]=\"\\(" i maxregexps) (while (and names (> i 0)) (setq regexp (concat regexp (regexp-quote (pop names)) "\\|") i (1- i))) (setq regexp (concat (substring regexp 0 -1) ")\"")) (goto-char (point-min)) (while (re-search-forward "<[^>]+>" nil t) (setq st (match-beginning 0) nd (match-end 0)) (goto-char st) (if (re-search-forward regexp nd t) (progn (goto-char st) (insert "") (goto-char (+ nd (- (point) st)))) (goto-char nd)))))) (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 opt nd val default) (goto-char (point-min)) (while (re-search-forward "\ <\\(?:input\\|\\(option\\)\\|textarea\\)[\t\n ]" nil t) (setq st (match-beginning 0) opt (match-beginning 1)) (when (and (search-forward ">" nil t) (progn (setq nd (match-end 0)) (goto-char (1+ st)) (re-search-forward "[\t\n ]\ \\(?:\\(disabled\\(=\"[^\"]+\"\\)?\\)\\|\\(readonly\\(?:=\"[^\"]+\"\\)?\\)\\)" nd t))) (setq val (if (match-beginning 1) (if (match-beginning 2) "readonly=\"readonly\"" "readonly") (match-string 3))) (if opt ;; 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 1) (save-restriction (narrow-to-region st nd) (delete-region (goto-char (match-beginning 1)) (match-end 1)) (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 "