Search code examples
emacselisp

Emacs -- creating a custom highlight parentheses function


I'm looking for some assistance, please, further modifying the following already modified excerpt from the highlight-parentheses library: https://github.com/nschum/highlight-parentheses.el [Fn 1.]

GOAL: The goal is to use something like mapcar or dolist to automatically replace INSERT-FACE-HERE with a different face from the variable my-parens-faces each time while does a loop. The visual effect will be a rainbow coloring of parentheses based on the level of nesting.

I am removing the overlays with a post-command-hook and a function similar to remove-overlays, and then subsequently adding new overlays with the parens function below. I will not be moving any overlays -- just creating and deleting. The final version will use variables for the faces and target specific overlays for removal, but here is a sample of what it will look like: (add-hook 'post-command-hook (lambda () (remove-overlays) (parens)))

Each time while does a loop, I want to insert a different face from the variable my-parens-faces -- going in order, like dolist. For example:

  • while doing loop # 1: (:foreground "black" :background "cyan")

  • while doing loop # 2: (:foreground "blue" :background "purple")

  • while doing loop # 3: (:foreground "green" :background "blue")

  • while doing loop # 4: (:foreground "yellow" :background "purple")

  • while doing loop # 5: (:foreground "orange" :background "yellow")

  • while doing loop # 6: (:foreground "red" :background "green")

  • while doing loop # 7: (:foreground "pink" :background "brown")

  • while doing loop # 8: (:foreground "blue" :background "beige")

(defun parens ()
  (let* (pos1 pos2)
    (save-excursion
      (condition-case err
        (while (setq pos1 (cadr (syntax-ppss pos1)))
          (overlay-put (make-overlay pos1 (1+ pos1)) 'face 'INSERT-FACE-HERE)
          (when (setq pos2 (scan-sexps pos1 1))
            (overlay-put (make-overlay (1- pos2) pos2) 'face 'INSERT-FACE-HERE)))
        (error nil)) )))

(defvar my-parens-faces '(
  (:foreground "black" :background "cyan")
  (:foreground "blue" :background "purple")
  (:foreground "green" :background "blue")
  (:foreground "yellow" :background "purple")
  (:foreground "orange" :background "yellow")
  (:foreground "red" :background "green")
  (:foreground "pink" :background "brown")
  (:foreground "blue" :background "beige")))

[Footnote number 1: Reference to the highlight-parentheses library is not needed to answer this question, but the reference is being included so that proper attribute is made to the author (i.e., Nikolaj Schumacher) who inspired the parens function in this question.]


Solution

  • (defvar parens-mode-command-exclusions '(mwheel-scroll scroll-up scroll-down)
      "List of functions that are excluded from triggering the function `parens'.")
    
    (defvar parens-mode-syntax-table
      (let ((st (make-syntax-table)))
        st)
      "Syntax table used while executing the function `parens'.")
    
    (defgroup parens nil
      "Faces for highlighting parentheses in `parens-mode'."
      :group 'parens)
    
    (defface parens-one-face
      '((t (:foreground "magenta")))
      "Face for `parens-one-face'."
      :group 'parens)
    
    (defface parens-two-face
      '((t (:foreground "red")))
      "Face for `parens-two-face'."
      :group 'parens)
    
    (defface parens-three-face
      '((t (:foreground "yellow")))
      "Face for `parens-three-face'."
      :group 'parens)
    
    (defface parens-four-face
      '((t (:foreground "green")))
      "Face for `parens-four-face'."
      :group 'parens)
    
    (defface parens-five-face
      '((t (:foreground "cyan")))
      "Face for `parens-five-face'."
      :group 'parens)
    
    (defface parens-six-face
      '((t (:foreground "orange")))
      "Face for `parens-six-face'."
      :group 'parens)
    
    (defface parens-seven-face
      '((t (:foreground "purple")))
      "Face for `parens-seven-face'."
      :group 'parens)
    
    (defface parens-eight-face
      '((t (:foreground "blue")))
      "Face for `parens-eight-face'."
      :group 'parens)
    
    (defface parens-nine-face
      '((t (:foreground "brown")))
      "Face for `parens-nine-face'."
      :group 'parens)
    
    (defface parens-ten-face
      '((t (:foreground "white")))
      "Face for `parens-ten-face'."
      :group 'parens)
    
    (defvar parens-overlays-exist-p nil
    "Simple test to see whether the parens overlays have been placed.")
    (make-variable-buffer-local 'parens-overlays-exist-p)
    
    (defun parens ()
    "Portions of this function were borrowed from the library
    `highlight-parentheses` written by Nikolaj Schumacher.
    https://github.com/nschum/highlight-parentheses.el"
      (unless (memq this-command parens-mode-command-exclusions)
        (with-syntax-table parens-mode-syntax-table
          (let* (
              (pt (point))
              (pos1 (if
                      (or
                        (= pt (point-min))
                        (eq (preceding-char) 40) ;; open-parentheses
                        (eq (preceding-char) 91) ;; open-squre-bracket
                        (eq (preceding-char) 123)) ;; open-wavy-bracket
                  pt
                  (1- pt)))
              pos2
              selected-face
              (i 0) )
            (remove-parens-overlays)
            (save-excursion
              (condition-case nil
                (while (setq pos1 (cadr (syntax-ppss pos1)))
                  (if (= i 10)
                    (setq i 1)
                    (setq i (1+ i)))
                  (cond
                    ((= i 1)
                      (setq selected-face 'parens-one-face))
                    ((= i 2)
                      (setq selected-face 'parens-two-face))
                    ((= i 3)
                      (setq selected-face 'parens-three-face))
                    ((= i 4)
                      (setq selected-face 'parens-four-face))
                    ((= i 5)
                      (setq selected-face 'parens-five-face))
                    ((= i 6)
                      (setq selected-face 'parens-six-face))
                    ((= i 7)
                      (setq selected-face 'parens-seven-face))
                    ((= i 8)
                      (setq selected-face 'parens-eight-face))
                    ((= i 9)
                      (setq selected-face 'parens-nine-face))
                    ((= i 10)
                      (setq selected-face 'parens-ten-face)) )
                  (overlay-put (make-overlay pos1 (1+ pos1)) 'face selected-face)
                  (when (setq pos2 (scan-sexps pos1 1))
                    (overlay-put (make-overlay (1- pos2) pos2) 'face selected-face)))
                (error nil) ))
            (setq parens-overlays-exist-p t)))))
    
    (defun remove-parens-overlays ()
      (when parens-overlays-exist-p
        (dolist (face '(
            parens-one-face
            parens-two-face
            parens-three-face
            parens-four-face
            parens-five-face
            parens-six-face
            parens-seven-face
            parens-eight-face
            parens-nine-face
            parens-ten-face))
          (remove-overlays nil nil 'face face)) 
        (setq parens-overlays-exist-p nil)))
    
    (defun turn-off-parens-mode ()
      (parens-mode -1))
    
    (define-minor-mode parens-mode
    "A minor-mode for highlighting parentheses."
      :init-value nil
      :lighter " ‹›"
      :keymap nil
      :global nil
      :group 'parens
      (cond
        (parens-mode
          (add-hook 'post-command-hook 'parens t t)
          (add-hook 'change-major-mode-hook 'turn-off-parens-mode nil t)
          (when (called-interactively-p 'any)
            (message "Turned ON `parens-mode`.")))
        (t
          (remove-hook 'post-command-hook 'parens t)
          (remove-hook 'change-major-mode-hook 'turn-off-parens-mode t)
          (remove-parens-overlays)
          (when (called-interactively-p 'any)
            (message "Turned OFF `parens-mode`.")))))