SiteMap Search ElispArea HowTo Glossary RecentChanges News Problems Suggestions

w3m-type-ahead.el

Last edit

Summary: v2.4.0

Changed:

< #REDIRECT MattHodges

to

> ;;; w3m-type-ahead.el --- type ahead support for Emacs-w3m
> ;;; Copyright (C) 2003, 2004, 2005, 2006 Matthew P. Hodges
> ;; Author: Matthew P. Hodges <MPHodges@member.fsf.org>
> ;; 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


Download

;;; w3m-type-ahead.el --- type ahead support for Emacs-w3m

;;; Copyright (C) 2003, 2004, 2005, 2006 Matthew P. Hodges

;; Author: Matthew P. Hodges <MPHodges@member.fsf.org>
;; 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