From d314603b307bb20ebdc06a99bd874999c8ca7ec6 Mon Sep 17 00:00:00 2001 From: Eshel Yaron Date: Sun, 25 Aug 2024 16:33:44 +0200 Subject: [PATCH] Experimental new Emacs Lisp mode --- lisp/progmodes/el.el | 247 ++++++++++++++++++++++++++++++++++++++++++ lisp/strict-indent.el | 57 ++++++++++ 2 files changed, 304 insertions(+) create mode 100644 lisp/progmodes/el.el create mode 100644 lisp/strict-indent.el diff --git a/lisp/progmodes/el.el b/lisp/progmodes/el.el new file mode 100644 index 00000000000..520d06b926a --- /dev/null +++ b/lisp/progmodes/el.el @@ -0,0 +1,247 @@ +;;; el.el --- -*- lexical-binding: t; -*- + +;; Copyright (C) 2024 Eshel Yaron + +;; Author: Eshel Yaron +;; 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 . + +;;; 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 index 00000000000..27397b5dce8 --- /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 +;; 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 . + +;;; 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 -- 2.39.5