Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100644 893 lines (767 sloc) 37.585 kb
2e8081d Ross Lagerwall Initial commit for Emacs 23.
authored
1 ;;; fill-column-indicator.el --- Graphically indicate the fill column
2
3 ;; Copyright (c) 2011-2012 Alp Aker
4
5 ;; Author: Alp Aker <alp.tekin.aker@gmail.com>
6 ;; Version: 1.81
7 ;; Keywords: convenience
8
9 ;; This program is free software; you can redistribute it and/or
10 ;; modify it under the terms of the GNU General Public License as
11 ;; published by the Free Software Foundation; either version 2 of the
12 ;; License, or (at your option) any later version.
13
14 ;; This program is distributed in the hope that it will be useful,
15 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
17 ;; General Public License for more details.
18
19 ;; A copy of the GNU General Public License can be obtained from the
20 ;; Free Software Foundation, Inc., 59 Temple Place, Suite 330, Boston,
21 ;; MA 02111-1307 USA
22
23 ;;; Commentary:
24
25 ;; Many modern editors and IDEs can graphically indicate the location of the
26 ;; fill column by drawing a thin line (in design parlance, a `rule') down the
27 ;; length of the editing window. Fill-column-indicator implements this
28 ;; facility in Emacs.
29
30 ;; Installation and Usage
31 ;; ======================
32
33 ;; Put this file in your load path and put:
34 ;;
35 ;; (require 'fill-column-indicator)
36 ;;
37 ;; in your init file.
38
39 ;; To toggle graphical indication of the fill column in a buffer, use the
40 ;; command `fci-mode'.
41
42 ;; Configuration
43 ;; =============
44
45 ;; By default, fci-mode draws its vertical indicator at the fill column. If
46 ;; you'd like it to be drawn at another column, set `fci-rule-column' to the
47 ;; column number. This variable becomes buffer local when set, so you can
48 ;; use different values for different modes. The default behavior (drawing
49 ;; the rule at the fill column) is specified by setting fci-rule-column to
50 ;; nil.
51
52 ;; On graphical displays the fill-column rule is drawn using a bitmap
53 ;; image. Its color is controlled by the variable `fci-rule-color', whose
54 ;; value can be any valid color name. The rule's width in pixels is
55 ;; determined by the variable `fci-rule-width'; the default value is 1.
56 ;;
57 ;; The rule can be drawn as a solid or dashed line, controlled by the
58 ;; variable `fci-rule-use-dashes'; the default is nil. The dash appearance is
59 ;; controlled by `fci-dash-pattern', which is the ratio of dash length to
60 ;; line height; the default is 0.75. (The value should be a number between 0
61 ;; and 1; values outside that interval are coerced to the nearest endpoint.)
62
63 ;; The image formats fci-mode can use are XPM and PBM. If Emacs has been
64 ;; compiled with the appropriate library it uses XPM images by default; if
65 ;; not it uses PBM images, which are natively supported. You can specify a
66 ;; particular choice of format by setting `fci-rule-image-format' explicitly
67 ;; to xpm or pbm.
68
69 ;; On character terminals the rule is drawn using the character specified by
70 ;; `fci-rule-character'; the default is `|' (ascii 124). If
71 ;; `fci-rule-character-color' is nil, then it is drawn using fci-rule-color
72 ;; (or the closest approximation thereto that the terminal is capable of); if
73 ;; it is a color name, then that color is used instead.
74
75 ;; If you'd like the rule to be drawn using fci-rule-character even on
76 ;; graphical displays, set `fci-always-use-textual-rule' to a non-nil value.
77
78 ;; These variables (as well as those described in the next section) can be
79 ;; given buffer-local bindings.
80
81 ;; Other Options
82 ;; =============
83
84 ;; When `truncate-lines' is nil, the effect of drawing a fill-column rule is
85 ;; very odd looking. Indeed, it makes little sense to use a rule to indicate
86 ;; the position of the fill column in that case (the positions at which the
87 ;; fill column falls in the visual display space won't, in general, be
88 ;; collinear). For this reason, fci-mode sets truncate-lines to t in buffers
89 ;; in which it is enabled and restores it to its previous value when
90 ;; disabled. You can turn this feature off by setting
91 ;; `fci-handle-truncate-lines' to nil.
92
93 ;; If `line-move-visual' is t, then vertical navigation can behave oddly in
94 ;; several edge cases while fci-mode is enabled (this is due to a bug in
95 ;; Emacs's C code). Accordingly, fci-mode sets line-move-visual to nil in
96 ;; buffers in which it is enabled and restores it to its previous value when
97 ;; disabled. This can be suppressed by setting `fci-handle-line-move-visual'
98 ;; to nil. (But you shouldn't want to do this. There's no reason to use
99 ;; line-move-visual if truncate-lines is t, and it doesn't make sense to use
100 ;; something like fci-mode when truncate-lines is nil.)
101
102 ;; Fci-mode needs free use of two characters (specifically, it needs the use
103 ;; of two characters whose display table entries it can change
104 ;; arbitrarily). Its defualt is to use the first two characters of the
105 ;; Private Use Area of the Unicode BMP, viz. U+E000 and U+E001. If you need
106 ;; to use those characters for some other purpose, set `fci-eol-char' and
107 ;; `fci-blank-char' to different values.
108
109 ;; Troubleshooting
110 ;; ===============
111
112 ;; o Fci-mode is intended to be used with monospaced fonts. If you're using
113 ;; a monospaced font and the fill-column rule is missing or misaligned on a
114 ;; few lines but otherwise appears normal, then most likely (a) there are
115 ;; non-ascii characters on those lines that are being displayed using a
116 ;; non-monospaced font, or (b) your font-lock settings use bold or italics
117 ;; and those font variants aren't monospaced.
118
119 ;; o Fci-mode in not currently compatible with Emacs's
120 ;; `show-trailing-whitespace' feature (given the way the latter is
121 ;; implemented, such compatibility is going to be hard to achieve). A
122 ;; workaround is to configure `whitespace-mode' to replicate the
123 ;; functionality of show-trailing-whitespace. This can be done with the
124 ;; following setting:
125 ;;
126 ;; (setq whitespace-style '(face trailing))
127 ;;
128 ;; With this, whitespace-mode produces the same basic effect as a non-nil
129 ;; value of show-trailing-whitespace, and compatibility with fci-mode is not
130 ;; a problem.
131
132 ;; Known Issues
133 ;; ============
134
135 ;; o The indicator extends only to end of the buffer contents (as opposed to
136 ;; running the full length of the editing window).
137
138 ;; o When portions of a buffer are invisible, such as when outline-mode is
139 ;; used to hide certain lines, the fill-column rule is hidden as well.
140
141 ;; o Fci-mode should work smoothly when simultaneously displaying the same
142 ;; buffer on both a graphical display and on a character terminal. It does
143 ;; not currently support simultaneous display of the same buffer on window
144 ;; frames with different default font sizes. (It would be feasible to
145 ;; support this use case, but thus far there seems to be no demand for
146 ;; it.)
147
148 ;; o An issue specific to the Mac OS X (NextStep) port, versions 23.0-23.2:
149 ;; Emacs won't, in these particular versions, draw a cursor on top of an
150 ;; image. Thus on graphical displays the cursor will disappear when
151 ;; positioned directly on top of the fill-column rule. The best way to
152 ;; deal with this is to upgrade to v23.3 or v24 (or downgrade to v22). If
153 ;; that isn't practical, a fix is available via the mini-package
154 ;; fci-osx-23-fix.el, which can be downloaded from:
155 ;;
156 ;; github.com/alpaker/Fill-Column-Indicator
157 ;;
158 ;; Directions for its use are given in the file header.
159
160 ;; Todo
161 ;; ====
162
163 ;; o Accommodate non-nil values of `hl-line-sticky-flag' and similar cases.
164
165 ;; o Accommodate linum-mode more robustly.
166
167 ;; o Compatibility with non-nil `show-trailing-whitespace.'
168
169 ;; Acknowledgements
170 ;; ================
171
172 ;; Thanks to Ami Fischman, Christopher Genovese, Michael Hoffman, José
173 ;; Alfredo Romero L., José Lombera, R. Lange, Joe Lisee, Frank Meffert,
174 ;; Mitchell Peabody, sheijk, and an anonymous BT subscriber for bug reports
175 ;; and suggestions. Special thanks to lomew and Pär Wieslander for code
176 ;; contributions.
177
178 ;;; Code:
179
180 (unless (version<= "22" emacs-version)
181 (error "Fill-column-indicator requires version 22 or later"))
182
183 ;;; ---------------------------------------------------------------------
184 ;;; User Options
185 ;;; ---------------------------------------------------------------------
186
187 (defgroup fill-column-indicator nil
188 "Graphically indicate the fill-column."
189 :tag "Fill-Column Indicator"
190 :group 'convenience
191 :group 'fill)
192
193 ;; We should be using :validate instead of :match, but that seems not to
194 ;; work with defcustom widgets.
195 (defcustom fci-rule-column nil
196 "Controls where fci-mode displays a vertical line (rule).
197
198 If nil, the rule is drawn at the fill column. Otherwise, it is
199 drawn at the column given by this variable.
200
201 Changes to this variable do not take effect until the mode
202 function `fci-mode' is run."
203 :group 'fill-column-indicator
204 :tag "Fill-Column rule column"
205 :type '(choice (symbol :tag "Use the fill column" 'fill-column)
206 (integer :tag "Use a custom column"
207 :match (lambda (w val) (fci-posint-p val)))))
208
209 (make-variable-buffer-local 'fci-rule-column)
210
211 (defcustom fci-rule-color "#cccccc"
212 "Color used to draw the fill-column rule.
213
214 Changes to this variable do not take effect until the mode
215 function `fci-mode' is run."
216 :group 'fill-column-indicator
217 :tag "Fill-column rule color"
218 :type 'color)
219
220 (defcustom fci-rule-width 1
221 "Width in pixels of the fill-column rule on graphical displays.
222 Note that a value greater than the default character width is
223 treated as equivalent to the default character width.
224
225 Changes to this variable do not take effect until the mode
226 function `fci-mode' is run."
227 :tag "Fill-Column Rule Width"
228 :group 'fill-column-indicator
229 :type '(integer :match (lambda (w val) (fci-posint-p val))))
230
231 (defcustom fci-rule-image-format
232 (if (image-type-available-p 'xpm) 'xpm 'pbm)
233 "Image format used for the fill-column rule on graphical displays.
234
235 Changes to this variable do not take effect until the mode
236 function `fci-mode' is run."
237 :tag "Fill-Column Rule Image Format"
238 :group 'fill-column-indicator
239 :type '(choice (symbol :tag "XPM" 'xpm)
240 (symbol :tag "PBM" 'pbm)))
241
242 (defcustom fci-rule-use-dashes nil
243 "Whether to show the fill-column rule as dashes or as a solid line.
244 This has no effect on non-graphical displays.
245
246 Changes to this variable do not take effect until the mode
247 function `fci-mode' is run."
248 :tag "Fill-Column Rule Use Dashes"
249 :group 'fill-column-indicator
250 :type 'boolean)
251
252 (defcustom fci-dash-pattern 0.75
253 "When using a dashed rule, ratio of dash length to line height.
254 Values less than 0 or greather than 1 are coerced to the nearest
255 endpoint of that interval.
256
257 Changes to this variable do not take effect until the mode
258 function `fci-mode' is run."
259 :tag "Fill-Column Rule Use Dashes"
260 :group 'fill-column-indicator
261 :type 'float)
262
263 (defcustom fci-rule-character ?|
264 "Character use to draw the fill-column rule on character terminals.
265
266 Changes to this variable do not take effect until the mode
267 function `fci-mode' is run."
268 :tag "Fill-Column Rule Character"
269 :group 'fill-column-indicator
270 :type 'character)
271
272 (defcustom fci-rule-character-color nil
273 "Color used to draw the fill-column rule on character terminals.
274 If nil, the same color is used as for the graphical rule.
275
276 Changes to this variable do not take effect until the mode
277 function `fci-mode' is run."
278 :group 'fill-column-indicator
279 :tag "Fill-column rule color"
280 :type '(choice (const :tag "Use same color as graphical rule" nil)
281 (color :tag "Specify a color")))
282
283 (defcustom fci-always-use-textual-rule nil
284 "When non-nil, the rule is always drawn using textual characters.
285 Specifically, fci-mode will use `fci-rule-character' intead of
286 bitmap images to draw the rule on graphical displays.
287
288 Changes to this variable do not take effect until the mode
289 function `fci-mode' is run."
290 :tag "Don't Use Image for Fill-Column Rule"
291 :group 'fill-column-indicator
292 :type 'boolean)
293
294 (defcustom fci-handle-truncate-lines t
295 "Whether fci-mode should set truncate-lines to t while enabled.
296 If non-nil, fci-mode will set truncate-lines to t in buffers in
297 which it is enabled, and restore it to its previous value when
298 disabled.
299
300 Leaving this option set to the default value is recommended."
301 :group 'fill-column-indicator
302 :tag "Locally set truncate-lines to t during fci-mode"
303 :type 'boolean)
304
305 (defcustom fci-handle-line-move-visual (version<= "23" emacs-version)
306 "Whether fci-mode should set line-move-visual to nil while enabled.
307 If non-nil, fci-mode will set line-move-visual to nil in buffers
308 in which it is enabled, and restore t to its previous value when
309 disabled.
310
311 Leaving this option set to the default value is recommended."
312 :group 'fill-column-indicator
313 :tag "Locally set line-move-visual to nil during fci-mode"
314 :type 'boolean)
315
316 (defcustom fci-eol-char ?\uE000
317 "Character used for internal purposes by fci-mode.
318 If you need to use this character, set this variable's value to a
319 character you do not care about (a good choice is a character
320 from the Private Use Area of the Unicode BMP, i.e., the range
321 U+E000-U+F8FF, inclusive)."
322 :group 'fill-column-indicator
323 :type 'character)
324
325 (defcustom fci-blank-char ?\uE001
326 "Character used for internal purposes by fci-mode.
327 If you need to use this character, set this variable's value to a
328 character you do not care about (a good choice is a character
329 from the Private Use Area of the Unicode BMP, i.e., the the range
330 U+E000-U+F8FF, inclusive)."
331 :group 'fill-column-indicator
332 :type 'character)
333
334 ;;; ---------------------------------------------------------------------
335 ;;; Internal Variables and Constants
336 ;;; ---------------------------------------------------------------------
337
338 ;; Record prior state of buffer.
339 (defvar fci-saved-line-move-visual)
340 (defvar fci-line-move-visual-was-buffer-local)
341 (defvar fci-saved-truncate-lines)
342 (defvar fci-saved-eol)
343 (defvar fci-made-display-table)
344
345 ;; Record state of fci initialization in this buffer.
346 (defvar fci-display-table-processed)
347 (defvar fci-local-vars-set)
348
349 ;; Record current state of some quantities, so we can detect changes to them.
350 (defvar fci-column)
351 (defvar fci-newline)
352 (defvar fci-tab-width)
353 (defvar fci-char-width)
354 (defvar fci-char-height)
355
356 ;; Data used in setting the fill-column rule that only need to be
357 ;; occasionally updated in a given buffer.
358 (defvar fci-limit)
359 (defvar fci-pre-limit-string)
360 (defvar fci-at-limit-string)
361 (defvar fci-post-limit-string)
362
363 ;; The preceding internal variables need to be buffer local and reset when
364 ;; the mode is disabled.
365 (defconst fci-internal-vars '(fci-saved-line-move-visual
366 fci-line-move-visual-was-buffer-local
367 fci-saved-truncate-lines
368 fci-saved-eol
369 fci-made-display-table
370 fci-display-table-processed
371 fci-local-vars-set
372 fci-column
373 fci-newline
374 fci-tab-width
375 fci-char-width
376 fci-char-height
377 fci-limit
378 fci-pre-limit-string
379 fci-at-limit-string
380 fci-post-limit-string))
381
382 (dolist (var fci-internal-vars)
383 (make-variable-buffer-local var))
384
385 ;; Hooks we use.
386 (defconst fci-hook-assignments
387 '((after-change-functions fci-redraw-region 'local)
388 (before-change-functions fci-extend-rule-for-deletion 'local)
389 (window-scroll-functions fci-update-window-for-scroll 'local)
390 (window-configuration-change-hook fci-redraw-frame)
391 (post-command-hook fci-post-command-check 'local)
392 (change-major-mode-hook turn-off-fci-mode 'local)
393 (longlines-mode-hook fci-update-all-windows 'local)))
394
395 ;;; ---------------------------------------------------------------------
396 ;;; Miscellany
397 ;;; ---------------------------------------------------------------------
398
399 (defun fci-get-buffer-windows (&optional all-frames)
400 "Return a list of windows displaying the current buffer."
401 (get-buffer-window-list (current-buffer) 'no-minibuf all-frames))
402
403 (defun fci-posint-p (x)
404 "Return true if X is an integer greater than zero."
405 (and (wholenump x)
406 (/= 0 x)))
407
408 (if (fboundp 'characterp)
409 (defalias 'fci-character-p 'characterp)
410 ;; For v22.
411 (defun fci-character-p (c)
412 "Return true if C is a character."
413 (and (fci-posint-p c)
414 ;; MAX_CHAR in v22 is (0x1f << 14). We don't worry about
415 ;; generic chars.
416 (< c 507904))))
417
418 ;;; ---------------------------------------------------------------------
419 ;;; Mode Definition
420 ;;; ---------------------------------------------------------------------
421
422 (define-minor-mode fci-mode
423 "Toggle fci-mode on and off.
424 Fci-mode indicates the location of the fill column by drawing a
425 thin line (a `rule') at the fill column.
426
427 With prefix ARG, turn fci-mode on if and only if ARG is positive.
428
429 The following options control the appearance of the fill-column
430 rule: `fci-rule-column', `fci-rule-width', `fci-rule-color',
431 `fci-rule-use-dashes', `fci-dash-pattern', `fci-rule-character',
432 and `fci-rule-character-color'. For further options, see the
433 Customization menu or the package file. (See the latter for tips
434 on troubleshooting.)"
435
436 nil nil nil
437
438 (if fci-mode
439 ;; Enabling.
440 (condition-case error
441 (progn
442 (fci-check-user-options)
443 (fci-process-display-table)
444 (fci-set-local-vars)
445 (fci-get-frame-dimens)
446 (dolist (hook fci-hook-assignments)
447 (add-hook (car hook) (nth 1 hook) nil (nth 2 hook)))
448 (setq fci-column (or fci-rule-column fill-column)
449 fci-tab-width tab-width
450 fci-limit (if fci-newline
451 (1+ (- fci-column (length fci-saved-eol)))
452 fci-column))
453 (fci-make-overlay-strings)
454 (fci-update-all-windows t))
455 (error
456 (fci-mode 0)
457 (signal (car error) (cdr error))))
458
459 ;; Disabling.
460 (fci-restore-display-table)
461 (fci-restore-local-vars)
462 (dolist (hook fci-hook-assignments)
463 (remove-hook (car hook) (nth 1 hook) (nth 2 hook)))
464 (fci-delete-overlays-buffer)
465 (dolist (var fci-internal-vars)
466 (set var nil))))
467
468 (defun turn-on-fci-mode ()
469 "Turn on fci-mode unconditionally."
470 (interactive)
471 (fci-mode 1))
472
473 (defun turn-off-fci-mode ()
474 "Turn off fci-mode unconditionally."
475 (interactive)
476 (fci-mode 0))
477
478 ;;; ---------------------------------------------------------------------
479 ;;; Enabling
480 ;;; ---------------------------------------------------------------------
481
482 (defun fci-check-user-options ()
483 "Check that all user options for fci-mode have valid values."
484 (unless (memq fci-rule-image-format '(xpm pbm))
485 (error "Unrecognized value of `fci-rule-image-format'"))
486 ;; If the third element of a binding form is t, then nil is an acceptable
487 ;; value for the variable; otherwise, the variable must satisfy the given
488 ;; predicate.
489 (let ((checks '((fci-rule-color color-defined-p)
490 (fci-rule-column fci-posint-p t)
491 (fci-rule-width fci-posint-p t)
492 (fci-rule-character-color color-defined-p t)
493 (fci-rule-character fci-character-p)
494 (fci-blank-char fci-character-p)
495 (fci-dash-pattern floatp)
496 (fci-eol-char fci-character-p))))
497 (dolist (check checks)
498 (let ((value (symbol-value (nth 0 check)))
499 (pred (nth 1 check))
500 (nil-is-ok (nth 2 check)))
501 (unless (or (and nil-is-ok (null value))
502 (funcall pred value))
503 (signal 'wrong-type-argument (list pred value)))))))
504
505 (defun fci-process-display-table ()
506 "Set up a buffer-local display table for fci-mode."
507 (unless fci-display-table-processed
508 (unless buffer-display-table
509 (setq buffer-display-table (make-display-table)
510 fci-made-display-table t))
511 (aset buffer-display-table fci-blank-char [32])
512 (setq fci-saved-eol (aref buffer-display-table 10))
513 ;; Assumption: the display-table entry for character 10 is either nil or
514 ;; a vector whose last element is the newline glyph.
515 (let ((glyphs (butlast (append fci-saved-eol nil)))
516 eol)
517 (if glyphs
518 (setq fci-newline [10]
519 eol (vconcat glyphs))
520 (setq fci-newline nil
521 eol [32]))
522 (aset buffer-display-table 10 fci-newline)
523 (aset buffer-display-table fci-eol-char eol))
524 (setq fci-display-table-processed t)))
525
526 (defun fci-set-local-vars ()
527 "Set miscellaneous local variables when fci-mode is enabled."
528 (unless fci-local-vars-set
529 (when (and fci-handle-line-move-visual
530 (boundp 'line-move-visual))
531 (if (local-variable-p 'line-move-visual)
532 (setq fci-line-move-visual-was-buffer-local t
533 fci-saved-line-move-visual line-move-visual
534 line-move-visual nil)
535 (set (make-local-variable 'line-move-visual) nil)))
536 (when fci-handle-truncate-lines
537 (setq fci-saved-truncate-lines truncate-lines
538 truncate-lines t))
539 (setq fci-local-vars-set t)))
540
541 (defun fci-make-rule-string ()
542 "Return a string for drawing the fill-column rule."
543 (let ((color (or fci-rule-character-color
544 fci-rule-color)))
545 ;; Make sure we don't inherit weight or slant from font-lock.
546 (propertize (char-to-string fci-rule-character)
547 'face `(:foreground ,color :weight normal :slant normal))))
548
549 (defun fci-make-img-descriptor ()
550 "Make an image descriptor for the fill-column rule."
551 (unless (or (= 0 fci-char-width)
552 fci-always-use-textual-rule)
553 ;; No point passing width, height, color etc. directly to the image
554 ;; functions: those variables have either global or buffer-local
555 ;; scope, so the image-generating functions can access them directly.
556 (if (eq fci-rule-image-format 'xpm)
557 (fci-make-xpm-img)
558 (fci-make-pbm-img))))
559
560 (defun fci-get-frame-dimens ()
561 "Determine the frame character height and width.
562
563 If the selected frame cannot display images, use the character
564 height and width of the first graphic frame in the frame list
565 displaying the current buffer. (This fallback behavior is a
566 rough heuristic.)"
567 (let ((frame (catch 'found-graphic
568 (if (display-images-p)
569 (selected-frame)
570 (dolist (win (fci-get-buffer-windows t))
571 (when (display-images-p (window-frame win))
572 (throw 'found-graphic (window-frame win))))))))
573 (setq fci-char-width (frame-char-width frame)
574 fci-char-height (frame-char-height frame))))
575
576 (defmacro fci-with-rule-parameters (&rest body)
577 "Define various quantites used in generating rule image descriptors."
578 (declare (indent defun))
579 `(let* ((height-str (number-to-string fci-char-height))
580 (width-str (number-to-string fci-char-width))
581 (rule-width (min fci-rule-width fci-char-width))
582 (hmargin (/ (- fci-char-width rule-width) 2.0))
583 (left-margin (floor hmargin))
584 (right-margin (ceiling hmargin))
585 (segment-ratio (if fci-rule-use-dashes fci-dash-pattern 1))
586 (segment-ratio-coerced (min 1 (max 0 segment-ratio)))
587 (segment-length (round (* segment-ratio-coerced fci-char-height)))
588 (vmargin (/ (- fci-char-height segment-length) 2.0))
589 (top-margin (floor vmargin))
590 (bottom-margin (ceiling vmargin)))
591 ,@body))
592
593 (defun fci-mapconcat (sep &rest lists)
594 "Concatenate the strings in LISTS, using SEP as separator."
595 (mapconcat #'identity (apply 'nconc lists) sep))
596
597 (defun fci-make-pbm-img ()
598 "Return an image descriptor for the fill-column rule in PBM format."
599 (fci-with-rule-parameters
600 (let* ((magic-number "P1\n")
601 (dimens (concat width-str " " height-str "\n"))
602 (on-pixels (fci-mapconcat " "
603 (make-list left-margin "0")
604 (make-list rule-width "1")
605 (make-list right-margin "0")))
606 (off-pixels (fci-mapconcat " " (make-list fci-char-width "0")))
607 (raster (fci-mapconcat "\n"
608 (make-list top-margin off-pixels)
609 (make-list segment-length on-pixels)
610 (make-list bottom-margin off-pixels)))
611 (data (concat magic-number dimens raster)))
612 `(image :type pbm
613 :data ,data
614 :mask heuristic
615 :foreground ,fci-rule-color
616 :ascent center))))
617
618 (defun fci-make-xpm-img ()
619 "Return an image descriptor for the fill-column rule in XPM format."
620 (fci-with-rule-parameters
621 (let* ((identifier "/* XPM */\nstatic char *rule[] = {")
622 (dimens (concat "\"" width-str " " height-str " 2 1\","))
623 (color-spec (concat "\"1 c " fci-rule-color "\",\"0 c None\","))
624 (on-pixels (concat "\""
625 (make-string left-margin ?0)
626 (make-string rule-width ?1)
627 (make-string right-margin ?0)
628 "\","))
629 (off-pixels (concat "\"" (make-string fci-char-width ?0) "\","))
630 (raster (fci-mapconcat ""
631 (make-list top-margin off-pixels)
632 (make-list segment-length on-pixels)
633 (make-list bottom-margin off-pixels)))
634 (end "};")
635 (data (concat identifier dimens color-spec raster end)))
636 `(image :type xpm
637 :data ,data
638 :mask heuristic
639 :ascent center))))
640
641 (defun fci-make-overlay-strings ()
642 "Generate the overlay strings used to display the fill-column rule."
643 (let* ((str (fci-make-rule-string))
644 (img (fci-make-img-descriptor))
645 (blank-str (char-to-string fci-blank-char))
646 (eol-str (char-to-string fci-eol-char))
647 (end-cap (propertize blank-str 'display '(space :width 0)))
648 (pre-or-post-eol (propertize eol-str
649 'cursor 1
650 'display (propertize eol-str 'cursor 1)))
651 (pre-padding (propertize blank-str 'display fci-padding-display))
652 (pre-rule (fci-rule-display blank-str img str t))
653 (at-rule (fci-rule-display blank-str img str fci-newline))
654 (at-eol (if fci-newline pre-or-post-eol "")))
655 (setq fci-pre-limit-string (concat pre-or-post-eol pre-padding pre-rule)
656 fci-at-limit-string (concat at-eol at-rule)
657 fci-post-limit-string (concat pre-or-post-eol end-cap))))
658
659 ;;; ---------------------------------------------------------------------
660 ;;; Disabling
661 ;;; ---------------------------------------------------------------------
662
663 (defun fci-restore-local-vars ()
664 "Restore miscellaneous local variables when fci-mode is disabled."
665 (when fci-local-vars-set
666 (when (and fci-handle-line-move-visual
667 (boundp 'line-move-visual))
668 (if fci-line-move-visual-was-buffer-local
669 (setq line-move-visual fci-saved-line-move-visual)
670 (kill-local-variable 'line-move-visual)))
671 (when fci-handle-truncate-lines
672 (setq truncate-lines fci-saved-truncate-lines))))
673
674 (defun fci-restore-display-table ()
675 "Restore the buffer display table when fci-mode is disabled."
676 (when (and buffer-display-table
677 fci-display-table-processed)
678 (aset buffer-display-table 10 fci-saved-eol)
679 ;; Don't set buffer-display-table to nil even if we created the display
680 ;; table; only do so if nothing else has changed it.
681 (when (and fci-made-display-table
682 (equal buffer-display-table (make-display-table)))
683 (setq buffer-display-table nil))))
684
685 ;;; ---------------------------------------------------------------------
686 ;;; Display Property Specs
687 ;;; ---------------------------------------------------------------------
688
689 (defun fci-overlay-fills-background-p (olay)
690 "Return true if OLAY specifies a background color."
691 (and (overlay-get olay 'face)
692 (not (eq (face-attribute (overlay-get olay 'face) :background nil t)
693 'unspecified))))
694
695 (defun fci-competing-overlay-p (posn)
696 "Return true if there is an overlay at POSN that fills the background."
697 (memq t (mapcar #'fci-overlay-fills-background-p (overlays-at posn))))
698
699 ;; The display spec used in overlay before strings to pad out the rule to the
700 ;; fill-column.
701 (defconst fci-padding-display
702 '((when (not (fci-competing-overlay-p buffer-position))
703 . (space :align-to fci-column))
704 (space :width 0)))
705
706 ;; Generate the display spec for the rule. Basic idea is to use a "cascading
707 ;; display property" to display the textual rule if the display doesn't
708 ;; support images and the graphical rule if it does, but in either case only
709 ;; display a rule if no other overlay wants to fill the background at the
710 ;; relevant buffer position.
711 (defun fci-rule-display (blank rule-img rule-str for-pre-string)
712 "Generate a display specification for a fill-column rule overlay string."
713 (let* ((cursor-prop (if (and (not for-pre-string) (not fci-newline)) 1))
714 (display-prop (if rule-img
715 `((when (not (or (display-images-p)
716 (fci-competing-overlay-p buffer-position)))
717 . ,(propertize rule-str 'cursor cursor-prop))
718 (when (not (fci-competing-overlay-p buffer-position))
719 . ,rule-img)
720 (space :width 0))
721 `((when (not (fci-competing-overlay-p buffer-position))
722 . ,(propertize rule-str 'cursor cursor-prop))
723 (space :width 0)))))
724 (propertize blank 'cursor cursor-prop 'display display-prop)))
725
726 ;;; ---------------------------------------------------------------------
727 ;;; Drawing and Erasing
728 ;;; ---------------------------------------------------------------------
729
730 (defun fci-get-overlays-region (start end)
731 "Return all overlays between START and END displaying the fill-column rule."
732 (delq nil (mapcar #'(lambda (o) (if (overlay-get o 'fci) o))
733 (overlays-in start end))))
734
735 (defun fci-delete-overlays-region (start end)
736 "Delete overlays displaying the fill-column rule between START and END."
737 (mapc #'(lambda (o) (if (overlay-get o 'fci) (delete-overlay o)))
738 (overlays-in start end)))
739
740 (defun fci-delete-overlays-buffer ()
741 "Delete all overlays displaying the fill-column rule in the current buffer."
742 (save-restriction
743 (widen)
744 (fci-delete-overlays-region (point-min) (point-max))))
745
746 (defsubst fci-posn-visible-p (posn ranges)
747 "Return true if POSN falls within an interval in RANGES."
748 (memq t (mapcar #'(lambda (range) (and (<= (car range) posn)
749 (< posn (cdr range))))
750 ranges)))
751
752 (defsubst fci-get-visible-ranges ()
753 "Return the window start and end for each window on the current buffer."
754 (mapcar #'(lambda (w) (cons (window-start w) (window-end w 'updated)))
755 (fci-get-buffer-windows t)))
756
757 (defun fci-delete-unneeded ()
758 "Erase the fill-column rule at buffer positions not visible in any window."
759 (let ((olays (fci-get-overlays-region (point-min) (point-max)))
760 (ranges (fci-get-visible-ranges)))
761 (dolist (o olays)
762 (unless (fci-posn-visible-p (overlay-start o) ranges)
763 (delete-overlay o)))))
764
765 ;; It would be slightly faster to run this backwards from END to START, but
766 ;; only if we maintained the overlay center at an early position in the
767 ;; buffer. Since other packages that use overlays typically place them while
768 ;; traversing the buffer in a forward direction, that would be a bad idea.
769 (defun fci-put-overlays-region (start end)
770 "Place overlays displaying the fill-column rule between START and END."
771 (goto-char start)
772 (let (o cc)
773 (while (search-forward "\n" end t)
774 (goto-char (match-beginning 0))
775 (setq cc (current-column)
776 o (make-overlay (match-beginning 0) (match-beginning 0)))
777 (overlay-put o 'fci t)
778 (cond
779 ((< cc fci-limit)
780 (overlay-put o 'after-string fci-pre-limit-string))
781 ((> cc fci-limit)
782 (overlay-put o 'after-string fci-post-limit-string))
783 (t
784 (overlay-put o 'after-string fci-at-limit-string)))
785 (goto-char (match-end 0)))))
786
787 (defun fci-redraw-region (start end _ignored)
788 "Erase and redraw the fill-column rule between START and END."
789 (save-match-data
790 (save-excursion
791 (let ((inhibit-point-motion-hooks t))
792 (goto-char end)
793 (setq end (line-beginning-position 2))
794 (fci-delete-overlays-region start end)
795 (fci-put-overlays-region start end)))))
796
797 (defun fci-redraw-window (win &optional start)
798 "Redraw the fill-column rule in WIN starting from START."
799 (fci-redraw-region (or start (window-start win)) (window-end win t) 'ignored))
800
801 ;; This doesn't determine the strictly minimum amount by which the rule needs
802 ;; to be extended, but the amount used is always sufficient, and determining
803 ;; the genuine minimum is more expensive than doing the extra drawing.
804 (defun fci-extend-rule-for-deletion (start end)
805 "Extend the fill-column rule after a deletion that spans newlines."
806 (unless (= start end)
807 (let ((delenda (fci-get-overlays-region start end)))
808 (when delenda
809 (let ((lossage (1+ (length delenda)))
810 (max-end 0)
811 win-end)
812 (mapc #'delete-overlay delenda)
813 (dolist (win (fci-get-buffer-windows t))
814 ;; Do not ask for an updated value of window-end.
815 (setq win-end (window-end win))
816 (when (and (< 0 (- (min win-end end)
817 (max (window-start win) start)))
818 (< max-end win-end))
819 (setq max-end win-end)))
820 (unless (= max-end (point-max))
821 (fci-redraw-region max-end
822 (save-excursion
823 (goto-char max-end)
824 (line-beginning-position lossage))
825 nil)))))))
826
827 (defun fci-update-window-for-scroll (win start)
828 "Redraw the fill-column rule in WIN after it has been been scrolled."
829 (fci-delete-unneeded)
830 (fci-redraw-window win start))
831
832 (defun fci-update-all-windows (&optional all-frames)
833 "Redraw the fill-column rule in all windows showing the current buffer."
834 (dolist (win (fci-get-buffer-windows all-frames))
835 (fci-redraw-window win)))
836
837 (defun fci-redraw-frame ()
838 "Redraw the fill-column rule in all windows on the selected frame."
839 (let* ((wins (window-list (selected-frame) 'no-minibuf))
840 (bufs (delete-dups (mapcar #'window-buffer wins))))
841 (dolist (buf bufs)
842 (with-current-buffer buf
843 (when fci-mode
844 (fci-delete-unneeded)
845 (fci-update-all-windows))))))
846
847 ;;; ---------------------------------------------------------------------
848 ;;; Workarounds
849 ;;; ---------------------------------------------------------------------
850
851 ;; This in placed in post-command-hook and does four things:
852 ;; 1. If the display table has been deleted or something has changed the
853 ;; display table for newline chars, we regenerate overlay strings after
854 ;; reprocessing the display table.
855 ;; 2. If the default char width or height has changed, we regenerate the rule
856 ;; image. (This handles both font changes and also cases where we
857 ;; activate the mode while displaying on a char terminal then subsequently
858 ;; display the buffer on a window frame.)
859 ;; 3. If the value of `tab-width' or `fill-column' has changed, we reset the
860 ;; rule. (We could set things up so that the rule adjusted automatically
861 ;; to such changes, but it wouldn't work on v22 or v23.)
862 ;; 4. Cursor properties are ignored when they're out of sight because of
863 ;; horizontal scrolling. We detect such situations and force a return
864 ;; from hscrolling to bring our requested cursor position back into view.
865 ;; These are all fast tests, so despite the large remit this function
866 ;; shouldn't noticeably affect editing speed.
867 (defun fci-post-command-check ()
868 "This function is a gross hack."
869 (cond
870 ((not (and buffer-display-table
871 (equal (aref buffer-display-table 10) fci-newline)))
872 (setq fci-display-table-processed nil)
873 (fci-mode 1))
874 ((and (< 1 (frame-char-width))
875 (not fci-always-use-textual-rule)
876 (not (and (= (frame-char-width) fci-char-width)
877 (= (frame-char-height) fci-char-height))))
878 (fci-mode 1))
879 ((not (and (= (or fci-rule-column fill-column) fci-column)
880 (= tab-width fci-tab-width)))
881 (fci-mode 1))
882 ((and (< 0 (window-hscroll))
883 auto-hscroll-mode
884 (<= (current-column) (window-hscroll)))
885 ;; Fix me: Rather than setting hscroll to 0, this should reproduce the
886 ;; relevant part of the auto-hscrolling algorithm. Most people won't
887 ;; notice the difference in behavior, though.
888 (set-window-hscroll (selected-window) 0))))
889
890 (provide 'fill-column-indicator)
891
892 ;;; fill-column-indicator.el ends here
Something went wrong with that request. Please try again.