comment-column and goal-column supports to ruler-mode.el

[Masatake YAMATO]

Hi,

I've added comment-column and goal-column supports to ruler-mode.el.
Could you evaluate my patch? I'm happy if my patch is merged into the
official source tree.

What I changed and added are:
- setting fill-column with dragging `¶' on the ruler, 
- setting comment-column with dragging `#' on the ruler,
- setting goal-column with dragging `G' on the ruler(when goal-column is 
non-nil value),
- unsetting goal-column with clicking G  on the ruler and
- setting goal-column with clicking any place on the ruler (when goal-column is 
nil).

regards,
Masatake YAMATO

2003-01-10  Masatake YAMATO  <address@hidden>

        * ruler-mode.el
        (ruler-mode-comment-column-char, ruler-mode-goal-column-char): New 
variables.
        (ruler-mode-ding-when-goal-column-is-set): New variable.
        (ruler-mode-comment-column-face, ruler-mode-goal-column-face): New 
faces.
        (ruler-mode-mouse-set-fill-column): removed.
        (ruler-mode-mouse-current-grab-object): New variable.
        (ruler-mode-mouse-grab-any-column)
        (ruler-mode-mouse-drag-any-column-iteration) 
        (ruler-mode-mouse-drag-any-column): New functions.
        (ruler-mode-map): bound ruler-mode-mouse-grab-any-column to
        [header-line down-mouse-2] instead of ruler-mode-mouse-set-fill-column.
        (ruler-mode-ruler-help-echo): Updated its value.
        (ruler-mode-ruler-help-echo-no-goal-column): New help string
        used when goal-column is already set.
        (ruler-mode-ruler-help-echo-fill-column) 
        (ruler-mode-ruler-help-echo-comment-column) 
        (ruler-mode-ruler-help-echo-goal-column): New help strings.
        (ruler-mode-ruler): Use ruler-mode-ruler-help-echo-no-goal-column
        instead of ruler-mode-ruler-help-echo if goal-column is set.
        Show goal-column and goal-column. Echo the different help string for 
        each *-column characters on the ruler.  

Index: ruler-mode.el
===================================================================
RCS file: /cvsroot/emacs/emacs/lisp/ruler-mode.el,v
retrieving revision 1.9
diff -u -r1.9 ruler-mode.el
--- ruler-mode.el       12 Sep 2002 03:21:21 -0000      1.9
+++ ruler-mode.el       9 Jan 2003 17:32:34 -0000
@@ -30,8 +30,8 @@
 ;; This library provides a minor mode to display a ruler in the header
 ;; line.  It works only on Emacs 21.
 ;;
-;; You can use the mouse to change the `fill-column', `window-margins'
-;; and `tab-stop-list' settings:
+;; You can use the mouse to change the `fill-column' `comment-column', 
+;; `goal-column', `window-margins' and `tab-stop-list' settings:
 ;;
 ;; [header-line (shift down-mouse-1)] set left margin to the ruler
 ;; graduation where the mouse pointer is on.
@@ -39,8 +39,8 @@
 ;; [header-line (shift down-mouse-3)] set right margin to the ruler
 ;; graduation where the mouse pointer is on.
 ;;
-;; [header-line down-mouse-2] set `fill-column' to the ruler
-;; graduation where the mouse pointer is on.
+;; [header-line down-mouse-2] set `fill-column', `comment-column' or 
+;; `goal-column' to the ruler graduation with the mouse dragging.
 ;;
 ;; [header-line (control down-mouse-1)] add a tab stop to the ruler
 ;; graduation where the mouse pointer is on.
@@ -55,7 +55,9 @@
 ;;
 ;; In the ruler the character `ruler-mode-current-column-char' shows
 ;; the `current-column' location, `ruler-mode-fill-column-char' shows
-;; the `fill-column' location and `ruler-mode-tab-stop-char' shows tab
+;; the `fill-column' location, `ruler-mode-comment-column-char' shows
+;; the `comment-column' location, `ruler-mode-goal-column-char' shows
+;; the `goal-column' and `ruler-mode-tab-stop-char' shows tab
 ;; stop locations.  `window-margins' areas are shown with a different
 ;; background color.
 ;;
@@ -73,6 +75,10 @@
 ;; - `ruler-mode-default-face' the ruler default face.
 ;; - `ruler-mode-fill-column-face' the face used to highlight the
 ;;   `fill-column' character.
