/[emacs]/emacs/lisp/ruler-mode.el
ViewVC logotype

Diff of /emacs/lisp/ruler-mode.el

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.7.2.1 by miles, Fri Apr 4 06:20:10 2003 UTC revision 1.7.2.2 by miles, Tue Oct 14 23:51:22 2003 UTC
# Line 5  Line 5 
5  ;; Author: David Ponce <david@dponce.com>  ;; Author: David Ponce <david@dponce.com>
6  ;; Maintainer: David Ponce <david@dponce.com>  ;; Maintainer: David Ponce <david@dponce.com>
7  ;; Created: 24 Mar 2001  ;; Created: 24 Mar 2001
8  ;; Version: 1.5  ;; Version: 1.6
9  ;; Keywords: convenience  ;; Keywords: convenience
10    
11  ;; This file is part of GNU Emacs.  ;; This file is part of GNU Emacs.
# Line 33  Line 33 
33  ;; You can use the mouse to change the `fill-column' `comment-column',  ;; You can use the mouse to change the `fill-column' `comment-column',
34  ;; `goal-column', `window-margins' and `tab-stop-list' settings:  ;; `goal-column', `window-margins' and `tab-stop-list' settings:
35  ;;  ;;
36  ;; [header-line (shift down-mouse-1)] set left margin to the ruler  ;; [header-line (shift down-mouse-1)] set left margin end to the ruler
37  ;; graduation where the mouse pointer is on.  ;; graduation where the mouse pointer is on.
38  ;;  ;;
39  ;; [header-line (shift down-mouse-3)] set right margin to the ruler  ;; [header-line (shift down-mouse-3)] set right margin beginning to
40  ;; graduation where the mouse pointer is on.  ;; the ruler graduation where the mouse pointer is on.
41  ;;  ;;
42  ;; [header-line down-mouse-2] set `fill-column', `comment-column' or  ;; [header-line down-mouse-2] Drag the `fill-column', `comment-column'
43  ;; `goal-column' to the ruler graduation with the mouse dragging.  ;; or `goal-column' to a ruler graduation.
44  ;;  ;;
45  ;; [header-line (control down-mouse-1)] add a tab stop to the ruler  ;; [header-line (control down-mouse-1)] add a tab stop to the ruler
46  ;; graduation where the mouse pointer is on.  ;; graduation where the mouse pointer is on.
# Line 57  Line 57 
57  ;; the `current-column' location, `ruler-mode-fill-column-char' shows  ;; the `current-column' location, `ruler-mode-fill-column-char' shows
58  ;; the `fill-column' location, `ruler-mode-comment-column-char' shows  ;; the `fill-column' location, `ruler-mode-comment-column-char' shows
59  ;; the `comment-column' location, `ruler-mode-goal-column-char' shows  ;; the `comment-column' location, `ruler-mode-goal-column-char' shows
60  ;; the `goal-column' and `ruler-mode-tab-stop-char' shows tab  ;; the `goal-column' and `ruler-mode-tab-stop-char' shows tab stop
61  ;; stop locations.  `window-margins' areas are shown with a different  ;; locations.  Graduations in `window-margins' and `window-fringes'
62  ;; background color.  ;; areas are shown with a different foreground color.
63  ;;  ;;
64  ;; It is also possible to customize the following characters:  ;; It is also possible to customize the following characters:
65  ;;  ;;
 ;; - `ruler-mode-margins-char' character used to pad margin areas  
 ;;   (space by default).  
66  ;; - `ruler-mode-basic-graduation-char' character used for basic  ;; - `ruler-mode-basic-graduation-char' character used for basic
67  ;;   graduations ('.' by default).  ;;   graduations ('.' by default).
68  ;; - `ruler-mode-inter-graduation-char' character used for  ;; - `ruler-mode-inter-graduation-char' character used for
# Line 83  Line 81 
81  ;;   `current-column' character.  ;;   `current-column' character.
82  ;; - `ruler-mode-tab-stop-face' the face used to highlight tab stop  ;; - `ruler-mode-tab-stop-face' the face used to highlight tab stop
83  ;;   characters.  ;;   characters.
84  ;; - `ruler-mode-margins-face' the face used to highlight the  ;; - `ruler-mode-margins-face' the face used to highlight graduations
85  ;;   `window-margins' areas.  ;;   in the `window-margins' areas.
86    ;; - `ruler-mode-fringes-face' the face used to highlight graduations
87    ;;   in the `window-fringes' areas.
88  ;; - `ruler-mode-column-number-face' the face used to highlight the  ;; - `ruler-mode-column-number-face' the face used to highlight the
89  ;;   number graduations.  ;;   numbered graduations.
90  ;;  ;;
91  ;; `ruler-mode-default-face' inherits from the built-in `default' face.  ;; `ruler-mode-default-face' inherits from the built-in `default' face.
92  ;; All `ruler-mode' faces inerit from `ruler-mode-default-face'.  ;; All `ruler-mode' faces inherit from `ruler-mode-default-face'.
93  ;;  ;;
94  ;; WARNING: To keep ruler graduations aligned on text columns it is  ;; 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  ;; important to use the same font family and size for ruler and text
# Line 135  or remove a tab stop.  \\[ruler-mode-tog Line 135  or remove a tab stop.  \\[ruler-mode-tog
135                      (format "Invalid character value: %S" value))                      (format "Invalid character value: %S" value))
136          widget))))          widget))))
137    
138  (defcustom ruler-mode-fill-column-char (if window-system  (defcustom ruler-mode-fill-column-char (if (char-displayable-p ?¶)
139                                             ?\¶                                             ?\¶
140                                           ?\|)                                           ?\|)
141    "*Character used at the `fill-column' location."    "*Character used at the `fill-column' location."
# Line 161  or remove a tab stop.  \\[ruler-mode-tog Line 161  or remove a tab stop.  \\[ruler-mode-tog
161            (integer :tag "Integer char value"            (integer :tag "Integer char value"
162                     :validate ruler-mode-character-validate)))                     :validate ruler-mode-character-validate)))
163    
164  (defcustom ruler-mode-current-column-char (if window-system  (defcustom ruler-mode-current-column-char (if (char-displayable-p ?¦)
165                                                ?\¦                                                ?\¦
166                                              ?\@)                                              ?\@)
167    "*Character used at the `current-column' location."    "*Character used at the `current-column' location."
# Line 179  or remove a tab stop.  \\[ruler-mode-tog Line 179  or remove a tab stop.  \\[ruler-mode-tog
179            (integer :tag "Integer char value"            (integer :tag "Integer char value"
180                     :validate ruler-mode-character-validate)))                     :validate ruler-mode-character-validate)))
181    
 (defcustom ruler-mode-margins-char ?\s  
   "*Character used in margin areas."  
   :group 'ruler-mode  
   :type '(choice  
           (character :tag "Character")  
           (integer :tag "Integer char value"  
                    :validate ruler-mode-character-validate)))  
   
