Download
(defgroup popup-ruler nil
"Major mode for editing Tandem DDL source files in Emacs."
:group 'convenience
)
(defun popup-ruler (arg)
"Temporarily display a ruler with `momentary' face above the current line.
With \\[universal-argument] prefix argument, make the ruler measure in both
directions from point. Use \\[universal-argument] \\[universal-argument] for
quoted text. The ruler then skips the quote character when measuring."
(interactive "P")
(momentary-string-display
(cond
((null arg)
(let* ((right-len (+ (window-hscroll)(window-width) -1))
(right (popup-ruler-l-r right-len)))
(concat (cadr right) "\n"
(car right) "\n")))
((if (listp arg) (< 4 (car arg))(= 0 arg))
(let* ((left-len (1- (current-column)))
(right-len (- (+ (window-hscroll)(window-width)) 3 left-len))
(left (popup-ruler-r-l left-len))
(right (popup-ruler-l-r right-len)))
(concat (cadr left) (make-string 2 ? ) (cadr right) "\n"
(car left) (make-string 2 ? ) (car right) "\n")))
(t (let* ((left-len (current-column))
(right-len (- (+ (window-hscroll)(window-width)) 1 left-len))
(left (popup-ruler-r-l left-len))
(right (popup-ruler-l-r right-len)))
(concat (cadr left) (cadr right) "\n"
(car left) (car right) "\n"))))
(line-beginning-position)
nil "[space] Clears ruler"))
(defcustom popup-ruler-vertical-interval 1
"Puts numbers on a vertical ruler only at this interval.
1 is the default which means every line. 5 would mean every N mod 5 line.
Line number 1 is always marked explicitly regardless of this value."
:group 'popup-ruler
)
(defun popup-ruler-vertical (arg)
"Temporarily display a vertical ruler in the `current-column'.
With \\[universal-argument] prefix argument, make the ruler measure in both
directions from point. Use \\[universal-argument] \\[universal-argument] to
make the ruler start at zero rather than one."
(interactive "P")
(popup-ruler-momentary-column
(popup-ruler-strings
(cond
((null arg) 'top-1)
((if (listp arg) (< 4 (car arg))(= 0 arg)) 'point-0)
(t 'point-1)))
(current-column))(sit-for 0)(message nil))
(defun popup-ruler-r-l (len)
"Returns right to left running ruler of length LEN.
Result is a list of 2 strings, markers and counters."
(let* ((iterations (/ (1- (abs len)) 10))
(short (- (* 10 (1+ iterations)) (abs len)))
(result1 "|....|...|")
(result2 "10 5 1")
(inc1 "|....|....")
(inc2 "%d0 ")
(i 1))
(while (<= i iterations)
(setq i (1+ i))
(setq result1 (concat inc1 result1))
(setq result2 (concat (substring (format inc2 i) 0 10) result2)))
(list (substring result1 short) (substring result2 short))))
(defun popup-ruler-l-r (len)
"Returns left to right running ruler of length LEN.
Result is a list of 2 strings; markers and counters."
(let* ((iterations (/ (1- (abs len)) 10))
(result1 "|...|....|")
(result2 "1 5 10")
(inc1 "....|....|")
(inc2 " %d0")
(i 1))
(while (<= i iterations)
(setq i (1+ i))
(setq result1 (concat result1 inc1))
(setq result2 (concat result2 (substring (format inc2 i) -10))))
(list (substring result1 0 len) (substring result2 0 len))))
(defun popup-ruler-window-position (&optional visible)
"Returns the cons (screen-line . screen-column) of point.
When VISIBLE is non-nil a screen-column of 0 is returned when a negative
value would otherwise be returned such as after (scroll-left).
nil is returned if current-buffer is not in the current window."
(if (eq (current-buffer) (window-buffer))
(if (or truncate-lines (/= 0 (window-hscroll)))
(let ((window-column (- (current-column)(window-hscroll)))
(window-line (count-lines (window-start)(point))))
(cond
((= 0 (current-column))
(cons window-line (if visible 0 window-column)))
((<= (current-column) (window-hscroll))
(cons (1- window-line) (if visible 0 window-column)))
(t (cons (1- window-line) window-column))))
(let ((window-column (% (current-column)(window-width)))
(window-line (count-screen-lines (window-start)(point))))
(if (= 0 window-column)
(cons window-line window-column)
(cons (1- window-line) window-column))))))
(defun popup-ruler-strings ( type )
"Return a list of strings that form a vertical ruler.
The ruler is intended to run from the top of the screen to the bottom so
there are (window-height) strings. When counter originates at point or
mark the numbering increments in both directions from that line. This
does not yet support generating strings for wrapped lines.
Supported types are:
'top-1 Numbering starts at the top of the screen
'bottom-1 Numbering starts at the bottom of the screen
'point-1 The line containing point is number 1
'point-0 The line containing point is number 0
'mark-1 The line containing mark is numbered 1
'mark-0 The line containing mark is numbered 0
"
(if (or truncate-lines (/= 0 (window-hscroll)))
(let* ((position (popup-ruler-window-position t))
(row (car position))
(col (cdr position))
(start 1)
(mid (1+ row))
(end (1- (window-height)))
(width (length (number-to-string (max start end mid))))
ruler-list)
(cond
((eq type 'top-1)
(popup-ruler-make-strings
start end popup-ruler-vertical-interval width))
((eq type 'bottom-1)
(popup-ruler-make-strings
end start popup-ruler-vertical-interval width))
((eq type 'point-1)
(append (popup-ruler-make-strings
mid 1
popup-ruler-vertical-interval width)
(popup-ruler-make-strings
2 (1- end) popup-ruler-vertical-interval width)))
((eq type 'point-0)
(append (popup-ruler-make-strings
(1- mid) 0 popup-ruler-vertical-interval width)
(popup-ruler-make-strings
1 (- end 2) popup-ruler-vertical-interval width)))
((eq type 'mark-1)
(append (popup-ruler-make-strings
(1- mid) 0 popup-ruler-vertical-interval width)
(popup-ruler-make-strings
1 (- end 2) popup-ruler-vertical-interval width)))
(t (error "popup-ruler-strings - unsupported type `%s'" type))))
(error "popup-ruler-strings - unsupported window configuration")))
(defun popup-ruler-make-strings ( start end interval width )
"Return a list of strings that form a vertical ruler.
Numbering of the strings runs from START thru END where strings not a
multiple of INTERVAL do not contain numbers. The exception being that a
string numbered 1 is always numbered."
(let* ((fmt (concat "|-%" (number-to-string width) "d-|"))
(spacer (concat "|-" (make-string width ? ) "-|"))
(increment (if (> start end) -1 1))
(done nil)
ruler-list)
(while (not done)
(if (or (= start 1) (= 0 (% start interval)))
(push (format fmt start) ruler-list)
(push spacer ruler-list))
(setq done (= start end))
(setq start (+ increment start)))
(reverse ruler-list)))
(defun popup-ruler-momentary-column (string-list col)
"Momentarily display STRING-LIST in the current buffer at COL.
The strings in STRING-LIST cannot contain \\n.
They are displayed in `momentary' face, which is customizable.
Starting at the top of the display each string in the list is displayed
on subsequent lines at column COL until one of the following is reached:
the last string in STRING-LIST, the bottom of the display, the last line
in the buffer.
Display remains until next event is input."
(let ((count (window-height))
(loc (count-lines (window-start)(point)))
overlay-list
this-overlay
buffer-file-name)
(goto-char (window-start))
(temporary-invisible-change
(unwind-protect
(progn
(while (and string-list (> count 0))
(move-to-column col t)
(setq this-overlay (make-overlay (point) (point) nil t))
(setq overlay-list (cons this-overlay overlay-list))
(overlay-put this-overlay 'before-string
(propertize (pop string-list) 'face 'momentary))
(forward-line)
(if (< (point)(point-max))
(setq count (1- count))
(setq count -1)))
(goto-char (window-start))
(if (= col 0)(forward-line loc)
(forward-line (1- loc))
(move-to-column col))
(read-key-sequence-vector "Any event removes ruler.")())
(while overlay-list
(delete-overlay (prog1 (car overlay-list)
(setq overlay-list (cdr overlay-list)))))))))
(defmacro temporary-invisible-change (&rest forms)
"Executes FORMS with a temporary buffer-undo-list, undoing on return.
The changes you make within FORMS are undone before returning.
But more importantly, the buffer's buffer-undo-list is not affected.
This macro allows you to temporarily modify read-only buffers too.
Always return nil"
`(let* ((buffer-undo-list)
(modified (buffer-modified-p))
(inhibit-read-only t))
(save-excursion
(unwind-protect
(progn ,@forms)
(primitive-undo (length buffer-undo-list) buffer-undo-list)
(set-buffer-modified-p modified))) ()))
(provide 'popup-ruler)