+;; - `ruler-mode-comment-column-face' the face used to highlight the
+;;   `comment-column' character.
+;; - `ruler-mode-goal-column-face' the face used to highlight the
+;;   `goal-column' character.
 ;; - `ruler-mode-current-column-face' the face used to highlight the
 ;;   `current-column' character.
 ;; - `ruler-mode-tab-stop-face' the face used to highlight tab stop
@@ -139,6 +145,22 @@
           (integer :tag "Integer char value"
                    :validate ruler-mode-character-validate)))
 
+(defcustom ruler-mode-comment-column-char ?\#
+  "*Character used at the `comment-column' location."
+  :group 'ruler-mode
+  :type '(choice
+          (character :tag "Character")
+          (integer :tag "Integer char value"
+                   :validate ruler-mode-character-validate)))
+
+(defcustom ruler-mode-goal-column-char ?G
+  "*Character used at the `goal-column' location."
+  :group 'ruler-mode
+  :type '(choice
+          (character :tag "Character")
+          (integer :tag "Integer char value"
+                   :validate ruler-mode-character-validate)))
+
 (defcustom ruler-mode-current-column-char (if window-system
                                               ?\ヲ
                                             ?\@)
@@ -180,6 +202,12 @@
           (character :tag "Character")
           (integer :tag "Integer char value"
                    :validate ruler-mode-character-validate)))
+
+(defcustom ruler-mode-ding-when-goal-column-is-set t
+  "*Non-nil means do `ding' when goal-column is set in ruler operation."
+  :group 'ruler-mode
+  :type 'boolean)
+
 
 (defface ruler-mode-default-face
   '((((type tty))
@@ -214,6 +242,22 @@
   "Face used to highlight the fill column character."
   :group 'ruler-mode)
 
+(defface ruler-mode-comment-column-face
+  '((t
+     (:inherit ruler-mode-default-face
+               :foreground "red"
+               )))
+  "Face used to highlight the comment column character."
+  :group 'ruler-mode)
+
+(defface ruler-mode-goal-column-face
+  '((t
+     (:inherit ruler-mode-default-face
+               :foreground "red"
+               )))
+  "Face used to highlight the goal column character."
+  :group 'ruler-mode)
+
 (defface ruler-mode-tab-stop-face
   '((t
      (:inherit ruler-mode-default-face
@@ -281,27 +325,118 @@
           (message "Right margin set to %d (was %d)" rm rm0)
           (set-window-margins nil lm rm)))))
 
