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

Column block scanning



大和です。

> w3mをロードして、以下のコードを評価した後に、w3mのバッファで
> 以下のキーが使えるようになります。
> 
> "\M-\C-f": 右のコラムブロックへ移動
> "\M-\C-b": 左のコラムブロックへ移動
> "\M-\C-a": コラムブロックの先頭へ移動
> "\M-\C-e": コラムブロックの末尾へ移動
> 
> です。http://slashdot.orgのどの英語のページで試してみて下さい。
> 日本語のページではうまく動作しません。

日本語のページでも動作するようです。以下コードに差し替えて下さい。

;; w3m-block.el
;; Masatake YAMATO<jet@gyve.org>

(add-hook 'w3m-display-hook 'w3m-column-block-update)
(defvar w3m-column-block nil)
(defvar w3m-column-scan-threshold 100)
(make-variable-buffer-local 'w3m-column-block)
(defun w3m-column-block-update (url)
  (let ((cv (w3m-filter-vector 
	     (w3m-vecotr-self-diff 
	      (w3m-get-column-vector)))))
    (setq w3m-column-block cv)))

(define-key w3m-mode-map "\M-\C-f" 'w3m-next-column)
(define-key w3m-mode-map "\M-\C-b" 'w3m-prev-column)
(define-key w3m-mode-map "\M-\C-a" 'w3m-beginning-column)
(define-key w3m-mode-map "\M-\C-e" 'w3m-end-column)

(defun w3m-current-column-block ()
  (let ((i (current-column))
	(c 0))
    (while (<= 0 i)
      (if (aref w3m-column-block i)
	  (setq c (1+ c)))
      (setq i (1- i)))
    c))

(defun w3m-beginning-column ()
  (interactive)
  (let ((c (w3m-current-column-block)))
    (goto-char (point-min))
    (while (< 0 c)
      (w3m-next-column)
      (setq c (1- c)))))

(defun w3m-end-column ()
  (interactive)
  (let ((c (1+ (w3m-current-column-block))))
    (goto-char (point-max))
    (previous-line 4)
    (beginning-of-line)
    (while (< 0 c)
      (w3m-next-column)
      (setq c (1- c)))
    (backward-char 1)))

(defun w3m-next-column ()
  (interactive)
  (let ((cc (current-column)))
    (move-to-column (w3m-get-next-column (1+ cc)))))

(defun w3m-get-next-column (cc)
  (if (> cc (length w3m-column-block))
      cc
    (let ((i cc)
	  newcc)
      (while (and (< i (length w3m-column-block)) (null newcc))
	(if (aref w3m-column-block i)
	    (setq newcc i))
	(setq i (1+ i)))
      (if newcc newcc (length w3m-column-block)))))

(defun w3m-prev-column ()
  (interactive)
  (let ((cc (current-column)))
    (move-to-column (w3m-get-prev-column (1- cc)))))

(defun w3m-get-prev-column (cc)
  (if (<= cc 0)
      0
    (let ((i cc)
	  newcc)
      (while (and (>= i 0) (null newcc))
	(if (aref w3m-column-block i)
	    (setq newcc i))
	(setq i (1- i)))
      (if newcc newcc 0))))

(defun w3m-get-column-vector ()
  (save-excursion
    (let* ((max-column (progn
			 (goto-char (point-min)) (end-of-line) (point)))
	   (column-vector (make-vector max-column 0))
	   (i 0)
	   chars)
      (while (< i max-column)
	(aset column-vector i 
	      (w3m-count-column-chars i))
	(setq i (1+ i)))
      column-vector)))
	
(defun w3m-count-column-chars (col)
  (goto-char (1+ col))
  (let (goal-column)
    (set-goal-column nil)
    (w3m-count-current-column-chars)
    ))

(defsubst w3m-char-is-in-text (c)
  (if (or (eq c ?\ ) (eq c nil) (eq c ?\n))
      nil
    t))

(defun w3m-count-current-column-chars ()
  (let ((chars 0))
    (condition-case nil
	(while t
	  (if (and (or (eq goal-column (current-column))
		       (eq goal-column (1- (current-column))))
		   (w3m-char-is-in-text (char-after)))
	      (setq chars (1+ chars)))
	  (next-line 1))
      (error nil))
    chars))

(defun w3m-vecotr-rotate (v)
  (let* ((vl (length v))
	 (newv (make-vector vl 0))
	(i 0)
	j)
    (setq vl (1- vl))
    (while (< i vl)
      (setq j (1+ i))
      (aset newv j (aref v i))
      (setq i j))
    newv))

(defun w3m-vecotr-self-diff (v)
  (map 'vector (function (lambda (x y)
			   (- x y)))
       v (w3m-vecotr-rotate v)))


(defun w3m-filter-vector (v)
  (map 'vector (function (lambda (x)
			   (if (< w3m-column-scan-threshold x)
			       t
			     nil)))
       v))