From d34f9abfc63f2affff414d7d87e5cd1a47b94535 Mon Sep 17 00:00:00 2001 From: Eshel Yaron Date: Wed, 11 Jun 2025 08:45:12 +0200 Subject: [PATCH] elisp-mode.el: Better support for coding-systems --- lisp/emacs-lisp/find-func.el | 4 ++ lisp/emacs-lisp/scope.el | 90 ++++++++++++++++++++++++++++++++++-- lisp/international/mule.el | 1 + lisp/loadhist.el | 4 ++ lisp/progmodes/elisp-mode.el | 7 +++ 5 files changed, 103 insertions(+), 3 deletions(-) diff --git a/lisp/emacs-lisp/find-func.el b/lisp/emacs-lisp/find-func.el index d9315002dba..f451e9b14aa 100644 --- a/lisp/emacs-lisp/find-func.el +++ b/lisp/emacs-lisp/find-func.el @@ -85,6 +85,9 @@ Please send improvements and fixes to the maintainer." (defvar find-icon-regexp (concat "^\\s-*(define-icon" find-function-space-re "%s\\(\\s-\\|$\\)")) +(defvar find-coding-system-regexp + (concat "^\\s-*(define-coding-system" find-function-space-re "%s\\(\\s-\\|$\\)")) + (defvar find-widget-regexp (concat "^\\s-*(define-widget" find-function-space-re "%s\\(\\s-\\|$\\)")) @@ -148,6 +151,7 @@ should insert the feature name." (define-widget . find-widget-regexp) (define-error . find-error-regexp) (define-icon . find-icon-regexp) + (define-coding-system . find-coding-system-regexp) (define-symbol-type . find-symbol-type-regexp)) "Alist mapping definition types into regexp variables. Each regexp variable's value should actually be a format string diff --git a/lisp/emacs-lisp/scope.el b/lisp/emacs-lisp/scope.el index bfd83935f34..236e4f8e9a2 100644 --- a/lisp/emacs-lisp/scope.el +++ b/lisp/emacs-lisp/scope.el @@ -356,6 +356,26 @@ :imenu "OClosure type" :namespace 'oclosure) +(scope-define-symbol-type coding () + :doc "Coding system names." + :face 'font-lock-type-face + :help (lambda (beg end _def) + (if-let ((sym (intern (buffer-substring-no-properties beg end)))) + (lambda (&rest _) + (if-let ((doc (coding-system-doc-string sym))) + (format "Coding system `%S'.\n\n%s" sym doc) + "Coding system")) + "Coding system")) + :completion (constantly #'coding-system-p) + :namespace 'coding) + +(scope-define-symbol-type defcoding () + :doc "Coding system definitions." + :face 'font-lock-type-face + :help (constantly "Coding system definition") + :imenu "Coding system" + :namespace 'coding) + (defvar scope-counter nil) (defvar scope-local-functions nil) @@ -1524,8 +1544,9 @@ a (possibly empty) list of safe macros.") (scope-define-function-analyzer oclosure--define (&optional name _docstring parent-names _slots &rest props) (when-let ((quoted (scope--unqoute name))) (scope-report-s quoted 'defoclosure)) - (dolist (parent parent-names) - (when-let ((quoted (scope--unqoute parent))) (scope-report-s quoted 'oclosure))) + (when-let ((qs (scope--unqoute parent-names))) + (dolist (q qs) + (scope-report-s q 'oclosure))) (while-let ((kw (car-safe props)) (bkw (scope-sym-bare kw)) ((keywordp bkw))) @@ -1535,6 +1556,68 @@ a (possibly empty) list of safe macros.") (when-let ((q (scope--unqoute (cadr props)))) (scope-report-s q 'defun)))) (setq props (cddr props)))) +(scope-define-function-analyzer define-coding-system + (&optional name _docstring &rest _props) + (when-let ((quoted (scope--unqoute name))) (scope-report-s quoted 'defcoding))) + +(scope-define-function-analyzer define-coding-system-alias + (&optional alias coding-system) + (when-let ((quoted (scope--unqoute alias))) (scope-report-s quoted 'defcoding)) + (when-let ((quoted (scope--unqoute coding-system))) (scope-report-s quoted 'coding))) + +(scope-define-function-analyzer decode-coding-region + (&optional _start _end coding-system &rest _) + (when-let ((quoted (scope--unqoute coding-system))) (scope-report-s quoted 'coding))) + +(put 'encode-coding-region 'scope-analyzer #'scope--analyze-decode-coding-region) + +(scope-define-function-analyzer decode-coding-string + (&optional _string coding-system &rest _) + (when-let ((quoted (scope--unqoute coding-system))) (scope-report-s quoted 'coding))) + +(dolist (sym '(encode-coding-char encode-coding-string)) + (put sym 'scope-analyzer #'scope--analyze-decode-coding-string)) + +(scope-define-function-analyzer coding-system-mnemonic + (&optional coding-system &rest _) + (when-let ((quoted (scope--unqoute coding-system))) (scope-report-s quoted 'coding))) + +(dolist (sym '(add-to-coding-system-list + check-coding-system + coding-system-aliases + coding-system-base + coding-system-category + coding-system-change-eol-conversion + coding-system-change-text-conversion + coding-system-charset-list + coding-system-doc-string + coding-system-eol-type + coding-system-eol-type-mnemonic + coding-system-get + coding-system-plist + coding-system-post-read-conversion + coding-system-pre-write-conversion + coding-system-put + coding-system-translation-table-for-decode + coding-system-translation-table-for-encode + coding-system-type + describe-coding-system + prefer-coding-system + print-coding-system + print-coding-system-briefly + revert-buffer-with-coding-system + set-buffer-file-coding-system + set-clipboard-coding-system + set-coding-system-priority + set-default-coding-systems + set-file-name-coding-system + set-keyboard-coding-system + set-next-selection-coding-system + set-selection-coding-system + set-terminal-coding-system + universal-coding-system-argument)) + (put sym 'scope-analyzer #'scope--analyze-coding-system-mnemonic)) + (scope-define-function-analyzer thing-at-point (thing &optional _) (when-let ((quoted (scope--unqoute thing))) (scope-report-s quoted 'thing))) @@ -2025,7 +2108,8 @@ starting with a top-level form, by inspecting HEAD at each level: functions." (let ((scope-counter 0) (scope-callback callback) - (read-symbol-shorthands nil)) + (read-symbol-shorthands nil) + (max-lisp-eval-depth 32768)) (scope-1 nil (read-positioning-symbols (or stream (current-buffer)))))) (provide 'scope) diff --git a/lisp/international/mule.el b/lisp/international/mule.el index 9d9c2d46a93..b556ef906bb 100644 --- a/lisp/international/mule.el +++ b/lisp/international/mule.el @@ -1003,6 +1003,7 @@ non-ASCII files. This attribute is meaningful only when (setq props (cons :name (cons name (cons :docstring (cons docstring props))))) (setcdr (assq :plist common-attrs) props) + (add-to-list 'current-load-list `(define-coding-system . ,name)) (apply #'define-coding-system-internal name (mapcar #'cdr (append common-attrs spec-attrs))))) diff --git a/lisp/loadhist.el b/lisp/loadhist.el index 3e18eb1da66..2f3c5511116 100644 --- a/lisp/loadhist.el +++ b/lisp/loadhist.el @@ -247,6 +247,10 @@ unloading." (cl-defmethod loadhist-unload-element ((x (head define-icon))) (let ((name (cdr x))) (put name 'icon--properties nil))) +(cl-defmethod loadhist-unload-element ((_x (head define-coding-system))) + ;; FIXME: Implement it. + nil) + ;;;###autoload (defun unload-feature (feature &optional force) "Unload the library that provided FEATURE. diff --git a/lisp/progmodes/elisp-mode.el b/lisp/progmodes/elisp-mode.el index 18e051eb75e..5a669ee7511 100644 --- a/lisp/progmodes/elisp-mode.el +++ b/lisp/progmodes/elisp-mode.el @@ -1163,6 +1163,7 @@ confidence." (widget-type '(widget-type)) (condition '(condition)) (icon '(deficon icon)) + (coding '(defcoding coding)) (variable '(defvar variable constant)) (symbol-type '(symbol-type symbol-type-definition)) (function '(defun function macro special-form major-mode))))) @@ -1240,6 +1241,8 @@ confidence." ('condition '(define-error)) ('icon '(define-icon)) ('symbol-type '(define-symbol-type)) + ('coding '(define-coding-system)) + ('oclosure '(oclosure)) ('widget-type '(define-widget))))) (cl-loop for d in definitions when (memq @@ -1296,6 +1299,10 @@ confidence." (when-let ((file (find-lisp-object-file-name symbol 'define-icon))) (push (elisp--xref-make-xref 'define-icon symbol file) xrefs))) + (when (coding-system-p symbol) + (when-let ((file (find-lisp-object-file-name symbol 'define-coding-system))) + (push (elisp--xref-make-xref 'define-coding-system symbol file) xrefs))) + (when (scope-symbol-type-p symbol) (when-let ((file (find-lisp-object-file-name symbol 'define-symbol-type))) (push (elisp--xref-make-xref 'define-symbol-type symbol file) xrefs))) -- 2.39.5