[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
editing emulated header
- From: TSUCHIYA Masatoshi <tsuchiya@xxxxxxxxxxxxxxxxxxxxxxx>
- Date: Thu, 07 Nov 2002 13:20:52 +0900
- X-ml-name: emacs-w3m
- X-mail-count: 04244
知り合いから「疑似ヘッダ部分(Location:)に表示されている URL を編集でき
て，その URL に移動できるといいよね」という提案を受けました．良さそう
なアイデアだと思ったので実装しかけたのですが，この変更には意外と癖があ
ることに気が付きました．
まだ全く不完全な状態なのですが，以下のパッチを適用すると，疑似ヘッダ部
分に記述されている URL を編集することができ，そこで RET すると指定され
た URL に移動することができます
癖があると思ったのは，私の場合，完全に emacs-w3m のキー操作に慣れてい
るので，ついつい疑似ヘッダ部分でも通常の emacs-w3m のコマンドが動くこ
とを期待して操作してしまうのですが，疑似ヘッダ部分を編集できるようにす
ると，この期待が裏切られてうっとうしく感じました．
それから，事実上，独自にミニバッファを実装するのと同じくらいの作業が必
要になりそうで，大変そうだとも思います．
ただし，この方向で buffer-read-only を廃止できると，form のその場での
編集が可能になって都合が良いかもしれません．
というわけで，ちょっと pending な気分なのですが，作りかけのコードを捨
ててしまうのも勿体ないので，とりあえずパッチだけ投げておきます．
--- w3m.el 6 Nov 2002 23:04:45 -0000 1.762
+++ w3m.el 7 Nov 2002 04:07:22 -0000
@@ -2403,7 +2403,7 @@
If URL is specified, only the image with URL is toggled."
(interactive "P")
(let ((cur-point (point))
- (buffer-read-only)
+ (before-change-functions)
(end (point-min))
start iurl image size)
(save-excursion
@@ -2451,12 +2451,12 @@
(with-current-buffer (marker-buffer start)
(if image
(when (equal url w3m-current-url)
- (let (buffer-read-only)
+ (let (before-change-functions)
(w3m-insert-image start end image iurl))
;; Redisplay
(when w3m-force-redisplay
(sit-for 0)))
- (let (buffer-read-only)
+ (let (before-change-functions)
(w3m-add-text-properties
start end '(w3m-image-status off))))
(set-buffer-modified-p nil))
@@ -2534,7 +2534,7 @@
URL is the image file's url.
RATE is resize percentage."
(interactive "P")
- (let ((buffer-read-only)
+ (let (before-change-functions
start end iurl image size iscale scale)
(if (or (featurep 'xemacs)
(and (boundp 'emacs-major-version)
@@ -2595,14 +2595,14 @@
(with-current-buffer (marker-buffer start)
(if image
(when (equal url w3m-current-url)
- (let (buffer-read-only)
+ (let (before-change-functions)
(w3m-static-when (featurep 'xemacs)
(w3m-remove-image start end))
(w3m-insert-image start end image iurl))
;; Redisplay
(when w3m-force-redisplay
(sit-for 0)))
- (let (buffer-read-only)
+ (let (before-change-functions)
(w3m-add-text-properties
start end '(w3m-image-status off))))
(set-buffer-modified-p nil))
@@ -2659,7 +2659,7 @@
(defun w3m-fontify ()
"Fontify this buffer."
(let ((case-fold-search t)
- (buffer-read-only))
+ (before-change-functions))
(run-hooks 'w3m-fontify-before-hook)
(w3m-message "Fontifying...")
;; Delete <?xml ... ?> tag
@@ -2711,7 +2711,7 @@
(eq (get-text-property (point) 'face) 'w3m-anchor-face))
(let* ((start)
(end (next-single-property-change (point) 'face))
- (buffer-read-only))
+ (before-change-functions))
(when (and end
(setq start (previous-single-property-change end 'face)))
(w3m-add-text-properties start end '(face w3m-arrived-anchor-face)))
@@ -4132,7 +4132,7 @@
(file-name-nondirectory url))))
(let ((result-buffer (current-buffer)))
(with-current-buffer output-buffer
- (let (buffer-read-only)
+ (let (before-change-functions)
(widen)
(delete-region (point-min) (point-max))
(insert-buffer-substring result-buffer)
@@ -4145,7 +4145,7 @@
&optional content-charset)
(when (w3m-image-type-available-p (w3m-image-type type))
(with-current-buffer output-buffer
- (let (buffer-read-only)
+ (let (before-change-functions)
(w3m-clear-local-variables)
(setq w3m-current-url (w3m-real-url url)
w3m-current-title (file-name-nondirectory url)
@@ -5400,7 +5400,6 @@
\\[report-emacs-w3m-bug] Send a bug report.
"
(kill-all-local-variables)
- (buffer-disable-undo)
(setq major-mode 'w3m-mode)
(setq mode-name "w3m")
(use-local-map w3m-mode-map)
@@ -5950,7 +5949,10 @@
w3m-image-only-page)
(and w3m-force-redisplay (sit-for 0))
(w3m-toggle-inline-image 'force reload)))
- (setq buffer-read-only t)
+ (buffer-disable-undo)
+ (buffer-enable-undo)
+ (w3m-add-local-hook 'before-change-functions
+ 'w3m-header-before-change)
(set-buffer-modified-p nil)))
(w3m-arrived-add orig w3m-current-title nil nil charset ct)
(setq list-buffers-directory w3m-current-title)
@@ -6932,8 +6934,11 @@
(defvar w3m-header-line-map nil)
(unless w3m-header-line-map
- (let ((map (make-sparse-keymap)))
- (set-keymap-parent map w3m-mode-map)
+ (let ((map (make-keymap)))
+ (dolist (pair '((beginning-of-line . w3m-header-beginning-of-line)
+ (end-of-line . w3m-header-end-of-line)))
+ (substitute-key-definition (car pair) (cdr pair) map global-map))
+ (define-key map "\C-m" 'w3m-header-goto-url)
(define-key map [mouse-2] 'w3m-goto-url)
(setq w3m-header-line-map map)))
@@ -6953,32 +6958,82 @@
(charset " [C]")
(t "")))))
(w3m-add-text-properties (point-min) (point)
- `(face w3m-header-line-location-title-face))
+ `(face w3m-header-line-location-title-face
+ local-map ,w3m-header-line-map))
(let ((start (point)))
(insert w3m-current-url)
- (w3m-add-text-properties start (point)
- `(face
- w3m-header-line-location-content-face
- mouse-face
- highlight
- ,(if (or (featurep 'xemacs)
- (>= emacs-major-version 21))
- 'keymap
- 'local-map)
- ,w3m-header-line-map
- ,@(if (featurep 'xemacs)
- '(help-echo
- "button2 prompts to input URL"
- balloon-help
- "button2 prompts to input URL")
- '(help-echo
- "mouse-2 prompts to input URL"))))
+ (w3m-header-add-location-content-property start (point))
(setq start (point))
(insert-char ?\ (max 0 (- (window-width) (current-column) 1)))
(w3m-add-text-properties start (point)
- `(face w3m-header-line-location-content-face))
+ `(face w3m-header-line-location-content-face
+ local-map ,w3m-header-line-map))
(unless (eolp)
(insert "\n")))))
+
+(defun w3m-header-add-location-content-property (start end)
+ (w3m-add-text-properties start end
+ `(w3m-header-location-content t
+ face w3m-header-line-location-content-face
+ mouse-face highlight
+ local-map ,w3m-header-line-map
+ ,@(if (featurep 'xemacs)
+ '(help-echo
+ "button2 prompts to input URL"
+ balloon-help
+ "button2 prompts to input URL")
+ '(help-echo
+ "mouse-2 prompts to input URL")))))
+
+(defun w3m-header-beginning-of-line (&optional N)
+ (interactive "p")
+ (beginning-of-line N)
+ (let ((beg (text-property-any (point) (line-end-position)
+ 'w3m-header-location-content t)))
+ (when beg (goto-char beg))))
+
+(defun w3m-header-end-of-line (&optional N)
+ (interactive "p")
+ (end-of-line N)
+ (let ((beg (text-property-any (line-beginning-position) (point)
+ 'w3m-header-location-content t)))
+ (when beg
+ (goto-char (next-single-property-change
+ beg 'w3m-header-location-content)))))
+
+(defun w3m-header-goto-url ()
+ (interactive)
+ (let ((beg (text-property-any (point-min) (point-max)
+ 'w3m-header-location-content t)))
+ (w3m-goto-url (buffer-substring beg
+ (next-single-property-change
+ beg 'w3m-header-location-content)))))
+
+(defun w3m-header-before-change (from to)
+ (w3m-add-local-hook 'post-command-hook 'w3m-header-after-change)
+ (unless (or (get-text-property from 'w3m-header-location-content)
+ (when (> from (point-min))
+ (get-text-property (1- from) 'w3m-header-location-content)))
+ (signal 'buffer-read-only (list (current-buffer)))))
+
+(defun w3m-header-after-change ()
+ (remove-hook 'post-command-hook 'w3m-header-after-change t)
+ (w3m-add-local-hook 'before-change-functions 'w3m-header-before-change)
+ (when (and (or (featurep 'xemacs)
+ (< emacs-major-version 21)
+ w3m-use-tab)
+ w3m-use-header-line)
+ (let* ((before-change-functions)
+ (x (next-single-property-change
+ (point-min) 'w3m-header-location-content))
+ (y (previous-single-property-change x 'local-map)))
+ (if y
+ (w3m-header-add-location-content-property y x)
+ (setq x (next-single-property-change x 'w3m-header-location-content)
+ y (when x
+ (next-single-property-change x 'local-map)))
+ (when y
+ (w3m-header-add-location-content-property x y))))))
;;; w3m-minor-mode
--
土屋 雅稔 ( TSUCHIYA Masatoshi )