猫熊は燃えつきた？！日記

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128

(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 "<" 'mew-summary-jump-top-or-scroll-right)
	    (define-key mew-summary-mode-map ">" 'mew-summary-jump-bottom-or-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-type ()
    (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-type ()
    (if automatic-hscrolling 'on 'off)))
 (t
  (defsubst mew-hscroll-off () (auto-show-mode 0))
  (defsubst mew-hscroll-type ()
    (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-jump-bottom-or-scroll-left (arg)
  "Scroll the message window to the left."
  (interactive "P")
  (unless (and (mew-buffer-message)
	       (get-buffer-window (mew-buffer-message))
	       (mew-summary-msg-or-part
		(unless mew-hscroll-type
		  (setq mew-hscroll-type (mew-hscroll-type)))
		(mew-hscroll-off)
		(let ((win (selected-window))
		      ret)
		  (unwind-protect
		      (progn
			(mew-summary-toggle-disp-msg 'on)
			(if (memq last-command '(mew-summary-jump-bottom-or-scroll-left
						 mew-summary-jump-top-or-scroll-right))
			    (when (get-buffer-window (mew-buffer-message))
			      (select-window (get-buffer-window (mew-buffer-message))))
			  (mew-window-configure 'message))
			(setq ret (mew-message-scroll-left arg)))
		    (select-window win)
		    ret))))
    (call-interactively 'mew-summary-jump-bottom)))
 
(defun mew-summary-jump-top-or-scroll-right (arg)
  "Scroll the message window to the right."
  (interactive "P")
  (unless (and (mew-buffer-message)
	       (get-buffer-window (mew-buffer-message))
	       (mew-summary-msg-or-part
		(unless mew-hscroll-type
		  (setq mew-hscroll-type (mew-hscroll-type)))
		(mew-hscroll-off)
		(let ((win (selected-window))
		      ret)
		  (unwind-protect
		      (progn
			(mew-summary-toggle-disp-msg 'on)
			(if (memq last-command '(mew-summary-jump-bottom-or-scroll-left
						 mew-summary-jump-top-or-scroll-right))
			    (when (get-buffer-window (mew-buffer-message))
			      (select-window (get-buffer-window (mew-buffer-message))))
			  (mew-window-configure 'message))
			(setq ret (mew-message-scroll-right arg)))
		    (select-window win)
		    ret))))
    (call-interactively 'mew-summary-jump-top)))
 
(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. "
  (when truncate-lines
    (let ((inhibit-point-motion-hooks t))
      (unless mew-hscroll-type
	(setq mew-hscroll-type (mew-hscroll-type)))
      (mew-hscroll-off)
      (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))))
	hs))))