[Date Prev][Date Next][Thread Prev][][Date Index][Thread Index]

w3m-hreflist 

はじめまして、織と申します。
emacs-w3m を大変重宝させて頂いております。

emacs-lisp の勉強がてら、オモチャを作ってみました。
M-x w3m-hreflist-show とすると、左に window を作って、
*w3m* バッファの中の全ての anchor を表示します。

いまいち役に立つかどうか分からないのですが、
もしよろしければお試し下さい。

----
京都大学大学院 情報学研究科 知能情報学専攻
          織  学 (ORI Manabu)
   mailto: ori@pine.kuee.kyoto-u.ac.jp

;;;; w3m-hreflist.el

;;; Commentary:

;; w3m-hreflist.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 of the
;; License, or (at your option) any later version.

;; w3m-hreflist.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.

;; You should have received a copy of the GNU General Public License
;; along with w3m-hreflist.el; if not, write to the Free Software
;; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307
;; USA

;;; Code:

(defvar w3m-hreflist-mode-map nil)

(defconst w3m-hreflist-title "Anchor List:\n------------\n")
(defconst w3m-hreflist-title-lines 2)
(defconst w3m-hreflist-itemize-label "* ")

(defface w3m-hreflist-focused-face
  '((((class color) (background light)) (:background "gold" :italic t))
    (((class color) (background dark)) (:background "gold" :italic t))
    (t (:bold t)))
  "face of selected anchor."
  :group 'w3m)

