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)))))