-(defun ruler-mode-mouse-set-fill-column (start-event)
-  "Set `fill-column' to the graduation where the mouse pointer is on.
-START-EVENT is the mouse click event."
+(defvar ruler-mode-mouse-current-grab-object nil
+  " column symbol dragged in the ruler.
+`fill-column', `comment-column' or `goal-column' are valid value.
+If nothing is dragged,  nil is set.")
+
+(defun ruler-mode-mouse-grab-any-column (start-event)
+  "Set `fill-column', `comment-column' or `goal-column' to the graduation with 
mouse dragging.
+START-EVENT is the mouse down event."
   (interactive "e")
+  (setq ruler-mode-mouse-current-grab-object nil)
+  (let* ((start (event-start start-event)) 
+         m col w lm rm hs newc oldc)
+    (save-selected-window
+      (select-window (posn-window start))
+      (setq m   (window-margins)
+           lm  (or (car m) 0)
+           rm  (or (cdr m) 0)
+           col (- (car (posn-col-row start)) lm)
+           w   (window-width)
+           hs  (window-hscroll)
+           newc  (+ col hs))
+      ;;
+      ;; About the ways to handle the goal column:
+      ;; A. update the value of the goal column if goal-column has non-nil 
+      ;;    value and if the mouse is dragged
+      ;; B. set value to the goal column if goal-column has nil and if the 
+      ;;    mouse is just clicked, not dragged.
+      ;; C. unset value to the goal column if goal-column has non-nil and 
+      ;;    mouse is just clicked on goal-column character on the ruler, 
+      ;;    not dragged.
+      ;;
+      (and (>= col 0) (< (+ col lm rm) w)
+          (cond 
+           ((eq newc fill-column)
+            (setq oldc fill-column)
+            (setq ruler-mode-mouse-current-grab-object 'fill-column)
+            t)
+           ((eq newc comment-column)
+            (setq oldc comment-column)
+            (setq ruler-mode-mouse-current-grab-object 'comment-column)
+            t)
+           ((eq newc goal-column)      ; A. update goal column
+            (setq oldc goal-column)
+            (setq ruler-mode-mouse-current-grab-object 'goal-column)
+            t)
+           ((null goal-column)         ; B. set goal column
+            (setq oldc goal-column)
+            (setq goal-column newc)
+            ;; mouse-2 coming AFTER drag-mouse-2 invokes `ding'.
+            ;; This `ding' flushes the next messages about setting 
+            ;; goal column. So here I force fetch the event(mouse-2)
+            ;; and throw away.
+            (read-event) 
+            ;; Ding BEFORE `message' is OK.
+            (if ruler-mode-ding-when-goal-column-is-set
+                (ding))
+            (message 
+             "Goal column %d (click `%s' on the ruler again to unset it)" 
+             newc 
+             (propertize (char-to-string ruler-mode-goal-column-char)
+                         'face 'ruler-mode-goal-column-face))
+            ;; don't enter drag iteration
+            nil))
+          (if (eq 'click (ruler-mode-mouse-drag-any-column-iteration 
+                          (posn-window start)))
+              (if (eq 'goal-column ruler-mode-mouse-current-grab-object)
+                  ;; C. unset goal column
+                  (set-goal-column t))
+            ;; *-column is updated; report it
+            (message "%s is set to %d (was %d)" 
+                     ruler-mode-mouse-current-grab-object
+                     (eval ruler-mode-mouse-current-grab-object)
+                     oldc))))))
+
+(defun ruler-mode-mouse-drag-any-column-iteration (window)
+  "Update the ruler while dragging the mouse.
+WINDOW is the window where the last down-mouse event is occurred.
+Return a symbol `drag' if the mouse is actually dragged.
+Return a symbol `click' if the mouse is just clicked."
+  (let (newevent 
+       (drag-count 0))
+    (track-mouse 
+      (while (progn 
+              (setq newevent (read-event))
+              (mouse-movement-p newevent))
+       (setq drag-count (1+ drag-count))
+       (if (eq window (posn-window (event-end newevent)))
+           (progn 
+             (ruler-mode-mouse-drag-any-column newevent)
+             (force-mode-line-update)))))
+    (if (and (eq drag-count 0) 
+            (eq 'click (car (event-modifiers newevent))))
+       'click
+      'drag)))
+
+(defun ruler-mode-mouse-drag-any-column (start-event)
+  "Update the ruler for START-EVENT, one mouse motion event."
   (let* ((start (event-start start-event))
          (end   (event-end   start-event))
-         m col w lm rm hs fc)
-    (if (eq start end) ;; mouse click
-        (save-selected-window
-          (select-window (posn-window start))
-          (setq m   (window-margins)
-                lm  (or (car m) 0)
-                rm  (or (cdr m) 0)
-                col (- (car (posn-col-row start)) lm)
-                w   (window-width)
-                hs  (window-hscroll)
-                fc  (+ col hs))
-          (and (>= col 0) (< (+ col lm rm) w)
-               (progn
-                 (message "Fill column set to %d (was %d)" fc fill-column)
-                 (setq fill-column fc)))))))
+         m col w lm rm hs newc)
+    (save-selected-window
+      (select-window (posn-window start))
+      (setq m   (window-margins)
+           lm  (or (car m) 0)
+           rm  (or (cdr m) 0)
+           col (- (car (posn-col-row end)) lm)
+           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)))))
+
 
 (defun ruler-mode-mouse-add-tab-stop (start-event)
   "Add a tab stop to the graduation where the mouse pointer is on.
@@ -367,7 +502,7 @@
     (define-key km [header-line down-mouse-3]
       #'ignore)
     (define-key km [header-line down-mouse-2]
-      #'ruler-mode-mouse-set-fill-column)
+      #'ruler-mode-mouse-grab-any-column)
     (define-key km [header-line (shift down-mouse-1)]
       #'ruler-mode-mouse-set-left-margin)
     (define-key km [header-line (shift down-mouse-3)]
@@ -418,11 +553,32 @@
 (defconst ruler-mode-ruler-help-echo
   "\
 S-mouse-1/3: set L/R margin, \
-mouse-2: set fill col, \
+mouse-2: set goal column, \
 C-mouse-2: show tabs"
   "Help string shown when mouse pointer is over the ruler.
 `ruler-mode-show-tab-stops' is nil.")
 
+(defconst ruler-mode-ruler-help-echo-no-goal-column
+  "\
+S-mouse-1/3: set L/R margin, \
+C-mouse-2: show tabs"
+  "Help string shown when mouse pointer is over the ruler and when goal-column 
is set.
+`ruler-mode-show-tab-stops' is nil.")
+
+(defconst ruler-mode-ruler-help-echo-fill-column
+  "drag-mouse-2: set fill column"
+  "Help string shown when mouse pointer is over fill column character on the 
ruler.")
+
+(defconst ruler-mode-ruler-help-echo-comment-column
+  "drag-mouse-2: set comment column"
+  "Help string shown when mouse pointer is over comment column character on 
the ruler.")
+
+(defconst ruler-mode-ruler-help-echo-goal-column
+  "\
+drag-mouse-2: set goal column, \
+mouse-2: unset goal column"
+  "Help string shown when mouse pointer is over goal column character on the 
ruler.")
+
 (defconst ruler-mode-ruler-help-echo-tab
   "\
 C-mouse1/3: set/unset tab, \
@@ -494,7 +650,9 @@
                            'help-echo 
                            (if ruler-mode-show-tab-stops
                                ruler-mode-ruler-help-echo-tab
-                             ruler-mode-ruler-help-echo)
+                            (if goal-column
+                                ruler-mode-ruler-help-echo-no-goal-column
+                              ruler-mode-ruler-help-echo))
                            ruler)
         ;; Setup the local map.
         (put-text-property 0 (length ruler)
@@ -546,15 +704,45 @@
         (while (< i (length ruler))
           (aset ruler i ruler-mode-margins-char)
           (setq i (1+ i)))
-         
+       
+       ;; Show the `goal-column' marker.
+       (if goal-column
+           (progn 
+             (setq i (- goal-column o))
+             (and (>= i 0) (< i r)
+                  (aset ruler i ruler-mode-goal-column-char)
+                  (progn 
+                    (put-text-property
+                     i (1+ i) 'face 'ruler-mode-goal-column-face
+                     ruler)
+                    (put-text-property
+                     i (1+ i) 'help-echo ruler-mode-ruler-help-echo-goal-column
+                     ruler))
+                  )))
+
+       ;; Show the `comment-column' marker.
+       (setq i (- comment-column o))
+       (and (>= i 0) (< i r)
+             (aset ruler i ruler-mode-comment-column-char)
+            (progn
+              (put-text-property
+               i (1+ i) 'face 'ruler-mode-comment-column-face
+               ruler)
+              (put-text-property
+               i (1+ i) 'help-echo ruler-mode-ruler-help-echo-comment-column
+               ruler)))
+       
         ;; Show the `fill-column' marker.
         (setq i (- fill-column o))
         (and (>= i 0) (< i r)
              (aset ruler i ruler-mode-fill-column-char)
-             (put-text-property
-              i (1+ i) 'face 'ruler-mode-fill-column-face
-              ruler))
-
+             (progn (put-text-property
+                    i (1+ i) 'face 'ruler-mode-fill-column-face
+                    ruler)
+                   (put-text-property
+                    i (1+ i) 'help-echo ruler-mode-ruler-help-echo-fill-column
+                    ruler)))
+       
         ;; Show the `tab-stop-list' markers.
         (if ruler-mode-show-tab-stops
             (let ((tsl tab-stop-list) ts)
@@ -567,9 +755,13 @@
                      (put-text-property
                       i (1+ i)
                       'face (cond
-                             ;; Don't override the fill-column face
+                             ;; 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)))))