(unless w3m-hreflist-mode-map
  (let ((map (make-keymap)))
    (suppress-keymap map)
    (define-key map "\t" 'w3m-hreflist-next-line)
    (define-key map [(shift tab)] 'w3m-hreflist-previous-line)
    (define-key map [(shift iso-lefttab)] 'w3m-hreflist-previous-line)
    (define-key map "j" 'w3m-hreflist-next-line)
    (define-key map "\C-n" 'w3m-hreflist-next-line)
    (define-key map "k" 'w3m-hreflist-previous-line)
    (define-key map "\C-p" 'w3m-hreflist-previous-line)
    (define-key map "q" 'w3m-hreflist-quit)
    (define-key map "\C-m" 'w3m-hreflist-view-this-url)
    (setq w3m-hreflist-mode-map map)))

(defun w3m-hreflist-get-beg (list)
  (car list))
(defun w3m-hreflist-get-end (list)
  (car (cdr list)))
(defun w3m-hreflist-get-string (list)
  (car (cdr (cdr list))))
(defun w3m-hreflist-get-url (list)
  (car (cdr (cdr (cdr list)))))

(defun w3m-hreflist-anchor-list-member-p (list beg)
  "list の要素に url と同じ文字列が含まれていれば t、そうでなければ nil を返す"
  (let ((result nil))
    (while list
      (let ((anchor (car list)))
	(when (and (= beg (w3m-hreflist-get-beg anchor))
		   (string= url (w3m-hreflist-get-url anchor))
		   (string= str (w3m-hreflist-get-string anchor)))
	  (setq result t)))
      (setq list (cdr list)))
    result))

(defun w3m-hreflist-collect-url (&optional buffer)
  "バッファ内の全ての (beg end string url) のリストを返す"
  (unless buffer (setq buffer (current-buffer)))
  (set-buffer buffer)
  (save-excursion
    (goto-char (point-min))
    (let* ((url (w3m-next-anchor))
	   (beg (point))
	   (end (goto-char (next-single-property-change
			    (point)
			    'w3m-cursor-anchor)))
	   (str (buffer-substring-no-properties beg end))
	   anchor-list)
      (while (null (w3m-hreflist-anchor-list-member-p anchor-list beg))
	(setq anchor-list (cons (list beg end str url) anchor-list))
	(forward-char -1)
	(setq url (w3m-next-anchor))
	(setq beg (point))
	(setq end (goto-char (next-single-property-change
			      (point) 'w3m-cursor-anchor)))
	(setq str (buffer-substring-no-properties beg end)))
      (reverse anchor-list))))

(defun w3m-hreflist-show ()
  (interactive)
  (setq w3m-hreflist-orig-buffer (get-buffer "*w3m*"))
  (setq w3m-hreflist-window (get-buffer-window w3m-hreflist-orig-buffer))
  (setq w3m-hreflist-anchor-list
	(w3m-hreflist-collect-url w3m-hreflist-orig-buffer))
  (setq w3m-hreflist-orig-window
	(split-window-horizontally (/ (window-width) 4)))
  (setq w3m-hreflist-buffer (get-buffer-create "*w3m-anchor-list*"))
  (set-window-buffer (selected-window) w3m-hreflist-buffer)
  (erase-buffer)
  (insert w3m-hreflist-title)
  (let ((anchor-list w3m-hreflist-anchor-list))
    (while anchor-list
      (insert w3m-hreflist-itemize-label
	      (w3m-hreflist-get-string (car anchor-list)) "\n")
      (setq anchor-list (cdr anchor-list))))
  (goto-line (1+ w3m-hreflist-title-lines))
  (w3m-hreflist-mode)
  (w3m-hreflist-next-line 0))		; 最初のアンカーをハイライト

(defun w3m-hreflist-mode ()
  (kill-all-local-variables)
  (buffer-disable-undo)
  (setq major-mode 'w3m-hreflist-mode)
  (setq mode-name "w3m-hreflist")
  (use-local-map w3m-hreflist-mode-map)
  (setq truncate-lines t)
  (setq w3m-hreflist-previous-line nil)
  (setq w3m-hreflist-previous-face nil))

(defun w3m-hreflist-next-line (arg)
  (interactive "p")
  (if (and (= (1+ (w3m-hreflist-current-line))
	      (w3m-hreflist-num-member w3m-hreflist-anchor-list))
	   (= 1 arg))
      ;; 最下行で下の行に移る操作がされると先頭行に移動する
      (goto-line (1+ w3m-hreflist-title-lines))
    (next-line arg))
  (let* ((curline (w3m-hreflist-current-line)) ; 何番目の項目が選択されたか
	 (anchor (nth curline w3m-hreflist-anchor-list))
	 (beg (w3m-hreflist-get-beg anchor))
	 (end (w3m-hreflist-get-end anchor)))
    (if anchor
	(progn
	  (message (w3m-hreflist-get-url anchor))
	  (select-window w3m-hreflist-orig-window)
	  (goto-char beg)
	  (let (buffer-read-only)
	    (setq w3m-hreflist-previous-face (get-text-property beg 'face))
 	    (put-text-property beg end 'face 'w3m-hreflist-focused-face)
	    (w3m-hreflist-clean-previous-face))
	  (select-window w3m-hreflist-window)
	  (setq w3m-hreflist-previous-line curline))
      (w3m-hreflist-previous-line 1))))

(defun w3m-hreflist-view-this-url ()
  (interactive)
  (let* ((anchor (nth (w3m-hreflist-current-line) w3m-hreflist-anchor-list))
	 (beg (w3m-hreflist-get-beg anchor)))
    (w3m-hreflist-quit)
    (select-window w3m-hreflist-orig-window)
    (goto-char beg)
    (w3m-view-this-url)))

(defun w3m-hreflist-previous-line (arg)
  (interactive "p")
  (when (and (= 0 (w3m-hreflist-current-line)) (= 1 arg))
    ;; 先頭行で上の行に移る操作がされると最下行に移動する
    (setq arg (- (w3m-hreflist-num-member w3m-hreflist-anchor-list))))
  (w3m-hreflist-next-line (- arg)))

(defun w3m-hreflist-clean-previous-face ()
  (select-window w3m-hreflist-orig-window)
  (when w3m-hreflist-previous-line
    (let (buffer-read-only
	  (prev-anchor (nth w3m-hreflist-previous-line
			    w3m-hreflist-anchor-list)))
      (put-text-property (w3m-hreflist-get-beg prev-anchor)
			 (w3m-hreflist-get-end prev-anchor)
			 'face
			 w3m-hreflist-previous-face)))
  (select-window w3m-hreflist-window))

(defun w3m-hreflist-quit ()
  (interactive)
  (w3m-hreflist-clean-previous-face)
  (delete-window w3m-hreflist-window)
  (kill-buffer w3m-hreflist-buffer))

(defun w3m-hreflist-current-line ()
  (- (count-lines (point-min) (point)) w3m-hreflist-title-lines))

(defun w3m-hreflist-num-member (list)
  (let ((num 0))
    (while list
      (setq num (1+ num))
      (setq list (cdr list)))
    num))

;; (define-key w3m-mode-map "L" 'w3m-hreflist-show)

;;; w3m-hreflist.el ends here.