]> git.eshelyaron.com Git - emacs.git/commitdiff
elisp-mode.el: Better support for coding-systems
authorEshel Yaron <me@eshelyaron.com>
Wed, 11 Jun 2025 06:45:12 +0000 (08:45 +0200)
committerEshel Yaron <me@eshelyaron.com>
Wed, 11 Jun 2025 06:45:12 +0000 (08:45 +0200)
lisp/emacs-lisp/find-func.el
lisp/emacs-lisp/scope.el
lisp/international/mule.el
lisp/loadhist.el
lisp/progmodes/elisp-mode.el

index d9315002dba10ec6e30fc5dd81fcd17836d3b707..f451e9b14aaeac97c770cce722410478cf5cc410 100644 (file)
@@ -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
index bfd83935f349274f9e215cb2952d4fca8ba7ae4d..236e4f8e9a22cd75187c8bc6b39d7ba665546881 100644 (file)
   :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)
index 9d9c2d46a93ac31d611ffc725732ee9d6b3946da..b556ef906bb175f98665a393e713d63a93b9c308 100644 (file)
@@ -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)))))
 
index 3e18eb1da66f88337a556d04eccc05e8068b21c6..2f3c55111161f1cc75ea89b6e105ebcc31a6f734 100644 (file)
@@ -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.
index 18e051eb75e5fa72ef4be2b0293b03bf6d0d565b..5a669ee7511bcc6c4e88210bcc606907a18fd38c 100644 (file)
@@ -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)))