Emacs Lisp要素へのorg-modeリンクをエクスポートする

(defun my-path-globalize-emacs (abs-file line)
  "Create a URL to a file bundled with Emacs."
  (let ((dirs `((,lisp-directory
                 . "https://git.savannah.gnu.org/cgit/emacs.git/tree/lisp/")
                (,find-function-C-source-directory
                 . "https://git.savannah.gnu.org/cgit/emacs.git/tree/src/"))))
    (cl-loop for (dir . url) in dirs
             when (and dir (string-prefix-p (expand-file-name dir) abs-file))
             return
             (concat
              url
              (file-relative-name abs-file dir)
              "?h=emacs-" emacs-version
              (when line (format "#n%d" line))))))

(my-path-globalize "c:/略/share/emacs/29.1/lisp/image.el" 484)

(defvar my-path-globalize-package-globalizers
  '(my-path-globalize-package-org
    my-path-globalize-package-github))

(defun my-path-globalize-package (abs-file line)
  "Create a URL to the file managed by package.el."
  (when-let* ((pkg-name-desc (my-path-globalize-package-find abs-file))
              (pkg-name (car pkg-name-desc))
              (pkg-desc (cdr pkg-name-desc))
              (pkg-dir (package-desc-dir pkg-desc))
              (rel-file (file-relative-name abs-file pkg-dir)))
    (seq-some (lambda (globalizer)
                (funcall globalizer rel-file line pkg-name pkg-desc))
              my-path-globalize-package-globalizers)))

(defun my-path-globalize-package-find (abs-file)
  ;;@todo package-user-dirで足切りする？ package-directory-listも？
  (cl-loop for (name . descs) in package-alist
           for desc = (cl-loop for desc in descs
                               for dir = (package-desc-dir desc)
                               when (and dir
                                         (string-prefix-p
                                          (expand-file-name dir) abs-file))
                               return desc)
           when desc
           return (cons name desc)))

(defun my-path-globalize-package-org (rel-file line pkg-name pkg-desc)
  (when (eq pkg-name 'org)
    (when-let* ((pkg-extras (package-desc-extras pkg-desc))
                (pkg-commit (alist-get :commit pkg-extras)))
      (concat
       "https://git.savannah.gnu.org/cgit/emacs/org-mode.git/tree/lisp/"
       rel-file
       "?id=" pkg-commit
       (when line (format "#n%d" line))))))

(defun my-path-globalize-package-github (rel-file line _pkg-name pkg-desc)
  (when-let* ((pkg-extras (package-desc-extras pkg-desc))
              (pkg-url (alist-get :url pkg-extras))
              (pkg-commit (alist-get :commit pkg-extras)))
    (when (string-match "\\(https?://github\\.com/[^/]+/[^/]+\\)" pkg-url)
      (concat
       (match-string 1 pkg-url) "/blob/" pkg-commit "/" rel-file
       (when line (format "#L%d" line))))))

(my-path-globalize-package (expand-file-name "~/.emacs.d/elpa/vertico-20231229.1740/vertico.el") 741)

(my-path-globalize-package (expand-file-name "~/.emacs.d/elpa/org-9.6.14/ol.el") 92)

(defvar my-path-globalizers
  '(my-path-globalize-emacs
    my-path-globalize-package))

(defun my-path-globalize (file line)
  "Return a URL on the World Wide Web that points to the LINE of the FILE.

FILE is a path to a local file that has the same content on the WWW.

LINE is a line number starting from 1."
  (let ((abs-file (expand-file-name file)))
    (seq-some (lambda (globalizer) (funcall globalizer abs-file line))
              my-path-globalizers)))

(defun my-elisp-face-web-url (symbol)
  (my-elisp-element-web-url symbol
                            (lambda (symbol)
                              (find-definition-noselect symbol 'defface))))

(defun my-elisp-variable-web-url (symbol)
  (my-elisp-element-web-url symbol #'find-variable-noselect))

(defun my-elisp-function-web-url (symbol)
  (my-elisp-element-web-url symbol #'find-function-noselect))

(defun my-elisp-element-web-url (symbol finder)
  (when-let ((file-line (my-elisp-element-file-line symbol finder)))
    (my-path-globalize (car file-line) (cdr file-line))))