ov1 -- overlay helper lib #emacs #elisp #ux

ov1.el

;;; ov1 -- overlay helper lib  -*- lexical-binding: t; -*-

;; This buffer is for text that is not saved, and for Lisp evaluation.
;; To create a file, visit it with C-x C-f and enter text in its buffer.

;;; MORE: https://www.youtube.com/watch?v=IWxCj5cr8rY (eieio font-lock Kitchin)
;;; TODO: use magit command minibuffer
;;; TODO: extend overlay
;;; TODO: adjoint overlay (f (ov-substring))
;;;       have an overlay monad ? ov = Ov id , compose Ov f Ov g = shift (l|r|u|d) Ov g (f (ov-substring))
;;; TODO:  

(setq lexical-binding t)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; PRELUDE

(defmacro mono (&rest body)
  `(lambda (it) ,@body))

;; (funcall (mono (+ 1 it)) 1)

(defmacro duo (&rest body)
  `(lambda (a b) ,@body))

;; (funcall (duo (+ a b)) 1 2)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; GROUPS

(defgroup ov '()
  "ov | overlay customization group"
  :group 'extensions
  :group 'convenience)


;; TOFIX somehow something is precomputed and not run on every click
(defun ov-click (&rest o)
  (interactive)
  (ignore o)
  (lambda ()
    (interactive)
    (let ((e (buffer-substring-no-properties
	      (region-beginning)
	      (region-end))))
      (message ">>> %S" (eval (read e))))))

(defcustom *ov/face-def* 'highlight
  "default face for ov overlays"
  :type 'face)
(defcustom *ov/face-hover* 'bg:erc-color-face11
  "hover face for ov overlays"
  :type 'face)
(defcustom *ov/click-fun* #'ov-click
  "default function on click"
  :type 'function)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; DEFS

(defun ov-click! (o b c)
  (let ((k (overlay-get o 'keymap)))
    (define-key k b c)))

(defun ov-key! (o l c)
  (let ((k (overlay-get o 'keymap)))
    (define-key k (kbd l) c)))

(defun ov-set (o k vf)
  (overlay-put o k (funcall vf (overlay-get o k))))

(defun ov-nop (o)
  (interactive)
  (lambda (&rest xs)
    (interactive)
    (message "<ov %S on %S (%s)>" xs o (ov-substring o))))

(defun ov-substring (o)
  (buffer-substring-no-properties (overlay-start o) (overlay-end o)))

(defun ov-bye (o)
  (interactive)
  (lambda ()
    (interactive)
    (delete-overlay o)))

(defun ov (a b u &optional on-click on-key f-def f-hover)
  (let ((o (make-overlay a b u))
	(k (make-keymap)))
    (define-key k [mouse-1] (funcall (or on-click #'ov-nop) o))
    (define-key k (kbd "RET") (funcall (or on-key #'ov-nop) o))
    (define-key k (kbd "q") (funcall #'ov-bye o))
    (overlay-put o 'keymap k)
    ;; (ov-set o 'keymap (mono (define-key it [mouse-1] (or on-click #'nop))))
    ;; (ov-set o 'keymap (mono (define-key it (kbd "RET") (or on-key #'nop))))
    (when f-def (overlay-put o 'face f-def))
    (when f-hover (overlay-put o 'mouse-face f-hover))
    o))

(defun ov-region ()
  (ov (region-beginning) (region-end) (current-buffer)
      *ov/click-fun* ;; nil
      nil
      *ov/face-def*
      *ov/face-hover*))

(cmd ov-region-at-point ()
  (save-excursion
    (backward-up-list)
    (mark-sexp)
    (ov-region)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; TODO

(defun ov-compose () :todo)
(defun ov-map () :todo)
(defun ov-extend () :todo)
(defun ov-ajoint () :todo)

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; UTILS

(defun kill-buffer-overlays (&optional b)
  (dolist (o (-filter
	      (lambda (o) (eq (overlay-buffer o) (or b (current-buffer))))
	      (-flatten (overlay-lists))))
    (delete-overlay o)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; REST

(kill-buffer-overlays)

;; (-filter (lambda (o)
;;   (eq (overlay-buffer o) (current-buffer)))
;;   (-flatten (overlay-lists)))
;; (-map #'overlay-buffer (-flatten (overlay-lists)))

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; TEST ZONE

;; place cursor on the sexp below then run
;;  M-x ov-region-at-point

(defun test ()
  (let ((x 1)
	(y 20))
    (+ x y 10 20 30)))