ruler-mode.el 28 KB

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