@@ 247,38 247,73 @@ prev, not to prev+tab."
(setq electric-indent-inhibit t)))
-(defcustom wisp--bg-colors
+(defcustom wisp--brighter-colors
+ '(
+ "#DDDDDD" "#eeeeee"
+ "#BBCCEE" "#ccddff"
+ "#CCEEFF" "#ddf3ff"
+ "#CCDDAA" "#ddeebb"
+ "#EEEEBB" "#ffffcc"
+ "#FFCCCC" "#ffdddd"
+ "#BCCCEE" "#cdddff"
+ "#CDEEFF" "#def3ff"
+ "#CDDDAA" "#deeebb"
+ "#EFEEBB" "#ffffcd"
+ "#FFCDCC" "#ffdedd"
+ "#BBCDEE" "#ccdeff"
+ "#CCEFFF" "#ddf5ff"
+ "#CCDEAA" "#ddefbb"
+ "#EEEFBB" "#ffffce"
+ "#FFCCCD" "#ffddde"
+ "#BBCCEF" "#ccdfff"
+ "#CDEFFF" "#def3ff"
+ "#CCDDAB" "#ddeebc"
+ "#EEEEBC" "#ffffcf"
+ "#FFCDCD" "#ffdede"
+ "#BCCDEE" "#cddeff"
+ "#CDEFFF" "#def5ff"
+ "#CDDEAA" "#deefbb"
+ "#EFEFBB" "#ffffd0"
+ "#FFCECD" "#ffdede"
+ )
+ "Highlight-colors for the current level: First the matching color then the replacement."
:group 'wisp
- '( ;; paul tol's pale scheme
- "#DDDDDD" ;; -1: . foo at toplevel
- "#BBCCEE"
- "#CCEEFF"
- "#CCDDAA"
- "#EEEEBB"
- "#FFCCCC"
- "#BBCCEE"
- "#CCEEFF"
- "#CCDDAA"
- "#EEEEBB"
- "#FFCCCC"
- "#BBCCEE"
- "#CCEEFF"
- "#CCDDAA"
- "#EEEEBB"
- "#FFCCCC"
- "#BBCCEE"
- "#CCEEFF"
- "#CCDDAA"
- "#EEEEBB"
- "#FFCCCC"
- "#BBCCEE"
- "#CCEEFF"
- "#CCDDAA"
- "#EEEEBB"
- "#FFCCCC"
- ) "Background-colors to show the indentation."
- :group 'wisp
- :type 'list)
+ :type 'plist)
+
+(defcustom wisp--bg-colors
+ '( ;; paul tol's pale scheme, the cycled ones become slightly
+ ;; brighter to allow for identification of indentation level by
+ ;; color.
+ "#DDDDDD" ;; -1: . foo at toplevel
+ "#BBCCEE"
+ "#CCEEFF"
+ "#CCDDAA"
+ "#EEEEBB"
+ "#FFCCCC"
+ "#BCCCEE"
+ "#CDEEFF"
+ "#CDDDAA"
+ "#EFEEBB"
+ "#FFCDCC"
+ "#BBCDEE"
+ "#CCEFFF"
+ "#CCDEAA"
+ "#EEEFBB"
+ "#FFCCCD"
+ "#BBCCEF"
+ "#CDEFFF"
+ "#CCDDAB"
+ "#EEEEBC"
+ "#FFCDCD"
+ "#BCCDEE"
+ "#CDEFFF"
+ "#CDDEAA"
+ "#EFEFBB"
+ "#FFCECD"
+ )
+ "Background-colors to show the indentation."
+ :group 'wisp
+ :type 'list)
(defun wisp--add-indentation-levels-before (indent levels)
"Add the indentation level with INDENT or less to the LEVELS."
@@ 294,23 329,68 @@ prev, not to prev+tab."
"Overlays set by wisp indentation highlighting in the current
buffer.")
+(defvar-local wisp--current-wisp-highlight-overlays-at-point '()
+ "The overlay the point was in in the last time the
+ wisp--highlight-current-indentation-level was called.")
+
+(defvar-local wisp--original-colors-dynamic '()
+ "The inverse of wisp--brighter-colors: the original-colors
+ mapped too the brighter ones, filled when colors are
+ replaced.")
+
+(defvar-local wisp--current-highlight-brighter-color nil
+ "The color of currently highlighted overlays.")
+
+
(defun wisp--highlight-indentation (&optional begin end length)
"Colorize a buffer or the region between BEGIN and END up to LENGTH."
(interactive)
(wisp--highlight-indentation-region (point-min) (point-max)))
-
-(defun wisp--highlight-indentation-region (&optional begin end length)
- "Colorize a buffer or the region between BEGIN and END up to LENGTH."
- (interactive "r")
- (let (
- (begin (if (not begin)
+(defun wisp--find-begin-and-end-of-block-around-region (begin end)
+ "Search around the current region and return the wisp-block around it."
+ (let ((begin (if (not begin)
(point-min)
begin))
(end (if (not end)
(point-max)
end)))
(save-mark-and-excursion
+ (goto-char begin)
+ (backward-paragraph)
+ (setq begin (point))
+ (goto-char end)
+ (forward-paragraph)
+ (setq end (point))
+ (goto-char begin))
+ (cons begin end)))
+
+(defun wisp--find-begin-and-end-of-lines-with-same-indentation (position)
+ "Search around the current region and return the wisp-block around it."
+ (save-mark-and-excursion
+ (let* ((begin (if (not position)
+ (point)
+ position))
+ (end begin))
+ (goto-char position)
+ (let ((indentation (wisp--current-indent)))
+ (while (and (> (point) (point-min)) (equal indentation (wisp--current-indent)))
+ (setq begin (point-at-bol))
+ (forward-line -1))
+ (forward-line 1)
+ (while (and (< (point) (point-max)) (equal indentation (wisp--current-indent)))
+ (setq end (point-at-eol))
+ (forward-line 1))
+ (cons begin end)))))
+
+
+(defun wisp--highlight-indentation-region (&optional begin end length)
+ "Colorize a buffer or the region between BEGIN and END up to LENGTH."
+ (interactive "r")
+ (let* ((region (wisp--find-begin-and-end-of-block-around-region begin end))
+ (begin (car region))
+ (end (cdr region)))
+ (save-mark-and-excursion
(with-silent-modifications
;; change all affected blocks
(goto-char begin)
@@ 362,7 442,10 @@ prev, not to prev+tab."
(overlay-put overlay
'face
`(:background
- ,(nth level wisp--bg-colors)))))
+ ,(nth level wisp--bg-colors)))
+ (overlay-put overlay
+ 'priority
+ level)))
(forward-char 1))))
(forward-line 1))))))))
@@ 375,7 458,99 @@ prev, not to prev+tab."
(progn
(wisp--highlight-indentation)
(add-hook 'after-change-functions 'wisp--highlight-indentation-region nil t))
- (remove-hook 'after-change-functions 'wisp--highlight-indentation-region t)))
+ (progn
+ (mapc 'delete-overlay wisp--highlight-indentation-overlays)
+ (mapc (lambda (o) (pop wisp--highlight-indentation-overlays))
+ wisp--highlight-indentation-overlays)
+ (remove-hook 'after-change-functions 'wisp--highlight-indentation-region t))))
+
+;;;###autoload
+(define-minor-mode wisp-color-highlight-current-indentation-minor-mode
+ "Mode to colorize the indentation level according to wisp-semanttics."
+ nil nil nil
+ :group 'wisp
+ :after-hook (if wisp-color-highlight-current-indentation-minor-mode
+ (progn
+ (wisp-color-indentation-minor-mode t)
+ (add-hook 'post-command-hook 'wisp--highlight-current-indentation-level nil t))
+ (progn
+ (remove-hook 'post-command-hook 'wisp--highlight-current-indentation-level))))
+
+
+(defun wisp--highlight-overlay-color (overlay)
+ "Replace the background color of the OVERLAY with a lighter color from wisp--brighter-colors."
+ (let ((color (plist-get (plist-get (overlay-properties overlay) 'face) :background)))
+ (let ((new-color (lax-plist-get wisp--brighter-colors color)))
+ (when new-color
+ (unless (lax-plist-get wisp--original-colors-dynamic new-color)
+ (setq wisp--original-colors-dynamic
+ (lax-plist-put wisp--original-colors-dynamic new-color color)))
+ (setq wisp--current-highlight-brighter-color new-color)
+ (overlay-put overlay 'face `(:background ,new-color))))))
+
+(defun wisp--overlay-background-color (overlay)
+ (plist-get (plist-get (overlay-properties overlay) 'face) :background))
+
+(defun wisp--restore-overlay-color (overlay)
+ "Replace the background color of the OVERLAY with its original color from wisp--brighter-colors."
+ (let ((color (wisp--overlay-background-color overlay)))
+ (let ((original-color (lax-plist-get wisp--original-colors-dynamic color)))
+ (when original-color
+ (overlay-put overlay 'face `(:background ,original-color))))))
+
+(defun wisp--highlight-current-indentation-level ()
+ "Highlight the current indentation level by using a brighter color.
+
+If the var wisp--brighter-colors defines a color for the current
+color of the overlay, the mapped color is set instead."
+ (interactive)
+ (with-silent-modifications
+ (let* ((overlays-with-bg-at-point
+ (remove-if-not
+ (lambda (overlay)
+ (let ((color (wisp--overlay-background-color overlay)))
+ (or (lax-plist-get wisp--brighter-colors color)
+ (lax-plist-get wisp--original-colors-dynamic color))))
+ (overlays-at (point) t)))
+ (wisp-overlay-at-point
+ (if overlays-with-bg-at-point
+ (list (car overlays-with-bg-at-point))
+ (list)))
+ (highlighted-overlays (mapc 'wisp--highlight-overlay-color wisp-overlay-at-point))
+ (region (wisp--find-begin-and-end-of-block-around-region (point) (point)))
+ (begin (car region))
+ (end (cdr region))
+ (overlays-in-region (overlays-in begin end))
+ (current-highlighting-color
+ (lax-plist-get wisp--original-colors-dynamic
+ wisp--current-highlight-brighter-color))
+ (overlays-with-same-color
+ (remove-if-not
+ (lambda (overlay)
+ (equalp current-highlighting-color
+ (wisp--overlay-background-color overlay)))
+ overlays-in-region))
+ (removed-overlays
+ (remove-if
+ (lambda (overlay)
+ (equalp wisp--current-highlight-brighter-color
+ (wisp--overlay-background-color overlay)))
+ wisp--current-wisp-highlight-overlays-at-point)))
+ ;; restore all no longer highlighted overlays
+ (mapc 'wisp--restore-overlay-color removed-overlays)
+ ;; remember all highlighted overlays
+ (setq wisp--current-wisp-highlight-overlays-at-point
+ (delete-dups
+ (append
+ wisp--current-wisp-highlight-overlays-at-point
+ highlighted-overlays
+ (mapc 'wisp--highlight-overlay-color overlays-with-same-color))))
+ ;; remove no longer highlighted overlays
+ (dolist (overlay removed-overlays)
+ (setq wisp--current-wisp-highlight-overlays-at-point
+ (delq overlay wisp--current-wisp-highlight-overlays-at-point))))))
+
+;; (add-hook 'post-command-hook 'wisp--highlight-current-indentation-level nil t)
(provide 'wisp-mode)