182  (defcustom ruler-mode-basic-graduation-char ?\.  (defcustom ruler-mode-basic-graduation-char ?\.
183    "*Character used for basic graduations."    "*Character used for basic graduations."
184    :group 'ruler-mode    :group 'ruler-mode
# Line 225  or remove a tab stop.  \\[ruler-mode-tog Line 217  or remove a tab stop.  \\[ruler-mode-tog
217    "Default face used by the ruler."    "Default face used by the ruler."
218    :group 'ruler-mode)    :group 'ruler-mode)
219    
220    (defface ruler-mode-pad-face
221      '((((type tty))
222         (:inherit ruler-mode-default-face
223                   :background "grey50"
224                   ))
225        (t
226         (:inherit ruler-mode-default-face
227                   :background "grey64"
228                   )))
229      "Face used to pad inactive ruler areas."
230      :group 'ruler-mode)
231    
232    (defface ruler-mode-margins-face
233      '((t
234         (:inherit ruler-mode-default-face
235                   :foreground "white"
236                   )))
237      "Face used to highlight margin areas."
238      :group 'ruler-mode)
239    
240    (defface ruler-mode-fringes-face
241      '((t
242         (:inherit ruler-mode-default-face
243                   :foreground "green"
244                   )))
245      "Face used to highlight fringes areas."
246      :group 'ruler-mode)
247    
248  (defface ruler-mode-column-number-face  (defface ruler-mode-column-number-face
249    '((t    '((t
250       (:inherit ruler-mode-default-face       (:inherit ruler-mode-default-face
# Line 265  or remove a tab stop.  \\[ruler-mode-tog Line 285  or remove a tab stop.  \\[ruler-mode-tog
285    "Face used to highlight tab stop characters."    "Face used to highlight tab stop characters."
286    :group 'ruler-mode)    :group 'ruler-mode)
287    
 (defface ruler-mode-margins-face  
   '((((type tty))  
      (:inherit ruler-mode-default-face  
                :background "grey50"  
                ))  
     (t  
      (:inherit ruler-mode-default-face  
                :background "grey64"  
                )))  
   "Face used to highlight the `window-margins' areas."  
   :group 'ruler-mode)  
   
288  (defface ruler-mode-current-column-face  (defface ruler-mode-current-column-face
289    '((t    '((t
290       (:inherit ruler-mode-default-face       (:inherit ruler-mode-default-face
# Line 286  or remove a tab stop.  \\[ruler-mode-tog Line 294  or remove a tab stop.  \\[ruler-mode-tog
294    "Face used to highlight the `current-column' character."    "Face used to highlight the `current-column' character."
295    :group 'ruler-mode)    :group 'ruler-mode)
296    
297    (defmacro ruler-mode-left-fringe-cols ()
298      "Return the width, measured in columns, of the left fringe area."
299      '(ceiling (or (car (window-fringes)) 0)
300                (frame-char-width)))
301    
302    (defmacro ruler-mode-right-fringe-cols ()
303      "Return the width, measured in columns, of the right fringe area."
304      '(ceiling (or (nth 1 (window-fringes)) 0)
305                (frame-char-width)))
306    
307    (defun ruler-mode-left-scroll-bar-cols ()
308      "Return the width, measured in columns, of the right vertical scrollbar."
309      (let* ((wsb   (window-scroll-bars))
310             (vtype (nth 2 wsb))
311             (cols  (nth 1 wsb)))
312        (if (or (eq vtype 'left)
313                (and (eq vtype t)
314                     (eq (frame-parameter nil 'vertical-scroll-bars) 'left)))
315            (or cols
316                (ceiling
317                 ;; nil means it's a non-toolkit scroll bar,
318                 ;; and its width in columns is 14 pixels rounded up.
319                 (or (frame-parameter nil 'scroll-bar-width) 14)
320                 ;; Always round up to multiple of columns.
321                 (frame-char-width)))
322          0)))
323    
324    (defun ruler-mode-right-scroll-bar-cols ()
325      "Return the width, measured in columns, of the right vertical scrollbar."
326      (let* ((wsb   (window-scroll-bars))
327             (vtype (nth 2 wsb))
328             (cols  (nth 1 wsb)))
329        (if (or (eq vtype 'right)
330                (and (eq vtype t)
331                     (eq (frame-parameter nil 'vertical-scroll-bars) 'right)))
332            (or cols
333                (ceiling
334                 ;; nil means it's a non-toolkit scroll bar,
335                 ;; and its width in columns is 14 pixels rounded up.
336                 (or (frame-parameter nil 'scroll-bar-width) 14)
337                 ;; Always round up to multiple of columns.
338                 (frame-char-width)))
339          0)))
340    
341    (defsubst ruler-mode-full-window-width ()
342      "Return the full width of the selected window."
343      (let ((edges (window-edges)))
344        (- (nth 2 edges) (nth 0 edges))))
345    
346    (defsubst ruler-mode-window-col (n)
347      "Return a column number relative to the selected window.
348    N is a column number relative to selected frame."
349      (- n
350         (car (window-edges))
351         (or (car (window-margins)) 0)
352         (ruler-mode-left-fringe-cols)
353         (ruler-mode-left-scroll-bar-cols)))
354    
355  (defun ruler-mode-mouse-set-left-margin (start-event)  (defun ruler-mode-mouse-set-left-margin (start-event)
356    "Set left margin to the graduation where the mouse pointer is on.    "Set left margin end to the graduation where the mouse pointer is on.
357  START-EVENT is the mouse click event."  START-EVENT is the mouse click event."
358    (interactive "e")    (interactive "e")
359    (let* ((start (event-start start-event))    (let* ((start (event-start start-event))
360           (end   (event-end   start-event))           (end   (event-end   start-event))
361           w col m lm0 lm rm)           col w lm rm)
362      (if (eq start end) ;; mouse click      (when (eq start end) ;; mouse click
363          (save-selected-window        (save-selected-window
364            (select-window (posn-window start))          (select-window (posn-window start))
365            (setq m   (window-margins)          (setq col (- (car (posn-col-row start)) (car (window-edges))
366                  lm0 (or (car m) 0)                       (ruler-mode-left-scroll-bar-cols))
367                  rm  (or (cdr m) 0)                w   (- (ruler-mode-full-window-width)
368                  w   (window-width)                       (ruler-mode-left-scroll-bar-cols)
369                  col (car (posn-col-row start))                       (ruler-mode-right-scroll-bar-cols)))
370                  lm  (min (- w rm) col))          (when (and (>= col 0) (< col w))
371            (message "Left margin set to %d (was %d)" lm lm0)            (setq lm (window-margins)
372            (set-window-margins nil lm rm)))))                  rm (or (cdr lm) 0)
373                    lm (or (car lm) 0))
374              (message "Left margin set to %d (was %d)" col lm)
375              (set-window-margins nil col rm))))))
376    
377  (defun ruler-mode-mouse-set-right-margin (start-event)  (defun ruler-mode-mouse-set-right-margin (start-event)
378    "Set right margin to the graduation where the mouse pointer is on.    "Set right margin beginning to the graduation where the mouse pointer is on.
379  START-EVENT is the mouse click event."  START-EVENT is the mouse click event."
380    (interactive "e")    (interactive "e")
381    (let* ((start (event-start start-event))    (let* ((start (event-start start-event))
382           (end   (event-end   start-event))           (end   (event-end   start-event))
383           m col w lm rm0 rm)           col w lm rm)
384      (if (eq start end) ;; mouse click      (when (eq start end) ;; mouse click
385          (save-selected-window        (save-selected-window
386            (select-window (posn-window start))          (select-window (posn-window start))
387            (setq m   (window-margins)          (setq col (- (car (posn-col-row start)) (car (window-edges))
388                  rm0 (or (cdr m) 0)                       (ruler-mode-left-scroll-bar-cols))
389                  lm  (or (car m) 0)                w   (- (ruler-mode-full-window-width)
390                  col (car (posn-col-row start))                       (ruler-mode-left-scroll-bar-cols)
391                  w   (window-width)                       (ruler-mode-right-scroll-bar-cols)))
392                  rm  (max 0 (- w col)))          (when (and (>= col 0) (< col w))
393            (message "Right margin set to %d (was %d)" rm rm0)            (setq lm  (window-margins)
394            (set-window-margins nil lm rm)))))                  rm  (or (cdr lm) 0)
395                    lm  (or (car lm) 0)
396                    col (- w col 1))
397              (message "Right margin set to %d (was %d)" col rm)
398              (set-window-margins nil lm col))))))
399    
400  (defvar ruler-mode-mouse-current-grab-object nil  (defvar ruler-mode-dragged-symbol nil
401    "Column symbol dragged in the ruler.    "Column symbol dragged in the ruler.
402  That is `fill-column', `comment-column', `goal-column', or nil when  That is `fill-column', `comment-column', `goal-column', or nil when
403  nothing is dragged.")  nothing is dragged.")
404    
405  (defun ruler-mode-mouse-grab-any-column (start-event)  (defun ruler-mode-mouse-grab-any-column (start-event)
406    "Set a column symbol to the graduation with mouse dragging.    "Drag a column symbol on the ruler.
407  See also variable `ruler-mode-mouse-current-grab-object'.  Start dragging on mouse down event START-EVENT, and update the column
408  START-EVENT is the mouse down event."  symbol value with the current value of the ruler graduation while
409    dragging.  See also the variable `ruler-mode-dragged-symbol'."
410    (interactive "e")    (interactive "e")
411    (setq ruler-mode-mouse-current-grab-object nil)    (setq ruler-mode-dragged-symbol nil)
412    (let* ((start (event-start start-event))    (let* ((start (event-start start-event))
413           m col w lm rm hs newc oldc)           col newc oldc)
414      (save-selected-window      (save-selected-window
415        (select-window (posn-window start))        (select-window (posn-window start))
416        (setq m   (window-margins)        (setq col  (ruler-mode-window-col (car (posn-col-row start)))
417              lm  (or (car m) 0)              newc (+ col (window-hscroll)))
418              rm  (or (cdr m) 0)        (and
419              col (- (car (posn-col-row start)) lm)         (>= col 0) (< col (window-width))
420              w   (window-width)         (cond
421              hs  (window-hscroll)  
422              newc  (+ col hs))          ;; Handle the fill column.
423        ;;          ((eq newc fill-column)
424        ;; About the ways to handle the goal column:           (setq oldc fill-column
425        ;; A. update the value of the goal column if goal-column has                 ruler-mode-dragged-symbol 'fill-column)
426        ;;    non-nil value and if the mouse is dragged           t) ;; Start dragging
427        ;; B. set value to the goal column if goal-column has nil and if  
428        ;;    the mouse is just clicked, not dragged.          ;; Handle the comment column.
429        ;; C. unset value to the goal column if goal-column has non-nil          ((eq newc comment-column)
430        ;;    and mouse is just clicked on goal-column character on the           (setq oldc comment-column
431        ;;    ruler, not dragged.                 ruler-mode-dragged-symbol 'comment-column)
432        ;;           t) ;; Start dragging
433        (and (>= col 0) (< (+ col lm rm) w)  
434             (cond          ;; Handle the goal column.
435              ((eq newc fill-column)          ;; A. On mouse down on the goal column character on the ruler,
436               (setq oldc fill-column)          ;;    update the `goal-column' value while dragging.
437               (setq ruler-mode-mouse-current-grab-object 'fill-column)          ;; B. If `goal-column' is nil, set the goal column where the
438               t)          ;;    mouse is clicked.
439              ((eq newc comment-column)          ;; C. On mouse click on the goal column character on the
440               (setq oldc comment-column)          ;;    ruler, unset the goal column.
441               (setq ruler-mode-mouse-current-grab-object 'comment-column)          ((eq newc goal-column)          ; A. Drag the goal column.
442               t)           (setq oldc goal-column
443              ((eq newc goal-column)      ; A. update goal column                 ruler-mode-dragged-symbol 'goal-column)
444               (setq oldc goal-column)           t) ;; Start dragging
445               (setq ruler-mode-mouse-current-grab-object 'goal-column)  
446               t)          ((null goal-column)             ; B. Set the goal column.
447              ((null goal-column)         ; B. set goal column           (setq oldc goal-column
448               (setq oldc goal-column)                 goal-column newc)
449               (setq goal-column newc)           ;; mouse-2 coming AFTER drag-mouse-2 invokes `ding'.  This
450               ;; mouse-2 coming AFTER drag-mouse-2 invokes `ding'.           ;; `ding' flushes the next messages about setting goal
451               ;; This `ding' flushes the next messages about setting           ;; column.  So here I force fetch the event(mouse-2) and
452               ;; goal column. So here I force fetch the event(mouse-2)           ;; throw away.
453               ;; and throw away.           (read-event)
454               (read-event)           ;; Ding BEFORE `message' is OK.
455               ;; Ding BEFORE `message' is OK.           (when ruler-mode-set-goal-column-ding-flag
456               (if ruler-mode-set-goal-column-ding-flag             (ding))
457                   (ding))           (message "Goal column set to %d (click on %s again to unset it)"
458               (message                    newc
459                "Goal column %d (click `%s' on the ruler again to unset it)"                    (propertize (char-to-string ruler-mode-goal-column-char)
460                newc                                'face 'ruler-mode-goal-column-face))
461                (propertize (char-to-string ruler-mode-goal-column-char)           nil) ;; Don't start dragging.
462                            'face 'ruler-mode-goal-column-face))          )
463               ;; don't enter drag iteration         (if (eq 'click (ruler-mode-mouse-drag-any-column-iteration
464               nil))                         (posn-window start)))
465             (if (eq 'click (ruler-mode-mouse-drag-any-column-iteration             (when (eq 'goal-column ruler-mode-dragged-symbol)
466                             (posn-window start)))               ;; C. Unset the goal column.
467                 (if (eq 'goal-column ruler-mode-mouse-current-grab-object)               (set-goal-column t))
468                     ;; C. unset goal column           ;; At end of dragging, report the updated column symbol.
469                     (set-goal-column t))           (message "%s is set to %d (was %d)"
470               ;; *-column is updated; report it                    ruler-mode-dragged-symbol
471               (message "%s is set to %d (was %d)"                    (symbol-value ruler-mode-dragged-symbol)
472                        ruler-mode-mouse-current-grab-object                    oldc))))))
                       (eval ruler-mode-mouse-current-grab-object)  
                       oldc))))))  
473    
474  (defun ruler-mode-mouse-drag-any-column-iteration (window)  (defun ruler-mode-mouse-drag-any-column-iteration (window)
475    "Update the ruler while dragging the mouse.    "Update the ruler while dragging the mouse.
476  WINDOW is the window where the last down-mouse event is occurred.  WINDOW is the window where occurred the last down-mouse event.
477  Return a symbol `drag' if the mouse is actually dragged.  Return the symbol `drag' if the mouse has been dragged, or `click' if
478  Return a symbol `click' if the mouse is just clicked."  the mouse has been clicked."
479    (let (newevent    (let ((drags 0)
480          (drag-count 0))          event)
481      (track-mouse      (track-mouse
482        (while (progn        (while (mouse-movement-p (setq event (read-event)))
483                 (setq newevent (read-event))          (setq drags (1+ drags))
484                 (mouse-movement-p newevent))          (when (eq window (posn-window (event-end event)))
485          (setq drag-count (1+ drag-count))            (ruler-mode-mouse-drag-any-column event)
486          (if (eq window (posn-window (event-end newevent)))            (force-mode-line-update))))
487              (progn      (if (and (zerop drags) (eq 'click (car (event-modifiers event))))
               (ruler-mode-mouse-drag-any-column newevent)  
               (force-mode-line-update)))))  
     (if (and (eq drag-count 0)  
              (eq 'click (car (event-modifiers newevent))))  
488          'click          'click
489        'drag)))        'drag)))
490    
491  (defun ruler-mode-mouse-drag-any-column (start-event)  (defun ruler-mode-mouse-drag-any-column (start-event)
492    "Update the ruler for START-EVENT, one mouse motion event."    "Update the value of the symbol dragged on the ruler.
493    Called on each mouse motion event START-EVENT."
494    (let* ((start (event-start start-event))    (let* ((start (event-start start-event))
495           (end   (event-end   start-event))           (end   (event-end   start-event))
496           m col w lm rm hs newc)           col newc)
497      (save-selected-window      (save-selected-window
498        (select-window (posn-window start))        (select-window (posn-window start))
499        (setq m   (window-margins)        (setq col  (ruler-mode-window-col (car (posn-col-row end)))
500              lm  (or (car m) 0)              newc (+ col (window-hscroll)))
501              rm  (or (cdr m) 0)        (when (and (>= col 0) (< col (window-width)))
502              col (- (car (posn-col-row end)) lm)          (set ruler-mode-dragged-symbol newc)))))
             w   (window-width)  
             hs  (window-hscroll)  
             newc  (+ col hs))  
       (if (and (>= col 0) (< (+ col lm rm) w))  
           (set ruler-mode-mouse-current-grab-object newc)))))  
503    
504  (defun ruler-mode-mouse-add-tab-stop (start-event)  (defun ruler-mode-mouse-add-tab-stop (start-event)
505    "Add a tab stop to the graduation where the mouse pointer is on.    "Add a tab stop to the graduation where the mouse pointer is on.
506  START-EVENT is the mouse click event."  START-EVENT is the mouse click event."
507    (interactive "e")    (interactive "e")
508    (if ruler-mode-show-tab-stops    (when ruler-mode-show-tab-stops
509        (let* ((start (event-start start-event))      (let* ((start (event-start start-event))
510               (end   (event-end   start-event))             (end   (event-end   start-event))
511               m col w lm rm hs ts)             col ts)
512          (if (eq start end) ;; mouse click        (when (eq start end) ;; mouse click
513              (save-selected-window          (save-selected-window
514                (select-window (posn-window start))            (select-window (posn-window start))
515                (setq m   (window-margins)            (setq col (ruler-mode-window-col (car (posn-col-row start)))
516                      lm  (or (car m) 0)                  ts  (+ col (window-hscroll)))
517                      rm  (or (cdr m) 0)            (and (>= col 0) (< col (window-width))
518                      col (- (car (posn-col-row start)) lm)                 (not (member ts tab-stop-list))
519                      w   (window-width)                 (progn
520                      hs  (window-hscroll)                   (message "Tab stop set to %d" ts)
521                      ts  (+ col hs))                   (setq tab-stop-list (sort (cons ts tab-stop-list)
522                (and (>= col 0) (< (+ col lm rm) w)                                             #'<)))))))))
                    (not (member ts tab-stop-list))  
                    (progn  
                      (message "Tab stop set to %d" ts)  
                      (setq tab-stop-list  
                            (sort (cons ts tab-stop-list)  
                                  #'<)))))))))  
523    
524  (defun ruler-mode-mouse-del-tab-stop (start-event)  (defun ruler-mode-mouse-del-tab-stop (start-event)
525    "Delete tab stop at the graduation where the mouse pointer is on.    "Delete tab stop at the graduation where the mouse pointer is on.
526  START-EVENT is the mouse click event."  START-EVENT is the mouse click event."
527    (interactive "e")    (interactive "e")
528    (if ruler-mode-show-tab-stops    (when ruler-mode-show-tab-stops
529        (let* ((start (event-start start-event))      (let* ((start (event-start start-event))
530               (end   (event-end   start-event))             (end   (event-end   start-event))
531               m col w lm rm hs ts)             col ts)
532          (if (eq start end) ;; mouse click        (when (eq start end) ;; mouse click
533              (save-selected-window          (save-selected-window
534                (select-window (posn-window start))            (select-window (posn-window start))
535                (setq m   (window-margins)            (setq col (ruler-mode-window-col (car (posn-col-row start)))
536                      lm  (or (car m) 0)                  ts  (+ col (window-hscroll)))
537                      rm  (or (cdr m) 0)            (and (>= col 0) (< col (window-width))
538                      col (- (car (posn-col-row start)) lm)                 (member ts tab-stop-list)
539                      w   (window-width)                 (progn
540                      hs  (window-hscroll)                   (message "Tab stop at %d deleted" ts)
541                      ts  (+ col hs))                   (setq tab-stop-list (delete ts tab-stop-list)))))))))
               (and (>= col 0) (< (+ col lm rm) w)  
                    (member ts tab-stop-list)  
                    (progn  
                      (message "Tab stop at %d deleted" ts)  
                      (setq tab-stop-list  
                            (delete ts tab-stop-list)))))))))  
542    
543  (defun ruler-mode-toggle-show-tab-stops ()  (defun ruler-mode-toggle-show-tab-stops ()
544    "Toggle showing of tab stops on the ruler."    "Toggle showing of tab stops on the ruler."
# Line 542  START-EVENT is the mouse click event." Line 594  START-EVENT is the mouse click event."
594      ;; the current one is the ruler header line format.      ;; the current one is the ruler header line format.
595      (when (eq header-line-format ruler-mode-header-line-format)      (when (eq header-line-format ruler-mode-header-line-format)
596        (kill-local-variable 'header-line-format)        (kill-local-variable 'header-line-format)
597        (when ruler-mode-header-line-format-old        (when (local-variable-p 'ruler-mode-header-line-format-old)
598          (setq header-line-format ruler-mode-header-line-format-old)))          (setq header-line-format ruler-mode-header-line-format-old)))
599      (remove-hook 'post-command-hook     ; remove local hook      (remove-hook 'post-command-hook     ; remove local hook
600                   #'force-mode-line-update t)))                   #'force-mode-line-update t)))
# Line 588  drag-mouse-2: set goal column, \ Line 640  drag-mouse-2: set goal column, \
640  mouse-2: unset goal column"  mouse-2: unset goal column"
641    "Help string shown when mouse is on the goal column character.")    "Help string shown when mouse is on the goal column character.")
642    
643  (defconst ruler-mode-left-margin-help-echo  (defconst ruler-mode-margin-help-echo
644    "Left margin %S"    "%s margin %S"
645    "Help string shown when mouse is over the left margin area.")    "Help string shown when mouse is over a margin area.")
646    
647  (defconst ruler-mode-right-margin-help-echo  (defconst ruler-mode-fringe-help-echo
648    "Right margin %S"    "%s fringe %S"
649    "Help string shown when mouse is over the right margin area.")    "Help string shown when mouse is over a fringe area.")
   
 (defmacro ruler-mode-left-fringe-cols ()  
   "Return the width, measured in columns, of the left fringe area."  
   '(round (or (frame-parameter nil 'left-fringe) 0)  
           (frame-char-width)))  
   
 (defmacro ruler-mode-right-fringe-cols ()  
   "Return the width, measured in columns, of the right fringe area."  
   '(round (or (frame-parameter nil 'right-fringe) 0)  
           (frame-char-width)))  
   
 (defmacro ruler-mode-left-scroll-bar-cols ()  
   "Return the width, measured in columns, of the left vertical scrollbar."  
   '(if (eq (frame-parameter nil 'vertical-scroll-bars) 'left)  
        (let ((sbw (frame-parameter nil 'scroll-bar-width)))  
          ;; nil means it's a non-toolkit scroll bar,  
          ;; and its width in columns is 14 pixels rounded up.  
          (unless sbw (setq sbw 14))  
          ;; Always round up to multiple of columns.  
          (ceiling sbw (frame-char-width)))  
      0))  
   
 (defmacro ruler-mode-right-scroll-bar-cols ()  
   "Return the width, measured in columns, of the right vertical scrollbar."  
   '(if (eq (frame-parameter nil 'vertical-scroll-bars) 'right)  
        (round (or (frame-parameter nil 'scroll-bar-width) 0)  
               (frame-char-width))  
      0))  
650    
651  (defun ruler-mode-ruler ()  (defun ruler-mode-ruler ()
652    "Return a string ruler."    "Return a string ruler."
653    (if ruler-mode    (when ruler-mode
654        (let* ((j     (+ (ruler-mode-left-fringe-cols)      (let* ((fullw (ruler-mode-full-window-width))
655                         (ruler-mode-left-scroll-bar-cols)))             (w     (window-width))
656               (w     (+ (window-width) j))             (m     (window-margins))
657               (m     (window-margins))             (lsb   (ruler-mode-left-scroll-bar-cols))
658               (l     (or (car m) 0))             (lf    (ruler-mode-left-fringe-cols))
659               (r     (or (cdr m) 0))             (lm    (or (car m) 0))
660               (o     (- (window-hscroll) l j))             (rsb   (ruler-mode-right-scroll-bar-cols))
661               (i     0)             (rf    (ruler-mode-right-fringe-cols))
662               (ruler (concat             (rm    (or (cdr m) 0))
663                       ;; unit graduations             (ruler (make-string fullw ruler-mode-basic-graduation-char))
664                       (make-string w ruler-mode-basic-graduation-char)             (o     (+ lsb lf lm))
665                       ;; extra space to fill the header line             (x     0)
666                       (make-string (+ (ruler-mode-right-fringe-cols)             (i     o)
667                                       (ruler-mode-right-scroll-bar-cols))             (j     (window-hscroll))
668                                    ?\ )))             k c l1 l2 r2 r1 h1 h2 f1 f2)
669               c k)  
670          ;; Setup the default properties.
671          ;; Setup default face and help echo.        (put-text-property 0 fullw 'face 'ruler-mode-default-face ruler)
672          (put-text-property 0 (length ruler)        (put-text-property 0 fullw
673                             'face 'ruler-mode-default-face                           'help-echo
674                             ruler)                           (cond
675          (put-text-property 0 (length ruler)                            (ruler-mode-show-tab-stops
676                             'help-echo                             ruler-mode-ruler-help-echo-when-tab-stops)
677                             (if ruler-mode-show-tab-stops                            (goal-column
678                                 ruler-mode-ruler-help-echo-when-tab-stops                             ruler-mode-ruler-help-echo-when-goal-column)
679                               (if goal-column                            (t
680                                   ruler-mode-ruler-help-echo-when-goal-column                             ruler-mode-ruler-help-echo))
681                                 ruler-mode-ruler-help-echo))                           ruler)
682                             ruler)        ;; Setup the local map.
683          ;; Setup the local map.        (put-text-property 0 fullw 'local-map ruler-mode-map ruler)
684          (put-text-property 0 (length ruler)  
685                             'local-map ruler-mode-map        ;; Setup the active area.
686                             ruler)        (while (< x w)
687            ;; Graduations.
688          (setq j (+ l j))          (cond
689          ;; Setup the left margin area.           ;; Show a number graduation.
690          (put-text-property           ((= (mod j 10) 0)
691           i j 'face 'ruler-mode-margins-face            (setq c (number-to-string (/ j 10))
692           ruler)                  m (length c)
693          (put-text-property                  k i)
694           i j 'help-echo (format ruler-mode-left-margin-help-echo l)            (put-text-property
695           ruler)             i (1+ i) 'face 'ruler-mode-column-number-face
696          (while (< i j)             ruler)
697            (aset ruler i ruler-mode-margins-char)            (while (and (> m 0) (>= k 0))
698            (setq i (1+ i)))              (aset ruler k (aref c (setq m (1- m))))
699                (setq k (1- k))))
700          ;; Setup the ruler area.           ;; Show an intermediate graduation.
701          (setq r (- w r))           ((= (mod j 5) 0)
702          (while (< i r)            (aset ruler i ruler-mode-inter-graduation-char)))
703            (setq j (+ i o))          ;; Special columns.
704            (cond          (cond
705             ((= (mod j 10) 0)           ;; Show the `current-column' marker.
706              (setq c (number-to-string (/ j 10))           ((= j (current-column))
707                    m (length c)            (aset ruler i ruler-mode-current-column-char)
708                    k i)            (put-text-property
709              (put-text-property             i (1+ i) 'face 'ruler-mode-current-column-face
710               i (1+ i) 'face 'ruler-mode-column-number-face             ruler))
711               ruler)           ;; Show the `goal-column' marker.
712              (while (and (> m 0) (>= k 0))           ((and goal-column (= j goal-column))
713                (aset ruler k (aref c (setq m (1- m))))            (aset ruler i ruler-mode-goal-column-char)
714                (setq k (1- k)))            (put-text-property
715              )             i (1+ i) 'face 'ruler-mode-goal-column-face
716             ((= (mod j 5) 0)             ruler)
717              (aset ruler i ruler-mode-inter-graduation-char)            (put-text-property
718              )             i (1+ i) 'help-echo ruler-mode-goal-column-help-echo
719             )             ruler))
720            (setq i (1+ i)))           ;; Show the `comment-column' marker.
721             ((= j comment-column)
722          ;; Setup the right margin area.            (aset ruler i ruler-mode-comment-column-char)
723          (put-text-property            (put-text-property
724           i (length ruler) 'face 'ruler-mode-margins-face             i (1+ i) 'face 'ruler-mode-comment-column-face
725           ruler)             ruler)
726          (put-text-property            (put-text-property
727           i (length ruler) 'help-echo             i (1+ i) 'help-echo ruler-mode-comment-column-help-echo
728           (format ruler-mode-right-margin-help-echo (- w r))             ruler))
729           ruler)           ;; Show the `fill-column' marker.
730          (while (< i (length ruler))           ((= j fill-column)
731            (aset ruler i ruler-mode-margins-char)            (aset ruler i ruler-mode-fill-column-char)
732            (setq i (1+ i)))            (put-text-property
733               i (1+ i) 'face 'ruler-mode-fill-column-face
734          ;; Show the `goal-column' marker.             ruler)
735          (if goal-column            (put-text-property
736              (progn             i (1+ i) 'help-echo ruler-mode-fill-column-help-echo
737                (setq i (- goal-column o))             ruler))
738                (and (>= i 0) (< i r)           ;; Show the `tab-stop-list' markers.
739                     (aset ruler i ruler-mode-goal-column-char)           ((and ruler-mode-show-tab-stops (member j tab-stop-list))
740                     (progn            (aset ruler i ruler-mode-tab-stop-char)
741                       (put-text-property            (put-text-property
742                        i (1+ i) 'face 'ruler-mode-goal-column-face             i (1+ i) 'face 'ruler-mode-tab-stop-face
743                        ruler)             ruler)))
744                       (put-text-property          (setq i (1+ i)
745                        i (1+ i) 'help-echo ruler-mode-goal-column-help-echo                j (1+ j)
746                        ruler))                x (1+ x)))
747                     )))  
748          ;; Highlight the fringes and margins.
749          ;; Show the `comment-column' marker.        (if (nth 2 (window-fringes))
750          (setq i (- comment-column o))            ;; fringes outside margins.
751          (and (>= i 0) (< i r)            (setq l1 lf
752               (aset ruler i ruler-mode-comment-column-char)                  l2 lm
753               (progn                  r2 rm
754                 (put-text-property                  r1 rf
755                  i (1+ i) 'face 'ruler-mode-comment-column-face                  h1 ruler-mode-fringe-help-echo
756                  ruler)                  h2 ruler-mode-margin-help-echo
757                 (put-text-property                  f1 'ruler-mode-fringes-face
758                  i (1+ i) 'help-echo ruler-mode-comment-column-help-echo                  f2 'ruler-mode-margins-face)
759                  ruler)))          ;; fringes inside margins.
760            (setq l1 lm
761          ;; Show the `fill-column' marker.                l2 lf
762          (setq i (- fill-column o))                r2 rf
763          (and (>= i 0) (< i r)                r1 rm
764               (aset ruler i ruler-mode-fill-column-char)                h1 ruler-mode-margin-help-echo
765               (progn (put-text-property                h2 ruler-mode-fringe-help-echo
766                       i (1+ i) 'face 'ruler-mode-fill-column-face                f1 'ruler-mode-margins-face
767                       ruler)                f2 'ruler-mode-fringes-face))
768                      (put-text-property        (setq i lsb j (+ i l1))
769                       i (1+ i) 'help-echo ruler-mode-fill-column-help-echo        (put-text-property i j 'face f1 ruler)
770                       ruler)))        (put-text-property i j 'help-echo (format h1 "Left" l1) ruler)
771          (setq i j j (+ i l2))
772          ;; Show the `tab-stop-list' markers.        (put-text-property i j 'face f2 ruler)
773          (if ruler-mode-show-tab-stops        (put-text-property i j 'help-echo (format h2 "Left" l2) ruler)
774              (let ((tsl tab-stop-list) ts)        (setq i (+ o w) j (+ i r2))
775                (while tsl        (put-text-property i j 'face f2 ruler)
776                  (setq ts  (car tsl)        (put-text-property i j 'help-echo (format h2 "Right" r2) ruler)
777                        tsl (cdr tsl)        (setq i j j (+ i r1))
778                        i   (- ts o))        (put-text-property i j 'face f1 ruler)
779                  (and (>= i 0) (< i r)        (put-text-property i j 'help-echo (format h1 "Right" r1) ruler)
780                       (aset ruler i ruler-mode-tab-stop-char)  
781                       (put-text-property        ;; Show inactive areas.
782                        i (1+ i)        (put-text-property 0 lsb   'face 'ruler-mode-pad-face ruler)
783                        'face (cond        (put-text-property j fullw 'face 'ruler-mode-pad-face ruler)
                              ;; Don't override the *-column face  
                              ((eq ts fill-column)  
                               'ruler-mode-fill-column-face)  
                              ((eq ts comment-column)  
                               'ruler-mode-comment-column-face)  
                              ((eq ts goal-column)  
                               'ruler-mode-goal-column-face)  
                              (t  
                               'ruler-mode-tab-stop-face))  
                       ruler)))))  
   
         ;; Show the `current-column' marker.  
         (setq i (- (current-column) o))  
         (and (>= i 0) (< i r)  
              (aset ruler i ruler-mode-current-column-char)  
              (put-text-property  
               i (1+ i) 'face 'ruler-mode-current-column-face  
               ruler))  
784    
785          ruler)))        ;; Return the ruler propertized string.
786          ruler)))
787    
788  (provide 'ruler-mode)  (provide 'ruler-mode)
789    
# Line 784  mouse-2: unset goal column" Line 791  mouse-2: unset goal column"
791  ;; coding: iso-latin-1  ;; coding: iso-latin-1
792  ;; End:  ;; End:
793    
794    ;;; arch-tag: b2f24546-5605-44c4-b67b-c9a4eeba3ee8
795  ;;; ruler-mode.el ends here  ;;; ruler-mode.el ends here

Legend:
Removed from v.1.7.2.1  
changed lines
  Added in v.1.7.2.2

savannah-hackers-public@gnu.org
ViewVC Help
Powered by ViewVC 1.1.26