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