(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))
(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)))
;; 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)
-;;; el.el --- -*- lexical-binding: t; -*-
+;;; el.el --- -*- lexical-binding: t; mode: el -*-
;; Copyright (C) 2024 Eshel Yaron
(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.
#'fboundp)))
(insert f)
(let ((func (intern-soft f)))
- (when (functionp func)
+ (when (fboundp func)
(dotimes (_ (car (func-arity func)))
(insert " ()")))))
(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
"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"
(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)