;;; w3m-type-ahead.el --- type ahead support for Emacs-w3m ;;; Copyright (C) 2003, 2004, 2005, 2006 Matthew P. Hodges ;; Author: Matthew P. Hodges ;; Version: $Id: w3m-type-ahead.el,v 1.107 2006/09/03 12:45:42 mphodges-guest Exp $ ;; w3m-type-ahead.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-type-ahead.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: ;; ;; Type ahead support for Emacs-w3m. This allows an isearch facility ;; that is limited to HREF anchors. Switch the mode on for all ;; w3m-mode buffers with: ;; (add-hook 'w3m-mode-hook 'w3m-type-ahead-mode) (require 'w3m) ;;; Code: (defconst w3m-type-ahead-version "2.4.0" "Version number of this package.") (defgroup w3m-type-ahead nil "Type ahead support for Emacs-w3m." :group 'w3m :link '(url-link "http://mph-emacs-pkgs.alioth.debian.org/WthreemTypeAheadEl.html")) ;; Customizable variables (defcustom w3m-type-ahead-hide-url nil "If non-nil, hide the URL in the echo area. Do this by removing `w3m-print-this-url' from `w3m-after-cursor-move-hook' during the incremental search. If equal to the symbol regexp-only, only hide the URL for regexp searches." :group 'w3m-type-ahead :type '(choice (const :tag "Show URL for all searches" nil) (const :tag "Hide URL for all searches" t) (const :tag "Hide URL for regexp searches" regexp-only))) ;; Entry points (defun w3m-type-ahead (&optional arg new-session) "Type-ahead search for `w3m-mode' buffers. 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, make a copy of the current session in advance. Otherwise, if ARG is non-nil, it forces reloading the URL at point. (See `w3m-view-this-url'.)" (interactive (if (member current-prefix-arg '(2 (16))) (list nil t) (list current-prefix-arg nil))) (w3m-type-ahead-internal nil arg new-session)) (defun w3m-type-ahead-regexp (&optional arg new-session) "Type-ahead regexp search for `w3m-mode' buffers. 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, make a copy of the current session in advance. Otherwise, if ARG is non-nil, it forces reloading the URL at point. (See `w3m-view-this-url'.)" (interactive (if (member current-prefix-arg '(2 (16))) (list nil t) (list current-prefix-arg nil))) (w3m-type-ahead-internal t arg new-session)) ;; Internal functions (defun w3m-type-ahead-internal (regexp-p arg new-session) "Internal `w3m-type-ahead' function. If non-nil REGEXP-P, do regular expression search. ARG and NEW-SESSION are passed to `w3m-view-this-url', which see." (cond ((not (eq major-mode 'w3m-mode)) (message "Can't type ahead in non-W3M buffer.")) (w3m-current-process (message "Can't type ahead while W3M is retrieving.")) ((not (next-single-property-change (point-min) 'w3m-anchor-sequence)) (message "Can't type ahead; no anchors found in buffer.")) (t (let ((advise '(search-forward search-backward re-search-forward re-search-backward)) success) (unwind-protect (progn (mapcar (lambda (f) (ad-enable-advice f 'around 'w3m-type-ahead) (ad-activate f)) advise) (let ((w3m-after-cursor-move-hook (copy-alist w3m-after-cursor-move-hook))) (when (or (eq w3m-type-ahead-hide-url t) (and regexp-p (eq w3m-type-ahead-hide-url 'regexp-only))) (setq w3m-after-cursor-move-hook (delq 'w3m-print-this-url w3m-after-cursor-move-hook))) (setq success (isearch-forward regexp-p nil)))) (mapcar (lambda (f) (ad-disable-advice f 'around 'w3m-type-ahead) (ad-activate f)) advise)) ;; Visit link if successful (when (and success (equal last-command-char ?\r)) ;; If we have adjacent anchors we may need to adjust point (when isearch-forward (let ((anchor-1 (get-text-property (point) 'w3m-anchor-sequence)) (anchor-2 (get-text-property (1- (point)) 'w3m-anchor-sequence))) (and anchor-1 anchor-2 (/= anchor-1 anchor-2) (goto-char (1- (point)))))) (w3m-view-this-url arg new-session)))))) (defun w3m-type-ahead-next-anchor () "Return `point' for the start of the next anchor. If in an anchor, just return current value of point; if no next anchor, return nil." (if (get-text-property (point) 'w3m-anchor-sequence) (point) (next-single-property-change (point) 'w3m-anchor-sequence))) (defun w3m-type-ahead-previous-anchor () "Return `point' after the end of the previous anchor. If in an anchor, just return current value of point; if no previous anchor, return nil." (if (get-text-property ;; avoid problem with a reversed search from (point-min) (if (bobp) (point) (1- (point))) 'w3m-anchor-sequence) (point) (previous-single-property-change (point) 'w3m-anchor-sequence))) (defun w3m-type-ahead-anchor-end () "Return `point' after the end of the current anchor." (unless (get-text-property (point) 'w3m-anchor-sequence) (error "Not in w3m anchor")) (next-single-property-change (point) 'w3m-anchor-sequence)) (defun w3m-type-ahead-anchor-start () "Return `point' for the start of the current anchor." (unless (get-text-property (1- (point)) 'w3m-anchor-sequence) (error "Not in w3m anchor")) (previous-single-property-change (point) 'w3m-anchor-sequence)) ;; Advised functions (defadvice search-forward (around w3m-type-ahead) "Limit search to w3m anchors." (if (not (eq major-mode 'w3m-mode)) ad-do-it (let (res) (ad-with-originals 'search-forward (while (and (goto-char (or (w3m-type-ahead-next-anchor) (point-max))) (not (eobp)) (not (setq res (search-forward (ad-get-arg 0) (w3m-type-ahead-anchor-end) 'move-to-bound))))) (setq ad-return-value res))))) (defadvice search-backward (around w3m-type-ahead) "Limit search to w3m anchors." (if (not (eq major-mode 'w3m-mode)) ad-do-it (let (res) (ad-with-originals 'search-backward (while (and (goto-char (or (w3m-type-ahead-previous-anchor) (point-min))) (not (bobp)) (not (setq res (search-backward (ad-get-arg 0) (w3m-type-ahead-anchor-start) 'move-to-bound))))) (setq ad-return-value res))))) (defadvice re-search-forward (around w3m-type-ahead) "Limit search to w3m anchors." ;; isearch-message-prefix is the only place in isearch where a ;; search command (re-search-forward) is called with a non-nil BOUND ;; optional argument. (if (not (eq major-mode 'w3m-mode)) ad-do-it (save-restriction (narrow-to-region (point-min) (or (ad-get-arg 1) (point-max))) (let ((posn (point)) res) (ad-with-originals 're-search-forward (while (and (goto-char (or (w3m-type-ahead-next-anchor) (point-max))) (not (eobp)) (not (setq res (re-search-forward (ad-get-arg 0) (w3m-type-ahead-anchor-end) 'move-to-bound)))))) (setq ad-return-value res))))) (defadvice re-search-backward (around w3m-type-ahead) "Limit search to w3m anchors." (if (not (eq major-mode 'w3m-mode)) ad-do-it (let (res) (ad-with-originals 're-search-backward (while (and (goto-char (or (w3m-type-ahead-previous-anchor) (point-min))) (not (bobp)) (not (setq res (re-search-backward (ad-get-arg 0) (w3m-type-ahead-anchor-start) 'move-to-bound))))) (setq ad-return-value res))))) ;; Minor mode setup (defvar w3m-type-ahead-mode-map (let ((map (make-sparse-keymap))) (define-key map (kbd "/") 'w3m-type-ahead) (define-key map (kbd "M-/") 'w3m-type-ahead-regexp) map) "Keymap for W3M Type Ahead mode.") ;; define-minor-mode is not available in GNU Emacs 20. In XEmacs 21 ;; and GNU Emacs 21, easy-mmode-define-minor-mode is an alias for ;; define-minor-mode. ;;;###autoload (easy-mmode-define-minor-mode w3m-type-ahead-mode "Toggle W3M Type Ahead mode. With ARG, turn W3M Type Ahead mode on if and only if ARG is positive. \\{w3m-type-ahead-mode-map}" nil " wta" w3m-type-ahead-mode-map) (provide 'w3m-type-ahead) ;;; w3m-type-ahead.el ends here