Download
(require 'w3m)
(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"))
(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)))
(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))
(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))
(when (and success (equal last-command-char ?\r))
(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
(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))
(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."
(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)))))
(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.")
(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)