chiark / gitweb /
el/dot-emacs.el: Overhaul the point-overlay stuff.
authorMark Wooding <mdw@distorted.org.uk>
Tue, 1 Aug 2017 11:41:34 +0000 (12:41 +0100)
committerMark Wooding <mdw@distorted.org.uk>
Tue, 1 Aug 2017 11:41:34 +0000 (12:41 +0100)
  * Make it capable of displaying a marker in both fringes, and turn
    this on by default.

  * Drop the overlay over the whole line, not just at point.  This
    actually simplifies the positioning code because it doesn't have to
    special-case point at the beginning of the line any more.

  * Lower the overlay priority so that the transient region is still
    visible.

  * Set a face in the overlay so that the line stands out on terminals
    which can't display fringes.

  * Sink the code until after the face machinery, so that we can use it
    for setting the default face.

el/dot-emacs.el

index 5d252ebefd1de423b1c307e849be7f1f6477a3c5..b7309246510d66f5713c6f5696b04004171a23f1 100644 (file)
@@ -1131,62 +1131,6 @@ (defun mdw-last-one-out-turn-off-the-lights (frame)
       (run-with-idle-timer 0 nil #'x-close-connection frame-display))))
 (add-hook 'delete-frame-functions 'mdw-last-one-out-turn-off-the-lights)
 
-;;;--------------------------------------------------------------------------
-;;; Where is point?
-
-(defvar mdw-point-overlay
-  (let ((ov (make-overlay 0 0))
-       (s "."))
-    (overlay-put ov 'priority 2)
-    (put-text-property 0 1 'display '(left-fringe vertical-bar) s)
-    (overlay-put ov 'before-string s)
-    (delete-overlay ov)
-    ov)
-  "An overlay used for showing where point is in the selected window.")
-
-(defun mdw-remove-point-overlay ()
-  "Remove the current-point overlay."
-  (delete-overlay mdw-point-overlay))
-
-(defun mdw-update-point-overlay ()
-  "Mark the current point position with an overlay."
-  (if (not mdw-point-overlay-mode)
-      (mdw-remove-point-overlay)
-    (overlay-put mdw-point-overlay 'window (selected-window))
-    (if (bolp)
-       (move-overlay mdw-point-overlay
-                     (point) (1+ (point)) (current-buffer))
-      (move-overlay mdw-point-overlay
-                   (1- (point)) (point) (current-buffer)))))
-
-(defvar mdw-point-overlay-buffers nil
-  "List of buffers using `mdw-point-overlay-mode'.")
-
-(define-minor-mode mdw-point-overlay-mode
-  "Indicate current line with an overlay."
-  :global nil
-  (let ((buffer (current-buffer)))
-    (setq mdw-point-overlay-buffers
-         (mapcan (lambda (buf)
-                   (if (and (buffer-live-p buf)
-                            (not (eq buf buffer)))
-                       (list buf)))
-                 mdw-point-overlay-buffers))
-    (if mdw-point-overlay-mode
-       (setq mdw-point-overlay-buffers
-             (cons buffer mdw-point-overlay-buffers))))
-  (cond (mdw-point-overlay-buffers
-        (add-hook 'pre-command-hook 'mdw-remove-point-overlay)
-        (add-hook 'post-command-hook 'mdw-update-point-overlay))
-       (t
-        (mdw-remove-point-overlay)
-        (remove-hook 'pre-command-hook 'mdw-remove-point-overlay)
-        (remove-hook 'post-command-hook 'mdw-update-point-overlay))))
-
-(define-globalized-minor-mode mdw-global-point-overlay-mode
-  mdw-point-overlay-mode
-  (lambda () (if (not (minibufferp)) (mdw-point-overlay-mode t))))
-
 ;;;--------------------------------------------------------------------------
 ;;; Fullscreen-ness.
 
@@ -1603,6 +1547,84 @@ (let ((dollar (make-glyph-code ?$ 'mdw-ellipsis-face))
                          (vector dot dot dot))
   (set-display-table-slot standard-display-table 5 bar))
 
+;;;--------------------------------------------------------------------------
+;;; Where is point?
+
+(mdw-define-face mdw-point-overlay
+  (((type x)))
+  (((min-colors 64)) :background "darkblue")
+  (((class color)) :background "blue")
+  (((type tty) (class mono)) :inverse-video t))
+
+(defvar mdw-point-overlay-fringe-display '(vertical-bar . vertical-bar))
+
+(defun mdw-configure-point-overlay ()
+  (let ((ov (make-overlay 0 0)))
+    (overlay-put ov 'priority 0)
+    (let* ((fringe (or mdw-point-overlay-fringe-display (cons nil nil)))
+          (left (car fringe)) (right (cdr fringe))
+          (s ""))
+      (when left
+       (let ((ss "."))
+         (put-text-property 0 1 'display `(left-fringe ,left) ss)
+         (setq s (concat s ss))))
+      (when right
+       (let ((ss "."))
+         (put-text-property 0 1 'display `(right-fringe ,right) ss)
+         (setq s (concat s ss))))
+      (when (or left right)
+       (overlay-put ov 'before-string s)))
+    (overlay-put ov 'face 'mdw-point-overlay)
+    (delete-overlay ov)
+    ov))
+
+(defvar mdw-point-overlay (mdw-configure-point-overlay)
+  "An overlay used for showing where point is in the selected window.")
+(defun mdw-reconfigure-point-overlay ()
+  (interactive)
+  (setq mdw-point-overlay (mdw-configure-point-overlay)))
+
+(defun mdw-remove-point-overlay ()
+  "Remove the current-point overlay."
+  (delete-overlay mdw-point-overlay))
+
+(defun mdw-update-point-overlay ()
+  "Mark the current point position with an overlay."
+  (if (not mdw-point-overlay-mode)
+      (mdw-remove-point-overlay)
+    (overlay-put mdw-point-overlay 'window (selected-window))
+    (move-overlay mdw-point-overlay
+                 (line-beginning-position)
+                 (+ (line-end-position) 1))))
+
+(defvar mdw-point-overlay-buffers nil
+  "List of buffers using `mdw-point-overlay-mode'.")
+
+(define-minor-mode mdw-point-overlay-mode
+  "Indicate current line with an overlay."
+  :global nil
+  (let ((buffer (current-buffer)))
+    (setq mdw-point-overlay-buffers
+         (mapcan (lambda (buf)
+                   (if (and (buffer-live-p buf)
+                            (not (eq buf buffer)))
+                       (list buf)))
+                 mdw-point-overlay-buffers))
+    (if mdw-point-overlay-mode
+       (setq mdw-point-overlay-buffers
+             (cons buffer mdw-point-overlay-buffers))))
+  (cond (mdw-point-overlay-buffers
+        (add-hook 'pre-command-hook 'mdw-remove-point-overlay)
+        (add-hook 'post-command-hook 'mdw-update-point-overlay))
+       (t
+        (mdw-remove-point-overlay)
+        (remove-hook 'pre-command-hook 'mdw-remove-point-overlay)
+        (remove-hook 'post-command-hook 'mdw-update-point-overlay))))
+
+(define-globalized-minor-mode mdw-global-point-overlay-mode
+  mdw-point-overlay-mode
+  (lambda () (if (not (minibufferp)) (mdw-point-overlay-mode t))))
+
 ;;;--------------------------------------------------------------------------
 ;;; C programming configuration.