[mew-dist 27826] メッセージバッファの横スクロール

[Hideyuki SHIRAI ( 白井秀行 )]

白井です。

メッセージバッファの横スクロールを作ってみました。
パッチにはしていませんが、それなりに良い感じだと思います。お試し
ください。

# summary の auto-hscroll-mode までいじらないとだめだとは。。。

-- 
白井秀行 (mailto:shirai at example.com)

(defcustom mew-message-horizontal-scroll-columns 15
  "*Number of steps in columns used when scrolling a message window horizontally."
  :group 'mew-message
  :type '(integer :size 0))

(add-hook 'mew-summary-mode-hook
	  (lambda ()
	    (define-key mew-summary-mode-map [?\C-<] 'mew-summary-jump-top)
	    (define-key mew-summary-mode-map [?\C->] 'mew-summary-jump-bottom)
	    (define-key mew-summary-mode-map "<" 'mew-summary-scroll-right)
	    (define-key mew-summary-mode-map ">" 'mew-summary-scroll-left)))

(add-hook 'mew-message-mode-hook
	  (lambda ()
	    (define-key mew-message-mode-map "<" 'mew-message-scroll-right)
	    (define-key mew-message-mode-map ">" 'mew-message-scroll-left)))

(cond
 ((boundp 'auto-hscroll-mode) ;; Emacs 21.3.50 or later
  (defsubst mew-hscroll-off ()
    (set (make-local-variable 'auto-hscroll-mode) nil))
  (defsubst mew-hscroll-mode ()
    (if auto-hscroll-mode 'on 'off)))
 ((boundp 'automatic-hscrolling) ;; Emacs 21.3 or earlier
  (defsubst mew-hscroll-off ()
    (set (make-local-variable 'automatic-hscrolling) nil))
  (defsubst mew-hscroll-mode ()
    (if automatic-hscrolling 'on 'off)))
 (t
  (defsubst mew-hscroll-off () (auto-show-mode 0))
  (defsubst mew-hscroll-mode ()
    (if auto-show-mode 'on 'off))))

(defvar mew-hscroll-type nil)
(make-variable-buffer-local 'mew-hscroll-type)

(defadvice mew-normal-line (before hscroll-off activate)
  (when (eq mew-hscroll-type 'on)
    (mew-hscroll))
  (let ((fld (mew-minfo-get-summary)))
    (when (and fld (get-buffer fld))
      (save-excursion
	(set-buffer fld)
	(when (eq mew-hscroll-type 'on)
	  (mew-hscroll))))))

(defun mew-summary-scroll-left (arg)
  "Scroll the message window to the left."
  (interactive "P")
  (mew-summary-msg-or-part
   (unless mew-hscroll-type
     (setq mew-hscroll-type (mew-hscroll-mode)))
   (mew-hscroll-off)
   (let ((win (selected-window)))
     (unwind-protect
	 (progn
	   (mew-summary-toggle-disp-msg 'on)
	   (if (memq last-command '(mew-summary-scroll-left
				    mew-summary-scroll-right))
	       (when (get-buffer-window (mew-buffer-message))
		 (select-window (get-buffer-window (mew-buffer-message))))
	     (mew-window-configure 'message))
	   (mew-message-scroll-left arg))
       (select-window win)))))

(defun mew-summary-scroll-right (arg)
  "Scroll the message window to the right."
  (interactive "P")
  (mew-summary-msg-or-part
   (unless mew-hscroll-type
     (setq mew-hscroll-type (mew-hscroll-mode)))
   (mew-hscroll-off)
   (let ((win (selected-window)))
     (unwind-protect
	 (progn
	   (mew-summary-toggle-disp-msg 'on)
	   (if (memq last-command '(mew-summary-scroll-left
				    mew-summary-scroll-right))
	       (when (get-buffer-window (mew-buffer-message))
		 (select-window (get-buffer-window (mew-buffer-message))))
	     (mew-window-configure 'message))
	   (mew-message-scroll-right arg))
       (select-window win)))))

(defun mew-message-scroll-left (arg)
  "Scroll the message window to the left."
  (interactive "P")
  (mew-message-horizontal-scroll
   'left (if arg
	     (prefix-numeric-value arg)
	   mew-message-horizontal-scroll-columns)))

(defun mew-message-scroll-right (arg)
  "Scroll the message window to the right."
  (interactive "P")
  (mew-message-horizontal-scroll
   'right (if arg
	      (prefix-numeric-value arg)
	    mew-message-horizontal-scroll-columns)))

(defun mew-message-horizontal-scroll (direction ncol)
  "Scroll the message window NCOL columns horizontally to DIRECTION.
DIRECTON should be the symbol `left' which specifies to scroll to the
left, or any other Lisp object meaning to scroll to the right.  NCOL
should be a number. "
  (let ((inhibit-point-motion-hooks t))
    (unless mew-hscroll-type
      (setq mew-hscroll-type (mew-hscroll-mode)))
    (mew-hscroll-off)
    (setq truncate-lines t) ;; なくても良いけど。。。
    (set-window-hscroll (selected-window)
			(max 0 (+ (window-hscroll)
				  (if (eq direction 'left) ncol (- ncol)))))
    (let ((hs (window-hscroll)))
      (unless (and (>= (- (current-column) hs) 0)
		   (< (- (current-column) hs) (window-width)))
	(move-to-column (if (eq direction 'left)
			  hs
			  (+ hs (window-width) -2)))))))