aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorJuanma Barranquero2003-06-01 23:07:31 +0000
committerJuanma Barranquero2003-06-01 23:07:31 +0000
commit3bb804d0795542dfaa4d130997f6a5569553dbb9 (patch)
tree6827a1eabe36cf3928ddbac0f8f7e56b57c66ef2
parentf4e622607979b1ff54ddef148824fc0e8f559745 (diff)
downloademacs-3bb804d0795542dfaa4d130997f6a5569553dbb9.tar.gz
emacs-3bb804d0795542dfaa4d130997f6a5569553dbb9.zip
Version 1.6
Take into account changes made to the display margins, fringes and scroll-bar handling. (ruler-mode-margins-char): Removed. Not used anymore. (ruler-mode-pad-face, ruler-mode-fringes-face): New faces. (ruler-mode-margins-face): New definition. Moved. (ruler-mode-left-fringe-cols) (ruler-mode-right-fringe-cols) (ruler-mode-left-scroll-bar-cols) (ruler-mode-right-scroll-bar-cols): Reimplemented. Moved. (ruler-mode-full-window-width) (ruler-mode-window-col): New functions. (ruler-mode-mouse-set-left-margin) (ruler-mode-mouse-set-right-margin) (ruler-mode-mouse-add-tab-stop) (ruler-mode-mouse-del-tab-stop): Reimplemented. (ruler-mode-mouse-current-grab-object): Renamed to... (ruler-mode-dragged-symbol): New. (ruler-mode-mouse-grab-any-column): Use it. Cleaned up. (ruler-mode-mouse-drag-any-column): Likewise. (ruler-mode-mouse-drag-any-column-iteration): Simplified. (ruler-mode): Restore previous `header-line-format' if `ruler-mode-header-line-format-old' has a local binding in current buffer. (ruler-mode-left-margin-help-echo) (ruler-mode-right-margin-help-echo): Removed. (ruler-mode-margin-help-echo) (ruler-mode-fringe-help-echo): New constants. (ruler-mode-ruler): Use them. Reimplemented.
-rw-r--r--lisp/ChangeLog40
-rw-r--r--lisp/ruler-mode.el767
2 files changed, 425 insertions, 382 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index fd22af842bb..e8943cbaca9 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,39 @@
12003-05-27 David Ponce <david@dponce.com>
2
3 * ruler-mode.el
4
5 Version 1.6
6
7 Take into account changes made to the display margins, fringes and
8 scroll-bar handling.
9
10 (ruler-mode-margins-char): Removed. Not used anymore.
11 (ruler-mode-pad-face, ruler-mode-fringes-face): New faces.
12 (ruler-mode-margins-face): New definition. Moved.
13 (ruler-mode-left-fringe-cols)
14 (ruler-mode-right-fringe-cols)
15 (ruler-mode-left-scroll-bar-cols)
16 (ruler-mode-right-scroll-bar-cols): Reimplemented. Moved.
17 (ruler-mode-full-window-width)
18 (ruler-mode-window-col): New functions.
19 (ruler-mode-mouse-set-left-margin)
20 (ruler-mode-mouse-set-right-margin)
21 (ruler-mode-mouse-add-tab-stop)
22 (ruler-mode-mouse-del-tab-stop): Reimplemented.
23 (ruler-mode-mouse-current-grab-object): Renamed to...
24 (ruler-mode-dragged-symbol): New.
25 (ruler-mode-mouse-grab-any-column): Use it. Cleaned up.
26 (ruler-mode-mouse-drag-any-column): Likewise.
27 (ruler-mode-mouse-drag-any-column-iteration): Simplified.
28 (ruler-mode): Restore previous `header-line-format' if
29 `ruler-mode-header-line-format-old' has a local binding in current
30 buffer.
31 (ruler-mode-left-margin-help-echo)
32 (ruler-mode-right-margin-help-echo): Removed.
33 (ruler-mode-margin-help-echo)
34 (ruler-mode-fringe-help-echo): New constants.
35 (ruler-mode-ruler): Use them. Reimplemented.
36
12003-06-01 Jason Rumney <jasonr@gnu.org> 372003-06-01 Jason Rumney <jasonr@gnu.org>
2 38
3 * mwheel.el (mouse-wheel-down-event, mouse-wheel-up-event): 39 * mwheel.el (mouse-wheel-down-event, mouse-wheel-up-event):
@@ -6,11 +42,11 @@
6 * term/w32-win.el: No need to bind wheel events specially. 42 * term/w32-win.el: No need to bind wheel events specially.
7 43
82003-06-01 Michael Kifer <kifer@cs.stonybrook.edu> 442003-06-01 Michael Kifer <kifer@cs.stonybrook.edu>
9 45
10 * desktop.el (desktop-create-buffer): Added (desktop-first-buffer) to 46 * desktop.el (desktop-create-buffer): Added (desktop-first-buffer) to
11 the let-statement to avoid the startup error that desktop-first-buffer 47 the let-statement to avoid the startup error that desktop-first-buffer
12 is undefined. 48 is undefined.
13 49
142003-06-01 Andreas Schwab <schwab@suse.de> 502003-06-01 Andreas Schwab <schwab@suse.de>
15 51
16 * man.el (Man-name-regexp): Also match Latin-1 soft hyphen. 52 * man.el (Man-name-regexp): Also match Latin-1 soft hyphen.
diff --git a/lisp/ruler-mode.el b/lisp/ruler-mode.el
index 5e839aff43c..ffa0d2a6f46 100644
--- a/lisp/ruler-mode.el
+++ b/lisp/ruler-mode.el
@@ -5,7 +5,7 @@
5;; Author: David Ponce <david@dponce.com> 5;; Author: David Ponce <david@dponce.com>
6;; Maintainer: David Ponce <david@dponce.com> 6;; Maintainer: David Ponce <david@dponce.com>
7;; Created: 24 Mar 2001 7;; Created: 24 Mar 2001
8;; Version: 1.5 8;; Version: 1.6
9;; Keywords: convenience 9;; Keywords: convenience
10 10
11;; This file is part of GNU Emacs. 11;; This file is part of GNU Emacs.
@@ -33,14 +33,14 @@
33;; You can use the mouse to change the `fill-column' `comment-column', 33;; You can use the mouse to change the `fill-column' `comment-column',
34;; `goal-column', `window-margins' and `tab-stop-list' settings: 34;; `goal-column', `window-margins' and `tab-stop-list' settings:
35;; 35;;
36;; [header-line (shift down-mouse-1)] set left margin to the ruler 36;; [header-line (shift down-mouse-1)] set left margin end to the ruler
37;; graduation where the mouse pointer is on. 37;; graduation where the mouse pointer is on.
38;; 38;;
39;; [header-line (shift down-mouse-3)] set right margin to the ruler 39;; [header-line (shift down-mouse-3)] set right margin beginning to
40;; graduation where the mouse pointer is on. 40;; the ruler graduation where the mouse pointer is on.
41;; 41;;
42;; [header-line down-mouse-2] set `fill-column', `comment-column' or 42;; [header-line down-mouse-2] Drag the `fill-column', `comment-column'
43;; `goal-column' to the ruler graduation with the mouse dragging. 43;; or `goal-column' to a ruler graduation.
44;; 44;;
45;; [header-line (control down-mouse-1)] add a tab stop to the ruler 45;; [header-line (control down-mouse-1)] add a tab stop to the ruler
46;; graduation where the mouse pointer is on. 46;; graduation where the mouse pointer is on.
@@ -57,14 +57,12 @@
57;; the `current-column' location, `ruler-mode-fill-column-char' shows 57;; the `current-column' location, `ruler-mode-fill-column-char' shows
58;; the `fill-column' location, `ruler-mode-comment-column-char' shows 58;; the `fill-column' location, `ruler-mode-comment-column-char' shows
59;; the `comment-column' location, `ruler-mode-goal-column-char' shows 59;; the `comment-column' location, `ruler-mode-goal-column-char' shows
60;; the `goal-column' and `ruler-mode-tab-stop-char' shows tab 60;; the `goal-column' and `ruler-mode-tab-stop-char' shows tab stop
61;; stop locations. `window-margins' areas are shown with a different 61;; locations. Graduations in `window-margins' and `window-fringes'
62;; background color. 62;; areas are shown with a different foreground color.
63;; 63;;
64;; It is also possible to customize the following characters: 64;; It is also possible to customize the following characters:
65;; 65;;
66;; - `ruler-mode-margins-char' character used to pad margin areas
67;; (space by default).
68;; - `ruler-mode-basic-graduation-char' character used for basic 66;; - `ruler-mode-basic-graduation-char' character used for basic
69;; graduations ('.' by default). 67;; graduations ('.' by default).
70;; - `ruler-mode-inter-graduation-char' character used for 68;; - `ruler-mode-inter-graduation-char' character used for
@@ -83,13 +81,15 @@
83;; `current-column' character. 81;; `current-column' character.
84;; - `ruler-mode-tab-stop-face' the face used to highlight tab stop 82;; - `ruler-mode-tab-stop-face' the face used to highlight tab stop
85;; characters. 83;; characters.
86;; - `ruler-mode-margins-face' the face used to highlight the 84;; - `ruler-mode-margins-face' the face used to highlight graduations
87;; `window-margins' areas. 85;; in the `window-margins' areas.
86;; - `ruler-mode-fringes-face' the face used to highlight graduations
87;; in the `window-fringes' areas.
88;; - `ruler-mode-column-number-face' the face used to highlight the 88;; - `ruler-mode-column-number-face' the face used to highlight the
89;; number graduations. 89;; numbered graduations.
90;; 90;;
91;; `ruler-mode-default-face' inherits from the built-in `default' face. 91;; `ruler-mode-default-face' inherits from the built-in `default' face.
92;; All `ruler-mode' faces inerit from `ruler-mode-default-face'. 92;; All `ruler-mode' faces inherit from `ruler-mode-default-face'.
93;; 93;;
94;; WARNING: To keep ruler graduations aligned on text columns it is 94;; WARNING: To keep ruler graduations aligned on text columns it is
95;; important to use the same font family and size for ruler and text 95;; important to use the same font family and size for ruler and text
@@ -179,14 +179,6 @@ or remove a tab stop. \\[ruler-mode-toggle-show-tab-stops] or
179 (integer :tag "Integer char value" 179 (integer :tag "Integer char value"
180 :validate ruler-mode-character-validate))) 180 :validate ruler-mode-character-validate)))
181 181
182(defcustom ruler-mode-margins-char ?\s
183 "*Character used in margin areas."
184 :group 'ruler-mode
185 :type '(choice
186 (character :tag "Character")
187 (integer :tag "Integer char value"
188 :validate ruler-mode-character-validate)))
189
190(defcustom ruler-mode-basic-graduation-char ?\. 182(defcustom ruler-mode-basic-graduation-char ?\.
191 "*Character used for basic graduations." 183 "*Character used for basic graduations."
192 :group 'ruler-mode 184 :group 'ruler-mode
@@ -225,6 +217,34 @@ or remove a tab stop. \\[ruler-mode-toggle-show-tab-stops] or
225 "Default face used by the ruler." 217 "Default face used by the ruler."
226 :group 'ruler-mode) 218 :group 'ruler-mode)
227 219
220(defface ruler-mode-pad-face
221 '((((type tty))
222 (:inherit ruler-mode-default-face
223 :background "grey50"
224 ))
225 (t
226 (:inherit ruler-mode-default-face
227 :background "grey64"
228 )))
229 "Face used to pad inactive ruler areas."
230 :group 'ruler-mode)
231
232(defface ruler-mode-margins-face
233 '((t
234 (:inherit ruler-mode-default-face
235 :foreground "white"
236 )))
237 "Face used to highlight margin areas."
238 :group 'ruler-mode)
239
240(defface ruler-mode-fringes-face
241 '((t
242 (:inherit ruler-mode-default-face
243 :foreground "green"
244 )))
245 "Face used to highlight fringes areas."
246 :group 'ruler-mode)
247
228(defface ruler-mode-column-number-face 248(defface ruler-mode-column-number-face
229 '((t 249 '((t
230 (:inherit ruler-mode-default-face 250 (:inherit ruler-mode-default-face
@@ -265,18 +285,6 @@ or remove a tab stop. \\[ruler-mode-toggle-show-tab-stops] or
265 "Face used to highlight tab stop characters." 285 "Face used to highlight tab stop characters."
266 :group 'ruler-mode) 286 :group 'ruler-mode)
267 287
268(defface ruler-mode-margins-face
269 '((((type tty))
270 (:inherit ruler-mode-default-face
271 :background "grey50"
272 ))
273 (t
274 (:inherit ruler-mode-default-face
275 :background "grey64"
276 )))
277 "Face used to highlight the `window-margins' areas."
278 :group 'ruler-mode)
279
280(defface ruler-mode-current-column-face 288(defface ruler-mode-current-column-face
281 '((t 289 '((t
282 (:inherit ruler-mode-default-face 290 (:inherit ruler-mode-default-face
@@ -286,207 +294,251 @@ or remove a tab stop. \\[ruler-mode-toggle-show-tab-stops] or
286 "Face used to highlight the `current-column' character." 294 "Face used to highlight the `current-column' character."
287 :group 'ruler-mode) 295 :group 'ruler-mode)
288 296
297(defmacro ruler-mode-left-fringe-cols ()
298 "Return the width, measured in columns, of the left fringe area."
299 '(ceiling (or (car (window-fringes)) 0)
300 (frame-char-width)))
301
302(defmacro ruler-mode-right-fringe-cols ()
303 "Return the width, measured in columns, of the right fringe area."
304 '(ceiling (or (nth 1 (window-fringes)) 0)
305 (frame-char-width)))
306
307(defun ruler-mode-left-scroll-bar-cols ()
308 "Return the width, measured in columns, of the right vertical scrollbar."
309 (let* ((wsb (window-scroll-bars))
310 (vtype (nth 2 wsb))
311 (cols (nth 1 wsb)))
312 (if (or (eq vtype 'left)
313 (and (eq vtype t)
314 (eq (frame-parameter nil 'vertical-scroll-bars) 'left)))
315 (or cols
316 (ceiling
317 ;; nil means it's a non-toolkit scroll bar,
318 ;; and its width in columns is 14 pixels rounded up.
319 (or (frame-parameter nil 'scroll-bar-width) 14)
320 ;; Always round up to multiple of columns.
321 (frame-char-width)))
322 0)))
323
324(defun ruler-mode-right-scroll-bar-cols ()
325 "Return the width, measured in columns, of the right vertical scrollbar."
326 (let* ((wsb (window-scroll-bars))
327 (vtype (nth 2 wsb))
328 (cols (nth 1 wsb)))
329 (if (or (eq vtype 'right)
330 (and (eq vtype t)
331 (eq (frame-parameter nil 'vertical-scroll-bars) 'right)))
332 (or cols
333 (ceiling
334 ;; nil means it's a non-toolkit scroll bar,
335 ;; and its width in columns is 14 pixels rounded up.
336 (or (frame-parameter nil 'scroll-bar-width) 14)
337 ;; Always round up to multiple of columns.
338 (frame-char-width)))
339 0)))
340
341(defsubst ruler-mode-full-window-width ()
342 "Return the full width of the selected window."
343 (let ((edges (window-edges)))
344 (- (nth 2 edges) (nth 0 edges))))
345
346(defsubst ruler-mode-window-col (n)
347 "Return a column number relative to the selected window.
348N is a column number relative to selected frame."
349 (- n
350 (car (window-edges))
351 (or (car (window-margins)) 0)
352 (ruler-mode-left-fringe-cols)
353 (ruler-mode-left-scroll-bar-cols)))
354
289(defun ruler-mode-mouse-set-left-margin (start-event) 355(defun ruler-mode-mouse-set-left-margin (start-event)
290 "Set left margin to the graduation where the mouse pointer is on. 356 "Set left margin end to the graduation where the mouse pointer is on.
291START-EVENT is the mouse click event." 357START-EVENT is the mouse click event."
292 (interactive "e") 358 (interactive "e")
293 (let* ((start (event-start start-event)) 359 (let* ((start (event-start start-event))
294 (end (event-end start-event)) 360 (end (event-end start-event))
295 w col m lm0 lm rm) 361 col w lm rm)
296 (if (eq start end) ;; mouse click 362 (when (eq start end) ;; mouse click
297 (save-selected-window 363 (save-selected-window
298 (select-window (posn-window start)) 364 (select-window (posn-window start))
299 (setq m (window-margins) 365 (setq col (- (car (posn-col-row start)) (car (window-edges))
300 lm0 (or (car m) 0) 366 (ruler-mode-left-scroll-bar-cols))
301 rm (or (cdr m) 0) 367 w (- (ruler-mode-full-window-width)
302 w (window-width) 368 (ruler-mode-left-scroll-bar-cols)
303 col (car (posn-col-row start)) 369 (ruler-mode-right-scroll-bar-cols)))
304 lm (min (- w rm) col)) 370 (when (and (>= col 0) (< col w))
305 (message "Left margin set to %d (was %d)" lm lm0) 371 (setq lm (window-margins)
306 (set-window-margins nil lm rm))))) 372 rm (or (cdr lm) 0)
373 lm (or (car lm) 0))
374 (message "Left margin set to %d (was %d)" col lm)
375 (set-window-margins nil col rm))))))
307 376
308(defun ruler-mode-mouse-set-right-margin (start-event) 377(defun ruler-mode-mouse-set-right-margin (start-event)
309 "Set right margin to the graduation where the mouse pointer is on. 378 "Set right margin beginning to the graduation where the mouse pointer is on.
310START-EVENT is the mouse click event." 379START-EVENT is the mouse click event."
311 (interactive "e") 380 (interactive "e")
312 (let* ((start (event-start start-event)) 381 (let* ((start (event-start start-event))
313 (end (event-end start-event)) 382 (end (event-end start-event))
314 m col w lm rm0 rm) 383 col w lm rm)
315 (if (eq start end) ;; mouse click 384 (when (eq start end) ;; mouse click
316 (save-selected-window 385 (save-selected-window
317 (select-window (posn-window start)) 386 (select-window (posn-window start))
318 (setq m (window-margins) 387 (setq col (- (car (posn-col-row start)) (car (window-edges))
319 rm0 (or (cdr m) 0) 388 (ruler-mode-left-scroll-bar-cols))
320 lm (or (car m) 0) 389 w (- (ruler-mode-full-window-width)
321 col (car (posn-col-row start)) 390 (ruler-mode-left-scroll-bar-cols)
322 w (window-width) 391 (ruler-mode-right-scroll-bar-cols)))
323 rm (max 0 (- w col))) 392 (when (and (>= col 0) (< col w))
324 (message "Right margin set to %d (was %d)" rm rm0) 393 (setq lm (window-margins)
325 (set-window-margins nil lm rm))))) 394 rm (or (cdr lm) 0)
326 395 lm (or (car lm) 0)
327(defvar ruler-mode-mouse-current-grab-object nil 396 col (- w col 1))
397 (message "Right margin set to %d (was %d)" col rm)
398 (set-window-margins nil lm col))))))
399
400(defvar ruler-mode-dragged-symbol nil
328 "Column symbol dragged in the ruler. 401 "Column symbol dragged in the ruler.
329That is `fill-column', `comment-column', `goal-column', or nil when 402That is `fill-column', `comment-column', `goal-column', or nil when
330nothing is dragged.") 403nothing is dragged.")
331 404
332(defun ruler-mode-mouse-grab-any-column (start-event) 405(defun ruler-mode-mouse-grab-any-column (start-event)
333 "Set a column symbol to the graduation with mouse dragging. 406 "Drag a column symbol on the ruler.
334See also variable `ruler-mode-mouse-current-grab-object'. 407Start dragging on mouse down event START-EVENT, and update the column
335START-EVENT is the mouse down event." 408symbol value with the current value of the ruler graduation while
409dragging. See also the variable `ruler-mode-dragged-symbol'."
336 (interactive "e") 410 (interactive "e")
337 (setq ruler-mode-mouse-current-grab-object nil) 411 (setq ruler-mode-dragged-symbol nil)
338 (let* ((start (event-start start-event)) 412 (let* ((start (event-start start-event))
339 m col w lm rm hs newc oldc) 413 col newc oldc)
340 (save-selected-window 414 (save-selected-window
341 (select-window (posn-window start)) 415 (select-window (posn-window start))
342 (setq m (window-margins) 416 (setq col (ruler-mode-window-col (car (posn-col-row start)))
343 lm (or (car m) 0) 417 newc (+ col (window-hscroll)))
344 rm (or (cdr m) 0) 418 (and
345 col (- (car (posn-col-row start)) lm) 419 (>= col 0) (< col (window-width))
346 w (window-width) 420 (cond
347 hs (window-hscroll) 421
348 newc (+ col hs)) 422 ;; Handle the fill column.
349 ;; 423 ((eq newc fill-column)
350 ;; About the ways to handle the goal column: 424 (setq oldc fill-column
351 ;; A. update the value of the goal column if goal-column has 425 ruler-mode-dragged-symbol 'fill-column)
352 ;; non-nil value and if the mouse is dragged 426 t) ;; Start dragging
353 ;; B. set value to the goal column if goal-column has nil and if 427
354 ;; the mouse is just clicked, not dragged. 428 ;; Handle the comment column.
355 ;; C. unset value to the goal column if goal-column has non-nil 429 ((eq newc comment-column)
356 ;; and mouse is just clicked on goal-column character on the 430 (setq oldc comment-column
357 ;; ruler, not dragged. 431 ruler-mode-dragged-symbol 'comment-column)
358 ;; 432 t) ;; Start dragging
359 (and (>= col 0) (< (+ col lm rm) w) 433
360 (cond 434 ;; Handle the goal column.
361 ((eq newc fill-column) 435 ;; A. On mouse down on the goal column character on the ruler,
362 (setq oldc fill-column) 436 ;; update the `goal-column' value while dragging.
363 (setq ruler-mode-mouse-current-grab-object 'fill-column) 437 ;; B. If `goal-column' is nil, set the goal column where the
364 t) 438 ;; mouse is clicked.
365 ((eq newc comment-column) 439 ;; C. On mouse click on the goal column character on the
366 (setq oldc comment-column) 440 ;; ruler, unset the goal column.
367 (setq ruler-mode-mouse-current-grab-object 'comment-column) 441 ((eq newc goal-column) ; A. Drag the goal column.
368 t) 442 (setq oldc goal-column
369 ((eq newc goal-column) ; A. update goal column 443 ruler-mode-dragged-symbol 'goal-column)
370 (setq oldc goal-column) 444 t) ;; Start dragging
371 (setq ruler-mode-mouse-current-grab-object 'goal-column) 445
372 t) 446 ((null goal-column) ; B. Set the goal column.
373 ((null goal-column) ; B. set goal column 447 (setq oldc goal-column
374 (setq oldc goal-column) 448 goal-column newc)
375 (setq goal-column newc) 449 ;; mouse-2 coming AFTER drag-mouse-2 invokes `ding'. This
376 ;; mouse-2 coming AFTER drag-mouse-2 invokes `ding'. 450 ;; `ding' flushes the next messages about setting goal
377 ;; This `ding' flushes the next messages about setting 451 ;; column. So here I force fetch the event(mouse-2) and
378 ;; goal column. So here I force fetch the event(mouse-2) 452 ;; throw away.
379 ;; and throw away. 453 (read-event)
380 (read-event) 454 ;; Ding BEFORE `message' is OK.
381 ;; Ding BEFORE `message' is OK. 455 (when ruler-mode-set-goal-column-ding-flag
382 (if ruler-mode-set-goal-column-ding-flag 456 (ding))
383 (ding)) 457 (message "Goal column set to %d (click on %s again to unset it)"
384 (message 458 newc
385 "Goal column %d (click `%s' on the ruler again to unset it)" 459 (propertize (char-to-string ruler-mode-goal-column-char)
386 newc 460 'face 'ruler-mode-goal-column-face))
387 (propertize (char-to-string ruler-mode-goal-column-char) 461 nil) ;; Don't start dragging.
388 'face 'ruler-mode-goal-column-face)) 462 )
389 ;; don't enter drag iteration 463 (if (eq 'click (ruler-mode-mouse-drag-any-column-iteration
390 nil)) 464 (posn-window start)))
391 (if (eq 'click (ruler-mode-mouse-drag-any-column-iteration 465 (when (eq 'goal-column ruler-mode-dragged-symbol)
392 (posn-window start))) 466 ;; C. Unset the goal column.
393 (if (eq 'goal-column ruler-mode-mouse-current-grab-object) 467 (set-goal-column t))
394 ;; C. unset goal column 468 ;; At end of dragging, report the updated column symbol.
395 (set-goal-column t)) 469 (message "%s is set to %d (was %d)"
396 ;; *-column is updated; report it 470 ruler-mode-dragged-symbol
397 (message "%s is set to %d (was %d)" 471 (symbol-value ruler-mode-dragged-symbol)
398 ruler-mode-mouse-current-grab-object 472 oldc))))))
399 (eval ruler-mode-mouse-current-grab-object)
400 oldc))))))
401 473
402(defun ruler-mode-mouse-drag-any-column-iteration (window) 474(defun ruler-mode-mouse-drag-any-column-iteration (window)
403 "Update the ruler while dragging the mouse. 475 "Update the ruler while dragging the mouse.
404WINDOW is the window where the last down-mouse event is occurred. 476WINDOW is the window where occurred the last down-mouse event.
405Return a symbol `drag' if the mouse is actually dragged. 477Return the symbol `drag' if the mouse has been dragged, or `click' if
406Return a symbol `click' if the mouse is just clicked." 478the mouse has been clicked."
407 (let (newevent 479 (let ((drags 0)
408 (drag-count 0)) 480 event)
409 (track-mouse 481 (track-mouse
410 (while (progn 482 (while (mouse-movement-p (setq event (read-event)))
411 (setq newevent (read-event)) 483 (setq drags (1+ drags))
412 (mouse-movement-p newevent)) 484 (when (eq window (posn-window (event-end event)))
413 (setq drag-count (1+ drag-count)) 485 (ruler-mode-mouse-drag-any-column event)
414 (if (eq window (posn-window (event-end newevent))) 486 (force-mode-line-update))))
415 (progn 487 (if (and (zerop drags) (eq 'click (car (event-modifiers event))))
416 (ruler-mode-mouse-drag-any-column newevent)
417 (force-mode-line-update)))))
418 (if (and (eq drag-count 0)
419 (eq 'click (car (event-modifiers newevent))))
420 'click 488 'click
421 'drag))) 489 'drag)))
422 490
423(defun ruler-mode-mouse-drag-any-column (start-event) 491(defun ruler-mode-mouse-drag-any-column (start-event)
424 "Update the ruler for START-EVENT, one mouse motion event." 492 "Update the value of the symbol dragged on the ruler.
493Called on each mouse motion event START-EVENT."
425 (let* ((start (event-start start-event)) 494 (let* ((start (event-start start-event))
426 (end (event-end start-event)) 495 (end (event-end start-event))
427 m col w lm rm hs newc) 496 col newc)
428 (save-selected-window 497 (save-selected-window
429 (select-window (posn-window start)) 498 (select-window (posn-window start))
430 (setq m (window-margins) 499 (setq col (ruler-mode-window-col (car (posn-col-row end)))
431 lm (or (car m) 0) 500 newc (+ col (window-hscroll)))
432 rm (or (cdr m) 0) 501 (when (and (>= col 0) (< col (window-width)))
433 col (- (car (posn-col-row end)) lm) 502 (set ruler-mode-dragged-symbol newc)))))
434 w (window-width)
435 hs (window-hscroll)
436 newc (+ col hs))
437 (if (and (>= col 0) (< (+ col lm rm) w))
438 (set ruler-mode-mouse-current-grab-object newc)))))
439 503
440(defun ruler-mode-mouse-add-tab-stop (start-event) 504(defun ruler-mode-mouse-add-tab-stop (start-event)
441 "Add a tab stop to the graduation where the mouse pointer is on. 505 "Add a tab stop to the graduation where the mouse pointer is on.
442START-EVENT is the mouse click event." 506START-EVENT is the mouse click event."
443 (interactive "e") 507 (interactive "e")
444 (if ruler-mode-show-tab-stops 508 (when ruler-mode-show-tab-stops
445 (let* ((start (event-start start-event)) 509 (let* ((start (event-start start-event))
446 (end (event-end start-event)) 510 (end (event-end start-event))
447 m col w lm rm hs ts) 511 col ts)
448 (if (eq start end) ;; mouse click 512 (when (eq start end) ;; mouse click
449 (save-selected-window 513 (save-selected-window
450 (select-window (posn-window start)) 514 (select-window (posn-window start))
451 (setq m (window-margins) 515 (setq col (ruler-mode-window-col (car (posn-col-row start)))
452 lm (or (car m) 0) 516 ts (+ col (window-hscroll)))
453 rm (or (cdr m) 0) 517 (and (>= col 0) (< col (window-width))
454 col (- (car (posn-col-row start)) lm) 518 (not (member ts tab-stop-list))
455 w (window-width) 519 (progn
456 hs (window-hscroll) 520 (message "Tab stop set to %d" ts)
457 ts (+ col hs)) 521 (setq tab-stop-list (sort (cons ts tab-stop-list)
458 (and (>= col 0) (< (+ col lm rm) w) 522 #'<)))))))))
459 (not (member ts tab-stop-list))
460 (progn
461 (message "Tab stop set to %d" ts)
462 (setq tab-stop-list
463 (sort (cons ts tab-stop-list)
464 #'<)))))))))
465 523
466(defun ruler-mode-mouse-del-tab-stop (start-event) 524(defun ruler-mode-mouse-del-tab-stop (start-event)
467 "Delete tab stop at the graduation where the mouse pointer is on. 525 "Delete tab stop at the graduation where the mouse pointer is on.
468START-EVENT is the mouse click event." 526START-EVENT is the mouse click event."
469 (interactive "e") 527 (interactive "e")
470 (if ruler-mode-show-tab-stops 528 (when ruler-mode-show-tab-stops
471 (let* ((start (event-start start-event)) 529 (let* ((start (event-start start-event))
472 (end (event-end start-event)) 530 (end (event-end start-event))
473 m col w lm rm hs ts) 531 col ts)
474 (if (eq start end) ;; mouse click 532 (when (eq start end) ;; mouse click
475 (save-selected-window 533 (save-selected-window
476 (select-window (posn-window start)) 534 (select-window (posn-window start))
477 (setq m (window-margins) 535 (setq col (ruler-mode-window-col (car (posn-col-row start)))
478 lm (or (car m) 0) 536 ts (+ col (window-hscroll)))
479 rm (or (cdr m) 0) 537 (and (>= col 0) (< col (window-width))
480 col (- (car (posn-col-row start)) lm) 538 (member ts tab-stop-list)
481 w (window-width) 539 (progn
482 hs (window-hscroll) 540 (message "Tab stop at %d deleted" ts)
483 ts (+ col hs)) 541 (setq tab-stop-list (delete ts tab-stop-list)))))))))
484 (and (>= col 0) (< (+ col lm rm) w)
485 (member ts tab-stop-list)
486 (progn
487 (message "Tab stop at %d deleted" ts)
488 (setq tab-stop-list
489 (delete ts tab-stop-list)))))))))
490 542
491(defun ruler-mode-toggle-show-tab-stops () 543(defun ruler-mode-toggle-show-tab-stops ()
492 "Toggle showing of tab stops on the ruler." 544 "Toggle showing of tab stops on the ruler."
@@ -542,7 +594,7 @@ START-EVENT is the mouse click event."
542 ;; the current one is the ruler header line format. 594 ;; the current one is the ruler header line format.
543 (when (eq header-line-format ruler-mode-header-line-format) 595 (when (eq header-line-format ruler-mode-header-line-format)
544 (kill-local-variable 'header-line-format) 596 (kill-local-variable 'header-line-format)
545 (when ruler-mode-header-line-format-old 597 (when (local-variable-p 'ruler-mode-header-line-format-old)
546 (setq header-line-format ruler-mode-header-line-format-old))) 598 (setq header-line-format ruler-mode-header-line-format-old)))
547 (remove-hook 'post-command-hook ; remove local hook 599 (remove-hook 'post-command-hook ; remove local hook
548 #'force-mode-line-update t))) 600 #'force-mode-line-update t)))
@@ -588,195 +640,150 @@ drag-mouse-2: set goal column, \
588mouse-2: unset goal column" 640mouse-2: unset goal column"
589 "Help string shown when mouse is on the goal column character.") 641 "Help string shown when mouse is on the goal column character.")
590 642
591(defconst ruler-mode-left-margin-help-echo 643(defconst ruler-mode-margin-help-echo
592 "Left margin %S" 644 "%s margin %S"
593 "Help string shown when mouse is over the left margin area.") 645 "Help string shown when mouse is over a margin area.")
594 646
595(defconst ruler-mode-right-margin-help-echo 647(defconst ruler-mode-fringe-help-echo
596 "Right margin %S" 648 "%s fringe %S"
597 "Help string shown when mouse is over the right margin area.") 649 "Help string shown when mouse is over a fringe area.")
598
599(defmacro ruler-mode-left-fringe-cols ()
600 "Return the width, measured in columns, of the left fringe area."
601 '(round (or (frame-parameter nil 'left-fringe) 0)
602 (frame-char-width)))
603
604(defmacro ruler-mode-right-fringe-cols ()
605 "Return the width, measured in columns, of the right fringe area."
606 '(round (or (frame-parameter nil 'right-fringe) 0)
607 (frame-char-width)))
608
609(defmacro ruler-mode-left-scroll-bar-cols ()
610 "Return the width, measured in columns, of the left vertical scrollbar."
611 '(if (eq (frame-parameter nil 'vertical-scroll-bars) 'left)
612 (let ((sbw (frame-parameter nil 'scroll-bar-width)))
613 ;; nil means it's a non-toolkit scroll bar,
614 ;; and its width in columns is 14 pixels rounded up.
615 (unless sbw (setq sbw 14))
616 ;; Always round up to multiple of columns.
617 (ceiling sbw (frame-char-width)))
618 0))
619
620(defmacro ruler-mode-right-scroll-bar-cols ()
621 "Return the width, measured in columns, of the right vertical scrollbar."
622 '(if (eq (frame-parameter nil 'vertical-scroll-bars) 'right)
623 (round (or (frame-parameter nil 'scroll-bar-width) 0)
624 (frame-char-width))
625 0))
626 650
627(defun ruler-mode-ruler () 651(defun ruler-mode-ruler ()
628 "Return a string ruler." 652 "Return a string ruler."
629 (if ruler-mode 653 (when ruler-mode
630 (let* ((j (+ (ruler-mode-left-fringe-cols) 654 (let* ((fullw (ruler-mode-full-window-width))
631 (ruler-mode-left-scroll-bar-cols))) 655 (w (window-width))
632 (w (+ (window-width) j)) 656 (m (window-margins))
633 (m (window-margins)) 657 (lsb (ruler-mode-left-scroll-bar-cols))
634 (l (or (car m) 0)) 658 (lf (ruler-mode-left-fringe-cols))
635 (r (or (cdr m) 0)) 659 (lm (or (car m) 0))
636 (o (- (window-hscroll) l j)) 660 (rsb (ruler-mode-right-scroll-bar-cols))
637 (i 0) 661 (rf (ruler-mode-right-fringe-cols))
638 (ruler (concat 662 (rm (or (cdr m) 0))
639 ;; unit graduations 663 (ruler (make-string fullw ruler-mode-basic-graduation-char))
640 (make-string w ruler-mode-basic-graduation-char) 664 (o (+ lsb lf lm))
641 ;; extra space to fill the header line 665 (x 0)
642 (make-string (+ (ruler-mode-right-fringe-cols) 666 (i o)
643 (ruler-mode-right-scroll-bar-cols)) 667 (j (window-hscroll))
644 ?\ ))) 668 k c l1 l2 r2 r1 h1 h2 f1 f2)
645 c k) 669
646 670 ;; Setup the default properties.
647 ;; Setup default face and help echo. 671 (put-text-property 0 fullw 'face 'ruler-mode-default-face ruler)
648 (put-text-property 0 (length ruler) 672 (put-text-property 0 fullw
649 'face 'ruler-mode-default-face 673 'help-echo
650 ruler) 674 (cond
651 (put-text-property 0 (length ruler) 675 (ruler-mode-show-tab-stops
652 'help-echo 676 ruler-mode-ruler-help-echo-when-tab-stops)
653 (if ruler-mode-show-tab-stops 677 (goal-column
654 ruler-mode-ruler-help-echo-when-tab-stops 678 ruler-mode-ruler-help-echo-when-goal-column)
655 (if goal-column 679 (t
656 ruler-mode-ruler-help-echo-when-goal-column 680 ruler-mode-ruler-help-echo))
657 ruler-mode-ruler-help-echo)) 681 ruler)
658 ruler) 682 ;; Setup the local map.
659 ;; Setup the local map. 683 (put-text-property 0 fullw 'local-map ruler-mode-map ruler)
660 (put-text-property 0 (length ruler) 684
661 'local-map ruler-mode-map 685 ;; Setup the active area.
662 ruler) 686 (while (< x w)
663 687 ;; Graduations.
664 (setq j (+ l j)) 688 (cond
665 ;; Setup the left margin area. 689 ;; Show a number graduation.
666 (put-text-property 690 ((= (mod j 10) 0)
667 i j 'face 'ruler-mode-margins-face 691 (setq c (number-to-string (/ j 10))
668 ruler) 692 m (length c)
669 (put-text-property 693 k i)
670 i j 'help-echo (format ruler-mode-left-margin-help-echo l) 694 (put-text-property
671 ruler) 695 i (1+ i) 'face 'ruler-mode-column-number-face
672 (while (< i j) 696 ruler)
673 (aset ruler i ruler-mode-margins-char) 697 (while (and (> m 0) (>= k 0))
674 (setq i (1+ i))) 698 (aset ruler k (aref c (setq m (1- m))))
675 699 (setq k (1- k))))
676 ;; Setup the ruler area. 700 ;; Show an intermediate graduation.
677 (setq r (- w r)) 701 ((= (mod j 5) 0)
678 (while (< i r) 702 (aset ruler i ruler-mode-inter-graduation-char)))
679 (setq j (+ i o)) 703 ;; Special columns.
680 (cond 704 (cond
681 ((= (mod j 10) 0) 705 ;; Show the `current-column' marker.
682 (setq c (number-to-string (/ j 10)) 706 ((= j (current-column))
683 m (length c) 707 (aset ruler i ruler-mode-current-column-char)
684 k i) 708 (put-text-property
685 (put-text-property 709 i (1+ i) 'face 'ruler-mode-current-column-face
686 i (1+ i) 'face 'ruler-mode-column-number-face 710 ruler))
687 ruler) 711 ;; Show the `goal-column' marker.
688 (while (and (> m 0) (>= k 0)) 712 ((and goal-column (= j goal-column))
689 (aset ruler k (aref c (setq m (1- m)))) 713 (aset ruler i ruler-mode-goal-column-char)
690 (setq k (1- k))) 714 (put-text-property
691 ) 715 i (1+ i) 'face 'ruler-mode-goal-column-face
692 ((= (mod j 5) 0) 716 ruler)
693 (aset ruler i ruler-mode-inter-graduation-char) 717 (put-text-property
694 ) 718 i (1+ i) 'help-echo ruler-mode-goal-column-help-echo
695 ) 719 ruler))
696 (setq i (1+ i))) 720 ;; Show the `comment-column' marker.
697 721 ((= j comment-column)
698 ;; Setup the right margin area. 722 (aset ruler i ruler-mode-comment-column-char)
699 (put-text-property 723 (put-text-property
700 i (length ruler) 'face 'ruler-mode-margins-face 724 i (1+ i) 'face 'ruler-mode-comment-column-face
701 ruler) 725 ruler)
702 (put-text-property 726 (put-text-property
703 i (length ruler) 'help-echo 727 i (1+ i) 'help-echo ruler-mode-comment-column-help-echo
704 (format ruler-mode-right-margin-help-echo (- w r)) 728 ruler))
705 ruler) 729 ;; Show the `fill-column' marker.
706 (while (< i (length ruler)) 730 ((= j fill-column)
707 (aset ruler i ruler-mode-margins-char) 731 (aset ruler i ruler-mode-fill-column-char)
708 (setq i (1+ i))) 732 (put-text-property
709 733 i (1+ i) 'face 'ruler-mode-fill-column-face
710 ;; Show the `goal-column' marker. 734 ruler)
711 (if goal-column 735 (put-text-property
712 (progn 736 i (1+ i) 'help-echo ruler-mode-fill-column-help-echo
713 (setq i (- goal-column o)) 737 ruler))
714 (and (>= i 0) (< i r) 738 ;; Show the `tab-stop-list' markers.
715 (aset ruler i ruler-mode-goal-column-char) 739 ((and ruler-mode-show-tab-stops (member j tab-stop-list))
716 (progn 740 (aset ruler i ruler-mode-tab-stop-char)
717 (put-text-property 741 (put-text-property
718 i (1+ i) 'face 'ruler-mode-goal-column-face 742 i (1+ i) 'face 'ruler-mode-tab-stop-face
719 ruler) 743 ruler)))
720 (put-text-property 744 (setq i (1+ i)
721 i (1+ i) 'help-echo ruler-mode-goal-column-help-echo 745 j (1+ j)
722 ruler)) 746 x (1+ x)))
723 ))) 747
724 748 ;; Highlight the fringes and margins.
725 ;; Show the `comment-column' marker. 749 (if (nth 2 (window-fringes))
726 (setq i (- comment-column o)) 750 ;; fringes outside margins.
727 (and (>= i 0) (< i r) 751 (setq l1 lf
728 (aset ruler i ruler-mode-comment-column-char) 752 l2 lm
729 (progn 753 r2 rm
730 (put-text-property 754 r1 rf
731 i (1+ i) 'face 'ruler-mode-comment-column-face 755 h1 ruler-mode-fringe-help-echo
732 ruler) 756 h2 ruler-mode-margin-help-echo
733 (put-text-property 757 f1 'ruler-mode-fringes-face
734 i (1+ i) 'help-echo ruler-mode-comment-column-help-echo 758 f2 'ruler-mode-margins-face)
735 ruler))) 759 ;; fringes inside margins.
736 760 (setq l1 lm
737 ;; Show the `fill-column' marker. 761 l2 lf
738 (setq i (- fill-column o)) 762 r2 rf
739 (and (>= i 0) (< i r) 763 r1 rm
740 (aset ruler i ruler-mode-fill-column-char) 764 h1 ruler-mode-margin-help-echo
741 (progn (put-text-property 765 h2 ruler-mode-fringe-help-echo
742 i (1+ i) 'face 'ruler-mode-fill-column-face 766 f1 'ruler-mode-margins-face
743 ruler) 767 f2 'ruler-mode-fringes-face))
744 (put-text-property 768 (setq i lsb j (+ i l1))
745 i (1+ i) 'help-echo ruler-mode-fill-column-help-echo 769 (put-text-property i j 'face f1 ruler)
746 ruler))) 770 (put-text-property i j 'help-echo (format h1 "Left" l1) ruler)
747 771 (setq i j j (+ i l2))
748 ;; Show the `tab-stop-list' markers. 772 (put-text-property i j 'face f2 ruler)
749 (if ruler-mode-show-tab-stops 773 (put-text-property i j 'help-echo (format h2 "Left" l2) ruler)
750 (let ((tsl tab-stop-list) ts) 774 (setq i (+ o w) j (+ i r2))
751 (while tsl 775 (put-text-property i j 'face f2 ruler)
752 (setq ts (car tsl) 776 (put-text-property i j 'help-echo (format h2 "Right" r2) ruler)
753 tsl (cdr tsl) 777 (setq i j j (+ i r1))
754 i (- ts o)) 778 (put-text-property i j 'face f1 ruler)
755 (and (>= i 0) (< i r) 779 (put-text-property i j 'help-echo (format h1 "Right" r1) ruler)
756 (aset ruler i ruler-mode-tab-stop-char) 780
757 (put-text-property 781 ;; Show inactive areas.
758 i (1+ i) 782 (put-text-property 0 lsb 'face 'ruler-mode-pad-face ruler)
759 'face (cond 783 (put-text-property j fullw 'face 'ruler-mode-pad-face ruler)
760 ;; Don't override the *-column face 784
761 ((eq ts fill-column) 785 ;; Return the ruler propertized string.
762 'ruler-mode-fill-column-face) 786 ruler)))
763 ((eq ts comment-column)
764 'ruler-mode-comment-column-face)
765 ((eq ts goal-column)
766 'ruler-mode-goal-column-face)
767 (t
768 'ruler-mode-tab-stop-face))
769 ruler)))))
770
771 ;; Show the `current-column' marker.
772 (setq i (- (current-column) o))
773 (and (>= i 0) (< i r)
774 (aset ruler i ruler-mode-current-column-char)
775 (put-text-property
776 i (1+ i) 'face 'ruler-mode-current-column-face
777 ruler))
778
779 ruler)))
780 787
781(provide 'ruler-mode) 788(provide 'ruler-mode)
782 789