Experimental new Emacs Lisp mode

diff --git a/lisp/progmodes/el.el b/lisp/progmodes/el.el
new file mode 100644 (file)
index 0000000..520d06b
--- /dev/null
+++ b/lisp/progmodes/el.el
@@ -0,0 +1,247 @@
+;;; el.el ---                                        -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2024  Eshel Yaron
+
+;; Author: Eshel Yaron <me@eshelyaron.com>
+;; Keywords:
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program.  If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;
+
+;;; Code:
+
+(eval-when-compile (require 'cl-lib))
+
+(require 'subr-x)
+
+(defface el-free-variable '((t :inherit underline))
+  "Face for highlighting free variables in Emacs Lisp code.")
+
+(defface el-binding-variable
+  '((t :slant italic :inherit font-lock-variable-name-face))
+  "Face for highlighting binding occurrences of variables in Emacs Lisp code.")
+
+(defface el-bound-variable '((t :slant italic))
+  "Face for highlighting bound occurrences of variables in Emacs Lisp code.")
+
+(defface el-variable-at-point '((t :inherit bold))
+  "Face for highlighting (all occurrences of) the variable at point.")
+
+(defface el-macro-use '((t :inherit font-lock-keyword-face))
+  "Face for highlighting macro calls in Emacs Lisp code.")
+
+(defface el-special-form '((t :inherit el-macro-use))
+  "Face for highlighting special forms in Emacs Lisp code.")
+
+(defun el-highlight-variable (pos)
+  "Highlight variable at POS along with its co-occurrences."
+  (let* (all dec)
+    (save-excursion
+      (goto-char pos)
+      (beginning-of-defun)
+      (scope (lambda (_type beg len bin)
+               (when (<= beg pos (+ beg len))
+                 (setq dec bin))
+               (when bin (push (list beg len bin) all)))
+             (current-buffer)))
+    (pcase-dolist (`(,sym ,len ,bin) all)
+      (when (equal bin dec)
+        (let ((ov (make-overlay sym (+ sym len))))
+          (overlay-put ov 'face 'elisp-variable-at-point)
+          (overlay-put ov 'elisp-highlight-variable t))))))
+
+(defun el-unhighlight-variable (pos)
+  "Remove variable highlighting across top-level form at POS."
+  (save-excursion
+    (goto-char pos)
+    (beginning-of-defun)
+    (remove-overlays (point) (progn (end-of-defun) (point))
+                     'elisp-highlight-variable t)))
+
+(defun el-cursor-sensor (pos)
+  "Return `cursor-sensor-functions' for ELisp symbol at POS."
+  (list
+   (lambda (_win old dir)
+     (if (eq dir 'entered)
+         (el-highlight-variable pos)
+       (el-unhighlight-variable old)))))
+
+(defun el-fontify-region-semantically (beg end)
+  "Fontify symbols between BEG and END according to their semantics."
+  (save-excursion
+    (goto-char beg)
+    (while (< (point) end)
+      (ignore-errors
+        (scope
+         (lambda (type sym len bind)
+           (if (null bind)
+               (when-let ((face (cl-case type
+                                  (variable     'el-free-variable)
+                                  (constant     'font-lock-constant-face)
+                                  (function     'font-lock-function-call-face)
+                                  (defun        'font-lock-function-name-face)
+                                  (defvar       'font-lock-variable-name-face)
+                                  (macro        'el-macro-use)
+                                  (special-form 'el-special-form))))
+                 (add-face-text-property sym (+ sym len) face t))
+             (add-face-text-property sym (+ sym len)
+                                     (if (equal sym bind)
+                                         'el-binding-variable
+                                       'el-bound-variable)
+                                     t)
+             (put-text-property sym (+ sym len 1) 'cursor-sensor-functions
+                                ;; Get a fresh list with SYM hardcoded,
+                                ;; so that the value is distinguishable
+                                ;; from the value in adjacent regions.
+                                (el-cursor-sensor sym))))
+         (current-buffer))))))
+
+(defun el-fontify-region (beg end &optional loudly)
+  "Fontify ELisp code between BEG and END.
+
+Non-nil optional argument LOUDLY permits printing status messages.
+
+This is the `font-lock-fontify-region-function' for `emacs-lisp-mode'."
+  (let ((beg (save-excursion (goto-char beg) (beginning-of-defun) (point)))
+        (end (save-excursion (goto-char end) (end-of-defun)
+                             (skip-chars-backward " \t\n")
+                             (point))))
+    (font-lock-default-fontify-region beg end loudly)
+    (el-fontify-region-semantically beg end)
+    `(jit-lock-bounds ,beg . ,end)))
+
+(defvar el-mode-syntax-table
+  (let ((table (make-syntax-table))
+        (i 0))
+    (while (< i ?0)
+      (modify-syntax-entry i "_   " table)
+      (setq i (1+ i)))
+    (setq i (1+ ?9))
+    (while (< i ?A)
+      (modify-syntax-entry i "_   " table)
+      (setq i (1+ i)))
+    (setq i (1+ ?Z))
+    (while (< i ?a)
+      (modify-syntax-entry i "_   " table)
+      (setq i (1+ i)))
+    (setq i (1+ ?z))
+    (while (< i 128)
+      (modify-syntax-entry i "_   " table)
+      (setq i (1+ i)))
+    (modify-syntax-entry ?\s "    " table)
+    ;; Non-break space acts as whitespace.
+    (modify-syntax-entry ?\xa0 "    " table)
+    (modify-syntax-entry ?\t "    " table)
+    (modify-syntax-entry ?\f "    " table)
+    (modify-syntax-entry ?\n ">   " table)
+    (modify-syntax-entry ?\; "<   " table)
+    (modify-syntax-entry ?` "'   " table)
+    (modify-syntax-entry ?' "'   " table)
+    (modify-syntax-entry ?, "'   " table)
+    (modify-syntax-entry ?@ "_   " table)
+    ;; Used to be singlequote; changed for flonums.
+    (modify-syntax-entry ?. "_   " table)
+    (modify-syntax-entry ?# "'   " table)
+    (modify-syntax-entry ?\" "\"    " table)
+    (modify-syntax-entry ?\\ "\\   " table)
+    (modify-syntax-entry ?\( "()  " table)
+    (modify-syntax-entry ?\) ")(  " table)
+    (modify-syntax-entry ?\[ "(]" table)
+    (modify-syntax-entry ?\] ")[" table)
+    table)
+  "Syntax table for `el-mode'.")
+
+(defun el-insert-function-name (f)
+  (interactive
+   (list (completing-read "Insert: "
+                          (completion-table-with-metadata
+                           obarray '((category . function)))
+                          #'fboundp)))
+  (insert f " "))
+
+(defun el-insert-function-call (f)
+  (interactive
+   (list (completing-read "Insert: "
+                          (completion-table-with-metadata
+                           obarray '((category . function)))
+                          #'fboundp)))
+  (insert f)
+  (let ((func (intern-soft f)))
+    (when (functionp func)
+      (dotimes (_ (car (func-arity func)))
+        (insert " ()")))))
+
+(defun el-edit-sexp ()
+  (interactive)
+  (if-let* ((bounds (bounds-of-thing-at-point 'sexp))
+            (beg (car bounds))
+            (pos (1+ (- (point) beg)))
+            (end (cdr bounds))
+            (str (minibuffer-with-setup-hook
+                     (lambda ()
+                       (set-syntax-table el-mode-syntax-table)
+                       (add-hook 'completion-at-point-functions
+                                 #'elisp-completion-at-point nil t)
+                       (run-hooks 'eval-expression-minibuffer-setup-hook))
+                   (read-from-minibuffer "Edit: "  (cons (buffer-substring beg end) pos) read--expression-map nil))))
+      (replace-region-contents beg end (lambda () str))
+    (user-error "No expression at point")))
+
+(defvar-keymap el-mode-map
+  :doc "Keymap for `el-mode'."
+  "r" #'raise-sexp
+  "t" #'transpose-sexps
+  "u" #'backward-up-list
+  "f" #'forward-sexp
+  "b" #'backward-sexp
+  "d" #'down-list
+  "k" #'kill-sexp
+  "y" #'yank
+  "(" #'insert-pair
+  ")" #'up-list
+  "\"" #'insert-pair
+  "/" #'undo
+  "c" #'el-insert-function-call
+  "s" #'el-edit-sexp
+  "x" #'eval-defun
+  "a" #'beginning-of-defun
+  "e" #'end-of-defun
+  "m" #'mark-sexp)
+
+;;;###autoload
+(define-derived-mode el-mode prog-mode "EL"
+  "Major mode for editing Emacs Lisp code."
+  :group 'lisp
+  (setq-local font-lock-defaults
+              '( nil nil nil nil nil
+                 (font-lock-fontify-region-function . el-fontify-region)
+                 (font-lock-extra-managed-props       cursor-sensor-functions))
+              syntax-propertize-function #'elisp-mode-syntax-propertize
+              indent-line-function #'lisp-indent-line
+              indent-region-function 'lisp-indent-region)
+  (add-hook 'xref-backend-functions #'el-xref-backend nil t)
+  (add-hook 'completion-at-point-functions #'elisp-completion-at-point nil 'local)
+  (add-hook 'flymake-diagnostic-functions #'elisp-flymake-checkdoc nil t)
+  (add-hook 'flymake-diagnostic-functions #'elisp-flymake-byte-compile nil t)
+  (add-hook 'refactor-backend-functions #'elisp-refactor-backend nil t)
+  (strict-indent-mode)
+  (rainbow-delimiters-mode))
+
+(defun el-xref-backend () "Xref backend function for `el-mode' buffers." 'el)
+
+(provide 'el)
+;;; el.el ends here

diff --git a/lisp/strict-indent.el b/lisp/strict-indent.el
new file mode 100644 (file)
index 0000000..27397b5
--- /dev/null
+++ b/lisp/strict-indent.el
@@ -0,0 +1,57 @@
+;;; strict-indent.el --- Keep code indented at all times  -*- lexical-binding: t; -*-
+
+;; Copyright (C) 2024  Eshel Yaron
+
+;; Author: Eshel Yaron <me@eshelyaron.com>
+;; Keywords:
+
+;; This program is free software; you can redistribute it and/or modify
+;; it under the terms of the GNU General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; This program is distributed in the hope that it will be useful,
+;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;; GNU General Public License for more details.
+
+;; You should have received a copy of the GNU General Public License
+;; along with this program.  If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;;
+
+;;; Code:
+
+(require 'track-changes)
+
+(defvar-local strict-indent--change-tracker nil)
+
+(defun strict-indent-region (beg end &optional _bef-len)
+  (let (b e)
+    (save-excursion
+      (goto-char beg)
+      (beginning-of-defun)
+      (setq b (point))
+      (goto-char end)
+      (end-of-defun)
+      (setq e (point)))
+    (indent-region b e)))
+
+;;;###autoload
+(define-minor-mode strict-indent-mode
+  "Keep code indented as you edit."
+  :lighter nil
+  (if strict-indent-mode
+      (unless strict-indent--change-tracker
+        (setq strict-indent--change-tracker
+              (track-changes-register
+               (lambda (id) (track-changes-fetch id #'strict-indent-region))
+               :nobefore t)))
+    (when strict-indent--change-tracker
+      (track-changes-unregister strict-indent--change-tracker)
+      (setq strict-indent--change-tracker nil))))
+
+(provide 'strict-indent)
+;;; strict-indent.el ends here