]> git.eshelyaron.com Git - emacs.git/commitdiff
; el.el, scope.el: Minor improvements.
authorEshel Yaron <me@eshelyaron.com>
Tue, 27 Aug 2024 15:00:02 +0000 (17:00 +0200)
committerEshel Yaron <me@eshelyaron.com>
Wed, 4 Sep 2024 07:51:36 +0000 (09:51 +0200)
lisp/emacs-lisp/scope.el
lisp/progmodes/el.el

index d296430c7c683559265da673c208b77cc0e3cc23..55cbe3a65bf3e88cd1bfd0b831419871971e99d6 100644 (file)
@@ -507,19 +507,36 @@ a (possibly empty) list of safe macros.")
           (scope-n local forms))
          ((get bare 'scope-function)
           (funcall (get bare 'scope-function) local forms))
-         ((eq bare 'eval)
-          (let ((q (scope-sym-bare (car-safe (car forms)))))
-            (cond
-             ((eq q 'quote) (scope-1 local (cadar forms)))
-             ((and (memq q '(function \`))
-                   (symbol-with-pos-p (cadar forms)))
-              (scope-s local (cadar forms)))))
-          (when (symbol-with-pos-p f)
-            (funcall scope-callback 'function
-                     (symbol-with-pos-pos f) (length (symbol-name bare))
-                     nil))
-          (scope-n local forms))
          ((functionp bare)
+          (cl-case bare
+            (eval
+             (let ((q (scope-sym-bare (car-safe (car forms)))))
+               (cond
+                ((eq q 'quote) (scope-1 local (cadar forms)))
+                ((and (memq q '(function \`))
+                      (symbol-with-pos-p (cadar forms)))
+                 (scope-s local (cadar forms))))))
+            (defalias
+              (when-let* ((alias-form (car forms))
+                          ((eq (scope-sym-bare (car-safe alias-form)) 'quote))
+                          (alias (cadr alias-form))
+                          (beg (scope-sym-pos alias))
+                          (bare (scope-sym-bare alias)))
+                (funcall scope-callback 'defun beg (length (symbol-name bare)) nil)))
+            (custom-declare-variable
+             (when-let* ((alias-form (car forms))
+                         ((eq (scope-sym-bare (car-safe alias-form)) 'quote))
+                         (alias (cadr alias-form))
+                         (beg (scope-sym-pos alias))
+                         (bare (scope-sym-bare alias)))
+               (funcall scope-callback 'defvar beg (length (symbol-name bare)) nil)))
+            (custom-declare-face
+             (when-let* ((alias-form (car forms))
+                         ((eq (scope-sym-bare (car-safe alias-form)) 'quote))
+                         (alias (cadr alias-form))
+                         (beg (scope-sym-pos alias))
+                         (bare (scope-sym-bare alias)))
+               (funcall scope-callback 'defface beg (length (symbol-name bare)) nil))))
           (when (symbol-with-pos-p f)
             (funcall scope-callback 'function
                      (symbol-with-pos-pos f) (length (symbol-name bare))
@@ -570,6 +587,8 @@ a (possibly empty) list of safe macros.")
             (scope-n local forms))
            ((memq bare '(with-slots))
             (scope-with-slots local (car forms) (cadr forms) (cddr forms)))
+           ;; ((memq bare '(defun))
+           ;;  (scope-defun local (car forms) (cadr forms) (cddr forms)))
            ((memq bare '(declare-function))
             (scope-declare-function local (car forms) (cadr forms)
                                     (caddr forms) (cadddr forms)))
@@ -598,7 +617,8 @@ a (possibly empty) list of safe macros.")
                                        ;; and handle them manually.
                                        '((static-if) (rx) (cl-eval-when)
                                          (eval-when-compile) (eval-and-compile))
-                                       macroexpand-all-environment)))
+                                       macroexpand-all-environment))
+                                     (macroexp-inhibit-compiler-macros t))
                                  (macroexpand-1 form macroexpand-all-environment))))))))
          ;; Assume nothing about unknown top-level forms.
          (top-level nil)
index 3da4164ae83290781871f8b6899280554920c4b2..c39cd87dc77a18c3e8b5e4a09c502492b45a68d7 100644 (file)
@@ -1,4 +1,4 @@
-;;; el.el ---                                        -*- lexical-binding: t; -*-
+;;; el.el ---                                        -*- lexical-binding: t; mode: el -*-
 
 ;; Copyright (C) 2024  Eshel Yaron
 
@@ -47,6 +47,9 @@
 (defface el-special-form '((t :inherit el-macro-use))
   "Face for highlighting special forms in Emacs Lisp code.")
 
+(defface el-face-name '((t :inherit font-lock-variable-name-face))
+  "Face for highlighting face names in Emacs Lisp code.")
+
 (defun el-highlight-variable (pos)
   "Highlight variable at POS along with its co-occurrences."
   (let* (all dec)
          (el-highlight-variable pos)
        (el-unhighlight-variable old)))))
 
+(defun el-fontify-symbol (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)
+                         (defface      'el-face-name)
+                         (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))))
+
 (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))))))
+      (ignore-errors (scope #'el-fontify-symbol)))))
 
 (defun el-fontify-region (beg end &optional loudly)
   "Fontify ELisp code between BEG and END.
@@ -181,7 +184,7 @@ This is the `font-lock-fontify-region-function' for `emacs-lisp-mode'."
                           #'fboundp)))
   (insert f)
   (let ((func (intern-soft f)))
-    (when (functionp func)
+    (when (fboundp func)
       (dotimes (_ (car (func-arity func)))
         (insert " ()")))))
 
@@ -230,6 +233,28 @@ This is the `font-lock-fontify-region-function' for `emacs-lisp-mode'."
   (interactive)
   (insert " "))
 
+(defun el-create-index ()
+  (goto-char (point-min))
+  (let (index)
+    (condition-case nil
+        (while t
+          (scope (lambda (type beg len _)
+                   (cl-case type
+                     (defun (push (cons (buffer-substring-no-properties beg (+ beg len))
+                                        beg)
+                                  index))
+                     (defvar (push (cons (buffer-substring-no-properties beg (+ beg len))
+                                         beg)
+                                   (alist-get "Var" index nil nil #'string=)))
+                     (defface (push (cons (buffer-substring-no-properties beg (+ beg len))
+                                          beg)
+                                    (alist-get "Face" index nil nil #'string=))))
+                   (when (eq type 'defun)
+                     (push (cons (buffer-substring-no-properties beg (+ beg len))
+                                 beg)
+                           index)))))
+      (end-of-file (nreverse index)))))
+
 (defvar-keymap el-mode-map
   :suppress t
   "r" #'raise-sexp
@@ -257,7 +282,9 @@ This is the `font-lock-fontify-region-function' for `emacs-lisp-mode'."
   "m" #'mark-sexp
   "." #'xref-find-definitions
   "," #'xref-go-back
-  "SPC" #'el-insert-space)
+  "SPC" #'el-insert-space
+  "g" #'imenu
+  "RET" #'newline-and-indent)
 
 ;;;###autoload
 (define-derived-mode el-mode prog-mode "EL"
@@ -269,7 +296,8 @@ This is the `font-lock-fontify-region-function' for `emacs-lisp-mode'."
                  (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)
+              indent-region-function #'lisp-indent-region
+              imenu-create-index-function #'el-create-index)
   (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)