Move lisp/emacs-lisp/authors.el to admin/
[bpt/emacs.git] / lisp / ruler-mode.el
CommitLineData
479d4d97 1;;; ruler-mode.el --- display a ruler in the header line
4f4ff50a 2
ba318903 3;; Copyright (C) 2001-2014 Free Software Foundation, Inc.
4f4ff50a
GM
4
5;; Author: David Ponce <david@dponce.com>
6;; Maintainer: David Ponce <david@dponce.com>
7;; Created: 24 Mar 2001
3bb804d0 8;; Version: 1.6
2a8f99fa 9;; Keywords: convenience
4f4ff50a
GM
10
11;; This file is part of GNU Emacs.
12
2d673452 13;; GNU Emacs is free software: you can redistribute it and/or modify
eb3fa2cf
GM
14;; it under the terms of the GNU General Public License as published by
15;; the Free Software Foundation, either version 3 of the License, or
16;; (at your option) any later version.
4f4ff50a 17
2d673452 18;; GNU Emacs is distributed in the hope that it will be useful,
eb3fa2cf
GM
19;; but WITHOUT ANY WARRANTY; without even the implied warranty of
20;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
21;; GNU General Public License for more details.
4f4ff50a
GM
22
23;; You should have received a copy of the GNU General Public License
2d673452 24;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
4f4ff50a
GM
25
26;;; Commentary:
27
28;; This library provides a minor mode to display a ruler in the header
68130af7 29;; line. It works from Emacs 21 onwards.
4f4ff50a 30;;
60ab677b
JB
31;; You can use the mouse to change the `fill-column' `comment-column',
32;; `goal-column', `window-margins' and `tab-stop-list' settings:
4f4ff50a 33;;
3bb804d0 34;; [header-line (shift down-mouse-1)] set left margin end to the ruler
4f4ff50a
GM
35;; graduation where the mouse pointer is on.
36;;
3bb804d0
JB
37;; [header-line (shift down-mouse-3)] set right margin beginning to
38;; the ruler graduation where the mouse pointer is on.
4f4ff50a 39;;
3bb804d0
JB
40;; [header-line down-mouse-2] Drag the `fill-column', `comment-column'
41;; or `goal-column' to a ruler graduation.
4f4ff50a
GM
42;;
43;; [header-line (control down-mouse-1)] add a tab stop to the ruler
44;; graduation where the mouse pointer is on.
45;;
46;; [header-line (control down-mouse-3)] remove the tab stop at the
47;; ruler graduation where the mouse pointer is on.
48;;
49;; [header-line (control down-mouse-2)] or M-x
50;; `ruler-mode-toggle-show-tab-stops' toggle showing and visually
51;; editing `tab-stop-list' setting. The `ruler-mode-show-tab-stops'
52;; option controls if the ruler shows tab stops by default.
53;;
54;; In the ruler the character `ruler-mode-current-column-char' shows
55;; the `current-column' location, `ruler-mode-fill-column-char' shows
60ab677b
JB
56;; the `fill-column' location, `ruler-mode-comment-column-char' shows
57;; the `comment-column' location, `ruler-mode-goal-column-char' shows
3bb804d0
JB
58;; the `goal-column' and `ruler-mode-tab-stop-char' shows tab stop
59;; locations. Graduations in `window-margins' and `window-fringes'
60;; areas are shown with a different foreground color.
4f4ff50a
GM
61;;
62;; It is also possible to customize the following characters:
63;;
4f4ff50a
GM
64;; - `ruler-mode-basic-graduation-char' character used for basic
65;; graduations ('.' by default).
66;; - `ruler-mode-inter-graduation-char' character used for
67;; intermediate graduations ('!' by default).
68;;
69;; The following faces are customizable:
70;;
42e64878
MB
71;; - `ruler-mode-default' the ruler default face.
72;; - `ruler-mode-fill-column' the face used to highlight the
4f4ff50a 73;; `fill-column' character.
42e64878 74;; - `ruler-mode-comment-column' the face used to highlight the
60ab677b 75;; `comment-column' character.
42e64878 76;; - `ruler-mode-goal-column' the face used to highlight the
60ab677b 77;; `goal-column' character.
42e64878 78;; - `ruler-mode-current-column' the face used to highlight the
4f4ff50a 79;; `current-column' character.
42e64878 80;; - `ruler-mode-tab-stop' the face used to highlight tab stop
4f4ff50a 81;; characters.
42e64878 82;; - `ruler-mode-margins' the face used to highlight graduations
3bb804d0 83;; in the `window-margins' areas.
42e64878 84;; - `ruler-mode-fringes' the face used to highlight graduations
3bb804d0 85;; in the `window-fringes' areas.
42e64878 86;; - `ruler-mode-column-number' the face used to highlight the
3bb804d0 87;; numbered graduations.
4f4ff50a 88;;
42e64878
MB
89;; `ruler-mode-default' inherits from the built-in `default' face.
90;; All `ruler-mode' faces inherit from `ruler-mode-default'.
4f4ff50a
GM
91;;
92;; WARNING: To keep ruler graduations aligned on text columns it is
93;; important to use the same font family and size for ruler and text
94;; areas.
6b61353c
KH
95;;
96;; You can override the ruler format by defining an appropriate
97;; function as the buffer-local value of `ruler-mode-ruler-function'.
4f4ff50a
GM
98
99;; Installation
100;;
101;; To automatically display the ruler in specific major modes use:
102;;
103;; (add-hook '<major-mode>-hook 'ruler-mode)
104;;
105
106;;; History:
107;;
bfba6c09 108\f
4f4ff50a
GM
109;;; Code:
110(eval-when-compile
111 (require 'wid-edit))
6b61353c
KH
112(require 'scroll-bar)
113(require 'fringe)
4f4ff50a
GM
114
115(defgroup ruler-mode nil
116 "Display a ruler in the header line."
bf247b6e 117 :version "22.1"
2a8f99fa 118 :group 'convenience)
4f4ff50a
GM
119
120(defcustom ruler-mode-show-tab-stops nil
9201cc28 121 "If non-nil the ruler shows tab stop positions.
4f4ff50a
GM
122Also allowing to visually change `tab-stop-list' setting using
123<C-down-mouse-1> and <C-down-mouse-3> on the ruler to respectively add
124or remove a tab stop. \\[ruler-mode-toggle-show-tab-stops] or
125<C-down-mouse-2> on the ruler toggles showing/editing of tab stops."
126 :group 'ruler-mode
127 :type 'boolean)
128
129;; IMPORTANT: This function must be defined before the following
130;; defcustoms because it is used in their :validate clause.
131(defun ruler-mode-character-validate (widget)
132 "Ensure WIDGET value is a valid character value."
133 (save-excursion
134 (let ((value (widget-value widget)))
ab2cbf67 135 (unless (characterp value)
4f4ff50a
GM
136 (widget-put widget :error
137 (format "Invalid character value: %S" value))
138 widget))))
60ab677b 139
c38e0c97
PE
140(defcustom ruler-mode-fill-column-char (if (char-displayable-p ?¶)
141 ?\¶
4f4ff50a 142 ?\|)
9201cc28 143 "Character used at the `fill-column' location."
4f4ff50a
GM
144 :group 'ruler-mode
145 :type '(choice
146 (character :tag "Character")
147 (integer :tag "Integer char value"
148 :validate ruler-mode-character-validate)))
149
60ab677b 150(defcustom ruler-mode-comment-column-char ?\#
9201cc28 151 "Character used at the `comment-column' location."
60ab677b
JB
152 :group 'ruler-mode
153 :type '(choice
154 (character :tag "Character")
155 (integer :tag "Integer char value"
156 :validate ruler-mode-character-validate)))
157
158(defcustom ruler-mode-goal-column-char ?G
9201cc28 159 "Character used at the `goal-column' location."
60ab677b
JB
160 :group 'ruler-mode
161 :type '(choice
162 (character :tag "Character")
163 (integer :tag "Integer char value"
164 :validate ruler-mode-character-validate)))
165
c38e0c97
PE
166(defcustom ruler-mode-current-column-char (if (char-displayable-p ?¦)
167 ?\¦
4f4ff50a 168 ?\@)
9201cc28 169 "Character used at the `current-column' location."
4f4ff50a
GM
170 :group 'ruler-mode
171 :type '(choice
172 (character :tag "Character")
173 (integer :tag "Integer char value"
174 :validate ruler-mode-character-validate)))
175
176(defcustom ruler-mode-tab-stop-char ?\T
9201cc28 177 "Character used at `tab-stop-list' locations."
4f4ff50a
GM
178 :group 'ruler-mode
179 :type '(choice
180 (character :tag "Character")
181 (integer :tag "Integer char value"
182 :validate ruler-mode-character-validate)))
183
4f4ff50a 184(defcustom ruler-mode-basic-graduation-char ?\.
9201cc28 185 "Character used for basic graduations."
4f4ff50a
GM
186 :group 'ruler-mode
187 :type '(choice
188 (character :tag "Character")
189 (integer :tag "Integer char value"
190 :validate ruler-mode-character-validate)))
191
192(defcustom ruler-mode-inter-graduation-char ?\!
9201cc28 193 "Character used for intermediate graduations."
4f4ff50a
GM
194 :group 'ruler-mode
195 :type '(choice
196 (character :tag "Character")
197 (integer :tag "Integer char value"
198 :validate ruler-mode-character-validate)))
60ab677b
JB
199
200(defcustom ruler-mode-set-goal-column-ding-flag t
9201cc28 201 "Non-nil means do `ding' when `goal-column' is set."
60ab677b
JB
202 :group 'ruler-mode
203 :type 'boolean)
bfba6c09 204\f
42e64878 205(defface ruler-mode-default
4f4ff50a
GM
206 '((((type tty))
207 (:inherit default
208 :background "grey64"
209 :foreground "grey50"
210 ))
211 (t
212 (:inherit default
213 :background "grey76"
214 :foreground "grey64"
215 :box (:color "grey76"
216 :line-width 1
217 :style released-button)
218 )))
219 "Default face used by the ruler."
220 :group 'ruler-mode)
221
42e64878 222(defface ruler-mode-pad
3bb804d0 223 '((((type tty))
42e64878 224 (:inherit ruler-mode-default
3bb804d0
JB
225 :background "grey50"
226 ))
227 (t
42e64878 228 (:inherit ruler-mode-default
3bb804d0
JB
229 :background "grey64"
230 )))
231 "Face used to pad inactive ruler areas."
232 :group 'ruler-mode)
233
42e64878 234(defface ruler-mode-margins
3bb804d0 235 '((t
42e64878 236 (:inherit ruler-mode-default
3bb804d0
JB
237 :foreground "white"
238 )))
239 "Face used to highlight margin areas."
240 :group 'ruler-mode)
241
42e64878 242(defface ruler-mode-fringes
3bb804d0 243 '((t
42e64878 244 (:inherit ruler-mode-default
3bb804d0
JB
245 :foreground "green"
246 )))
247 "Face used to highlight fringes areas."
248 :group 'ruler-mode)
249
42e64878 250(defface ruler-mode-column-number
4f4ff50a 251 '((t
42e64878 252 (:inherit ruler-mode-default
4f4ff50a
GM
253 :foreground "black"
254 )))
255 "Face used to highlight number graduations."
256 :group 'ruler-mode)
257
42e64878 258(defface ruler-mode-fill-column
4f4ff50a 259 '((t
42e64878 260 (:inherit ruler-mode-default
4f4ff50a
GM
261 :foreground "red"
262 )))
263 "Face used to highlight the fill column character."
264 :group 'ruler-mode)
265
42e64878 266(defface ruler-mode-comment-column
60ab677b 267 '((t
42e64878 268 (:inherit ruler-mode-default
60ab677b
JB
269 :foreground "red"
270 )))
271 "Face used to highlight the comment column character."
272 :group 'ruler-mode)
273
42e64878 274(defface ruler-mode-goal-column
60ab677b 275 '((t
42e64878 276 (:inherit ruler-mode-default
60ab677b
JB
277 :foreground "red"
278 )))
279 "Face used to highlight the goal column character."
280 :group 'ruler-mode)
281
42e64878 282(defface ruler-mode-tab-stop
4f4ff50a 283 '((t
42e64878 284 (:inherit ruler-mode-default
4f4ff50a
GM
285 :foreground "steelblue"
286 )))
287 "Face used to highlight tab stop characters."
288 :group 'ruler-mode)
289
42e64878 290(defface ruler-mode-current-column
4f4ff50a 291 '((t
42e64878 292 (:inherit ruler-mode-default
4f4ff50a
GM
293 :weight bold
294 :foreground "yellow"
295 )))
296 "Face used to highlight the `current-column' character."
297 :group 'ruler-mode)
bfba6c09 298\f
3bb804d0
JB
299
300(defsubst ruler-mode-full-window-width ()
301 "Return the full width of the selected window."
302 (let ((edges (window-edges)))
303 (- (nth 2 edges) (nth 0 edges))))
304
305(defsubst ruler-mode-window-col (n)
306 "Return a column number relative to the selected window.
307N is a column number relative to selected frame."
308 (- n
3bb804d0 309 (or (car (window-margins)) 0)
6b61353c
KH
310 (fringe-columns 'left)
311 (scroll-bar-columns 'left)))
3bb804d0 312\f
4f4ff50a 313(defun ruler-mode-mouse-set-left-margin (start-event)
3bb804d0 314 "Set left margin end to the graduation where the mouse pointer is on.
4f4ff50a
GM
315START-EVENT is the mouse click event."
316 (interactive "e")
317 (let* ((start (event-start start-event))
318 (end (event-end start-event))
3bb804d0
JB
319 col w lm rm)
320 (when (eq start end) ;; mouse click
321 (save-selected-window
322 (select-window (posn-window start))
680d0ff9 323 (setq col (- (car (posn-col-row start))
6b61353c 324 (scroll-bar-columns 'left))
3bb804d0 325 w (- (ruler-mode-full-window-width)
6b61353c
KH
326 (scroll-bar-columns 'left)
327 (scroll-bar-columns 'right)))
3bb804d0
JB
328 (when (and (>= col 0) (< col w))
329 (setq lm (window-margins)
330 rm (or (cdr lm) 0)
331 lm (or (car lm) 0))
332 (message "Left margin set to %d (was %d)" col lm)
333 (set-window-margins nil col rm))))))
4f4ff50a
GM
334
335(defun ruler-mode-mouse-set-right-margin (start-event)
3bb804d0 336 "Set right margin beginning to the graduation where the mouse pointer is on.
4f4ff50a
GM
337START-EVENT is the mouse click event."
338 (interactive "e")
339 (let* ((start (event-start start-event))
340 (end (event-end start-event))
3bb804d0
JB
341 col w lm rm)
342 (when (eq start end) ;; mouse click
343 (save-selected-window
344 (select-window (posn-window start))
680d0ff9 345 (setq col (- (car (posn-col-row start))
6b61353c 346 (scroll-bar-columns 'left))
3bb804d0 347 w (- (ruler-mode-full-window-width)
6b61353c
KH
348 (scroll-bar-columns 'left)
349 (scroll-bar-columns 'right)))
3bb804d0
JB
350 (when (and (>= col 0) (< col w))
351 (setq lm (window-margins)
352 rm (or (cdr lm) 0)
353 lm (or (car lm) 0)
354 col (- w col 1))
355 (message "Right margin set to %d (was %d)" col rm)
356 (set-window-margins nil lm col))))))
357
358(defvar ruler-mode-dragged-symbol nil
60ab677b
JB
359 "Column symbol dragged in the ruler.
360That is `fill-column', `comment-column', `goal-column', or nil when
361nothing is dragged.")
362
363(defun ruler-mode-mouse-grab-any-column (start-event)
3bb804d0
JB
364 "Drag a column symbol on the ruler.
365Start dragging on mouse down event START-EVENT, and update the column
366symbol value with the current value of the ruler graduation while
367dragging. See also the variable `ruler-mode-dragged-symbol'."
4f4ff50a 368 (interactive "e")
3bb804d0 369 (setq ruler-mode-dragged-symbol nil)
60ab677b 370 (let* ((start (event-start start-event))
3bb804d0 371 col newc oldc)
60ab677b
JB
372 (save-selected-window
373 (select-window (posn-window start))
3bb804d0
JB
374 (setq col (ruler-mode-window-col (car (posn-col-row start)))
375 newc (+ col (window-hscroll)))
376 (and
377 (>= col 0) (< col (window-width))
378 (cond
379
380 ;; Handle the fill column.
381 ((eq newc fill-column)
382 (setq oldc fill-column
383 ruler-mode-dragged-symbol 'fill-column)
384 t) ;; Start dragging
385
386 ;; Handle the comment column.
387 ((eq newc comment-column)
388 (setq oldc comment-column
389 ruler-mode-dragged-symbol 'comment-column)
390 t) ;; Start dragging
391
392 ;; Handle the goal column.
393 ;; A. On mouse down on the goal column character on the ruler,
394 ;; update the `goal-column' value while dragging.
395 ;; B. If `goal-column' is nil, set the goal column where the
396 ;; mouse is clicked.
397 ;; C. On mouse click on the goal column character on the
398 ;; ruler, unset the goal column.
399 ((eq newc goal-column) ; A. Drag the goal column.
400 (setq oldc goal-column
401 ruler-mode-dragged-symbol 'goal-column)
402 t) ;; Start dragging
403
404 ((null goal-column) ; B. Set the goal column.
405 (setq oldc goal-column
406 goal-column newc)
407 ;; mouse-2 coming AFTER drag-mouse-2 invokes `ding'. This
408 ;; `ding' flushes the next messages about setting goal
409 ;; column. So here I force fetch the event(mouse-2) and
410 ;; throw away.
411 (read-event)
412 ;; Ding BEFORE `message' is OK.
413 (when ruler-mode-set-goal-column-ding-flag
414 (ding))
415 (message "Goal column set to %d (click on %s again to unset it)"
416 newc
417 (propertize (char-to-string ruler-mode-goal-column-char)
42e64878 418 'face 'ruler-mode-goal-column))
3bb804d0
JB
419 nil) ;; Don't start dragging.
420 )
421 (if (eq 'click (ruler-mode-mouse-drag-any-column-iteration
422 (posn-window start)))
423 (when (eq 'goal-column ruler-mode-dragged-symbol)
424 ;; C. Unset the goal column.
425 (set-goal-column t))
426 ;; At end of dragging, report the updated column symbol.
427 (message "%s is set to %d (was %d)"
428 ruler-mode-dragged-symbol
429 (symbol-value ruler-mode-dragged-symbol)
430 oldc))))))
60ab677b
JB
431
432(defun ruler-mode-mouse-drag-any-column-iteration (window)
433 "Update the ruler while dragging the mouse.
3bb804d0
JB
434WINDOW is the window where occurred the last down-mouse event.
435Return the symbol `drag' if the mouse has been dragged, or `click' if
436the mouse has been clicked."
437 (let ((drags 0)
438 event)
60ab677b 439 (track-mouse
3bb804d0
JB
440 (while (mouse-movement-p (setq event (read-event)))
441 (setq drags (1+ drags))
442 (when (eq window (posn-window (event-end event)))
443 (ruler-mode-mouse-drag-any-column event)
444 (force-mode-line-update))))
445 (if (and (zerop drags) (eq 'click (car (event-modifiers event))))
60ab677b
JB
446 'click
447 'drag)))
448
449(defun ruler-mode-mouse-drag-any-column (start-event)
3bb804d0
JB
450 "Update the value of the symbol dragged on the ruler.
451Called on each mouse motion event START-EVENT."
4f4ff50a
GM
452 (let* ((start (event-start start-event))
453 (end (event-end start-event))
3bb804d0 454 col newc)
60ab677b
JB
455 (save-selected-window
456 (select-window (posn-window start))
3bb804d0
JB
457 (setq col (ruler-mode-window-col (car (posn-col-row end)))
458 newc (+ col (window-hscroll)))
459 (when (and (>= col 0) (< col (window-width)))
460 (set ruler-mode-dragged-symbol newc)))))
bfba6c09 461\f
4f4ff50a
GM
462(defun ruler-mode-mouse-add-tab-stop (start-event)
463 "Add a tab stop to the graduation where the mouse pointer is on.
464START-EVENT is the mouse click event."
465 (interactive "e")
3bb804d0
JB
466 (when ruler-mode-show-tab-stops
467 (let* ((start (event-start start-event))
468 (end (event-end start-event))
469 col ts)
470 (when (eq start end) ;; mouse click
471 (save-selected-window
472 (select-window (posn-window start))
473 (setq col (ruler-mode-window-col (car (posn-col-row start)))
474 ts (+ col (window-hscroll)))
475 (and (>= col 0) (< col (window-width))
476 (not (member ts tab-stop-list))
477 (progn
478 (message "Tab stop set to %d" ts)
479 (setq tab-stop-list (sort (cons ts tab-stop-list)
480 #'<)))))))))
4f4ff50a
GM
481
482(defun ruler-mode-mouse-del-tab-stop (start-event)
483 "Delete tab stop at the graduation where the mouse pointer is on.
484START-EVENT is the mouse click event."
485 (interactive "e")
3bb804d0
JB
486 (when ruler-mode-show-tab-stops
487 (let* ((start (event-start start-event))
488 (end (event-end start-event))
489 col ts)
490 (when (eq start end) ;; mouse click
491 (save-selected-window
492 (select-window (posn-window start))
493 (setq col (ruler-mode-window-col (car (posn-col-row start)))
494 ts (+ col (window-hscroll)))
495 (and (>= col 0) (< col (window-width))
496 (member ts tab-stop-list)
497 (progn
498 (message "Tab stop at %d deleted" ts)
499 (setq tab-stop-list (delete ts tab-stop-list)))))))))
4f4ff50a
GM
500
501(defun ruler-mode-toggle-show-tab-stops ()
502 "Toggle showing of tab stops on the ruler."
503 (interactive)
bfba6c09
RS
504 (setq ruler-mode-show-tab-stops (not ruler-mode-show-tab-stops))
505 (force-mode-line-update))
506\f
4f4ff50a
GM
507(defvar ruler-mode-map
508 (let ((km (make-sparse-keymap)))
509 (define-key km [header-line down-mouse-1]
510 #'ignore)
511 (define-key km [header-line down-mouse-3]
512 #'ignore)
513 (define-key km [header-line down-mouse-2]
60ab677b 514 #'ruler-mode-mouse-grab-any-column)
4f4ff50a
GM
515 (define-key km [header-line (shift down-mouse-1)]
516 #'ruler-mode-mouse-set-left-margin)
517 (define-key km [header-line (shift down-mouse-3)]
518 #'ruler-mode-mouse-set-right-margin)
519 (define-key km [header-line (control down-mouse-1)]
520 #'ruler-mode-mouse-add-tab-stop)
521 (define-key km [header-line (control down-mouse-3)]
522 #'ruler-mode-mouse-del-tab-stop)
523 (define-key km [header-line (control down-mouse-2)]
524 #'ruler-mode-toggle-show-tab-stops)
59b3965e
RS
525 (define-key km [header-line (shift mouse-1)]
526 'ignore)
527 (define-key km [header-line (shift mouse-3)]
528 'ignore)
529 (define-key km [header-line (control mouse-1)]
530 'ignore)
531 (define-key km [header-line (control mouse-3)]
532 'ignore)
533 (define-key km [header-line (control mouse-2)]
534 'ignore)
4f4ff50a
GM
535 km)
536 "Keymap for ruler minor mode.")
537
538(defvar ruler-mode-header-line-format-old nil
539 "Hold previous value of `header-line-format'.")
6b61353c
KH
540
541(defvar ruler-mode-ruler-function 'ruler-mode-ruler
542 "Function to call to return ruler header line format.
543This variable is expected to be made buffer-local by modes.")
4f4ff50a
GM
544
545(defconst ruler-mode-header-line-format
6b61353c
KH
546 '(:eval (funcall ruler-mode-ruler-function))
547 "`header-line-format' used in ruler mode.
548Call `ruler-mode-ruler-function' to compute the ruler value.")
4f4ff50a 549
dc9a226c
CY
550;;;###autoload
551(defvar ruler-mode nil
552 "Non-nil if Ruler mode is enabled.
553Use the command `ruler-mode' to change this variable.")
554(make-variable-buffer-local 'ruler-mode)
555
556(defun ruler--save-header-line-format ()
557 "Install the header line format for Ruler mode.
b32d1614 558Unless Ruler mode is already enabled, save the old header line
dc9a226c 559format first."
b32d1614
CY
560 (when (and (not ruler-mode)
561 (local-variable-p 'header-line-format)
562 (not (local-variable-p 'ruler-mode-header-line-format-old)))
563 (set (make-local-variable 'ruler-mode-header-line-format-old)
564 header-line-format))
565 (setq header-line-format ruler-mode-header-line-format))
dc9a226c 566
4f4ff50a
GM
567;;;###autoload
568(define-minor-mode ruler-mode
06e21633
CY
569 "Toggle display of ruler in header line (Ruler mode).
570With a prefix argument ARG, enable Ruler mode if ARG is positive,
571and disable it otherwise. If called from Lisp, enable the mode
572if ARG is omitted or nil."
4f4ff50a
GM
573 nil nil
574 ruler-mode-map
575 :group 'ruler-mode
dc9a226c
CY
576 :variable (ruler-mode
577 . (lambda (enable)
578 (when enable
579 (ruler--save-header-line-format))
580 (setq ruler-mode enable)))
4f4ff50a 581 (if ruler-mode
dc9a226c 582 (add-hook 'post-command-hook 'force-mode-line-update nil t)
4f4ff50a
GM
583 ;; When `ruler-mode' is off restore previous header line format if
584 ;; the current one is the ruler header line format.
60ab677b
JB
585 (when (eq header-line-format ruler-mode-header-line-format)
586 (kill-local-variable 'header-line-format)
3bb804d0 587 (when (local-variable-p 'ruler-mode-header-line-format-old)
6b61353c
KH
588 (setq header-line-format ruler-mode-header-line-format-old)
589 (kill-local-variable 'ruler-mode-header-line-format-old)))
590 (remove-hook 'post-command-hook 'force-mode-line-update t)))
bfba6c09 591\f
110c171f 592;; Add ruler-mode to the minor mode menu in the mode line
4f4ff50a
GM
593(define-key mode-line-mode-menu [ruler-mode]
594 `(menu-item "Ruler" ruler-mode
60ab677b 595 :button (:toggle . ruler-mode)))
4f4ff50a
GM
596
597(defconst ruler-mode-ruler-help-echo
598 "\
599S-mouse-1/3: set L/R margin, \
60ab677b 600mouse-2: set goal column, \
4f4ff50a 601C-mouse-2: show tabs"
60ab677b 602 "Help string shown when mouse is over the ruler.
4f4ff50a
GM
603`ruler-mode-show-tab-stops' is nil.")
604
60ab677b
JB
605(defconst ruler-mode-ruler-help-echo-when-goal-column
606 "\
607S-mouse-1/3: set L/R margin, \
608C-mouse-2: show tabs"
609 "Help string shown when mouse is over the ruler.
610`goal-column' is set and `ruler-mode-show-tab-stops' is nil.")
611
612(defconst ruler-mode-ruler-help-echo-when-tab-stops
4f4ff50a
GM
613 "\
614C-mouse1/3: set/unset tab, \
615C-mouse-2: hide tabs"
60ab677b 616 "Help string shown when mouse is over the ruler.
4f4ff50a
GM
617`ruler-mode-show-tab-stops' is non-nil.")
618
60ab677b
JB
619(defconst ruler-mode-fill-column-help-echo
620 "drag-mouse-2: set fill column"
621 "Help string shown when mouse is on the fill column character.")
622
623(defconst ruler-mode-comment-column-help-echo
624 "drag-mouse-2: set comment column"
625 "Help string shown when mouse is on the comment column character.")
626
627(defconst ruler-mode-goal-column-help-echo
628 "\
629drag-mouse-2: set goal column, \
630mouse-2: unset goal column"
631 "Help string shown when mouse is on the goal column character.")
632
3bb804d0
JB
633(defconst ruler-mode-margin-help-echo
634 "%s margin %S"
635 "Help string shown when mouse is over a margin area.")
4f4ff50a 636
3bb804d0
JB
637(defconst ruler-mode-fringe-help-echo
638 "%s fringe %S"
639 "Help string shown when mouse is over a fringe area.")
6b61353c
KH
640
641(defsubst ruler-mode-space (width &rest props)
642 "Return a single space string of WIDTH times the normal character width.
643Optional argument PROPS specifies other text properties to apply."
644 (apply 'propertize " " 'display (list 'space :width width) props))
bfba6c09 645\f
4f4ff50a 646(defun ruler-mode-ruler ()
1bb60c13 647 "Compute and return a header line ruler."
6b61353c
KH
648 (let* ((w (window-width))
649 (m (window-margins))
650 (f (window-fringes))
651 (i 0)
652 (j (window-hscroll))
653 ;; Setup the scrollbar, fringes, and margins areas.
654 (lf (ruler-mode-space
655 'left-fringe
42e64878 656 'face 'ruler-mode-fringes
6b61353c
KH
657 'help-echo (format ruler-mode-fringe-help-echo
658 "Left" (or (car f) 0))))
659 (rf (ruler-mode-space
660 'right-fringe
42e64878 661 'face 'ruler-mode-fringes
6b61353c
KH
662 'help-echo (format ruler-mode-fringe-help-echo
663 "Right" (or (cadr f) 0))))
664 (lm (ruler-mode-space
665 'left-margin
42e64878 666 'face 'ruler-mode-margins
6b61353c
KH
667 'help-echo (format ruler-mode-margin-help-echo
668 "Left" (or (car m) 0))))
669 (rm (ruler-mode-space
670 'right-margin
42e64878 671 'face 'ruler-mode-margins
6b61353c
KH
672 'help-echo (format ruler-mode-margin-help-echo
673 "Right" (or (cdr m) 0))))
674 (sb (ruler-mode-space
675 'scroll-bar
42e64878 676 'face 'ruler-mode-pad))
6b61353c
KH
677 ;; Remember the scrollbar vertical type.
678 (sbvt (car (window-current-scroll-bars)))
679 ;; Create an "clean" ruler.
680 (ruler
681 (propertize
9201cc28 682 (string-to-multibyte
34c2efdc 683 (make-string w ruler-mode-basic-graduation-char))
42e64878 684 'face 'ruler-mode-default
6b61353c
KH
685 'local-map ruler-mode-map
686 'help-echo (cond
687 (ruler-mode-show-tab-stops
688 ruler-mode-ruler-help-echo-when-tab-stops)
689 (goal-column
690 ruler-mode-ruler-help-echo-when-goal-column)
691 (ruler-mode-ruler-help-echo))))
692 k c)
693 ;; Setup the active area.
694 (while (< i w)
695 ;; Graduations.
696 (cond
697 ;; Show a number graduation.
698 ((= (mod j 10) 0)
699 (setq c (number-to-string (/ j 10))
700 m (length c)
701 k i)
702 (put-text-property
42e64878 703 i (1+ i) 'face 'ruler-mode-column-number
6b61353c
KH
704 ruler)
705 (while (and (> m 0) (>= k 0))
706 (aset ruler k (aref c (setq m (1- m))))
707 (setq k (1- k))))
708 ;; Show an intermediate graduation.
709 ((= (mod j 5) 0)
710 (aset ruler i ruler-mode-inter-graduation-char)))
711 ;; Special columns.
712 (cond
713 ;; Show the `current-column' marker.
714 ((= j (current-column))
715 (aset ruler i ruler-mode-current-column-char)
716 (put-text-property
42e64878 717 i (1+ i) 'face 'ruler-mode-current-column
6b61353c
KH
718 ruler))
719 ;; Show the `goal-column' marker.
720 ((and goal-column (= j goal-column))
721 (aset ruler i ruler-mode-goal-column-char)
722 (put-text-property
42e64878 723 i (1+ i) 'face 'ruler-mode-goal-column
6b61353c 724 ruler)
359e4563
MY
725 (put-text-property
726 i (1+ i) 'mouse-face 'mode-line-highlight
727 ruler)
6b61353c
KH
728 (put-text-property
729 i (1+ i) 'help-echo ruler-mode-goal-column-help-echo
730 ruler))
731 ;; Show the `comment-column' marker.
732 ((= j comment-column)
733 (aset ruler i ruler-mode-comment-column-char)
734 (put-text-property
42e64878 735 i (1+ i) 'face 'ruler-mode-comment-column
6b61353c 736 ruler)
359e4563
MY
737 (put-text-property
738 i (1+ i) 'mouse-face 'mode-line-highlight
739 ruler)
6b61353c
KH
740 (put-text-property
741 i (1+ i) 'help-echo ruler-mode-comment-column-help-echo
742 ruler))
743 ;; Show the `fill-column' marker.
744 ((= j fill-column)
745 (aset ruler i ruler-mode-fill-column-char)
746 (put-text-property
42e64878 747 i (1+ i) 'face 'ruler-mode-fill-column
6b61353c 748 ruler)
359e4563
MY
749 (put-text-property
750 i (1+ i) 'mouse-face 'mode-line-highlight
751 ruler)
6b61353c
KH
752 (put-text-property
753 i (1+ i) 'help-echo ruler-mode-fill-column-help-echo
754 ruler))
755 ;; Show the `tab-stop-list' markers.
756 ((and ruler-mode-show-tab-stops (member j tab-stop-list))
757 (aset ruler i ruler-mode-tab-stop-char)
758 (put-text-property
42e64878 759 i (1+ i) 'face 'ruler-mode-tab-stop
6b61353c
KH
760 ruler)))
761 (setq i (1+ i)
762 j (1+ j)))
763 ;; Return the ruler propertized string. Using list here,
764 ;; instead of concat visually separate the different areas.
765 (if (nth 2 (window-fringes))
766 ;; fringes outside margins.
767 (list "" (and (eq 'left sbvt) sb) lf lm
768 ruler rm rf (and (eq 'right sbvt) sb))
769 ;; fringes inside margins.
770 (list "" (and (eq 'left sbvt) sb) lm lf
771 ruler rf rm (and (eq 'right sbvt) sb)))))
4f4ff50a
GM
772
773(provide 'ruler-mode)
774
775;; Local Variables:
c38e0c97 776;; coding: utf-8
4f4ff50a
GM
777;; End:
778
779;;; ruler-mode.el ends here