SymTable — Build and search flat hash tables of symbols (Emacs package)

;;; symtable.el --- Build and search flat hash tables of symbols -*- lexical-binding: t -*-
;;; Commentary:
;;;; For all the details, please do see the README
;;; Code:
;;;; Libraries
;;;; Package metadata
;;;; Customizable variables
;;;; Other variables
;;;; Functions
;;;;; Query and report
;;;;;; Demos
;;;;;; Query prefixes
;;;;;; Query any regexp
;;;;; Create hash table
;;;;;; Select input interactively and create output
;;;;;; From pack→symbols to symbol→packages hash tables
;;;;;;; Read hash table
;;;;; See README
;;;; Wrapping up
;;; symtable.el ends here

;;; symtable.el --- Build and search flat hash tables of symbols -*- lexical-binding: t -*-

;; SPDX-FileCopyrightText: © flandrew <https://flandrew.srht.site/listful>

;;---------------------------------------------------------------------------
;; Author:    flandrew
;; Created:   2024-11-08
;; Updated:   2025-08-08
;; Keywords:  lisp
;; Homepage:  <https://flandrew.srht.site/listful/software.html>
;;---------------------------------------------------------------------------
;; Package-Version:  0.2.0.1
;; Package-Requires: ((emacs "26.1") (xht "1.0.5") (dash "2.15") (s "1.12"))
;;---------------------------------------------------------------------------

;; SPDX-License-Identifier: GPL-3.0-or-later

;; This file is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published
;; by the Free Software Foundation, either version 3 of the License,
;; or (at your option) any later version.
;;
;; This file is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;;
;; You should have received a copy of the GNU General Public License
;; along with this file. If not, see <https://www.gnu.org/licenses/>.

;;; Commentary:

;; From a hash table of packages and their symbols to a hash table of symbols
;; and their packages.
;;
;;;; For all the details, please do see the README
;;
;; Open it easily with:
;;   (find-file-read-only "README.org")   <--- C-x C-e here¹
;;
;; or from any buffer:
;;   M-x symtable-see-readme
;;
;; or read it online:
;;   <https://flandrew.srht.site/listful/sw-emacs-symtable.html>
;;
;; ¹ or the key that ‘eval-last-sexp’ is bound to, if not C-x C-e.
;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


;;; Code:
;;;; Libraries

(require 's)
(require 'xht)       ; <---also by the author of this package
(require 'dash)
(require 'lisp-mnt)  ; ‘lm-summary’, ‘lm-homepage’, ‘lm-version’, ‘lm-header’


;;;; Package metadata

(defvar symtable--name "SymTable")

(defvar symtable--dot-el
  (format "%s.el" (file-name-sans-extension (eval-and-compile
                                              (or load-file-name
                                                  buffer-file-name)))))
(defvar symtable--readme-org
  (expand-file-name "README.org" (file-name-directory symtable--dot-el)))

(defvar symtable--summary  (lm-summary   symtable--dot-el))
(defvar symtable--homepage (lm-homepage  symtable--dot-el))
(defvar symtable--version  (lm-with-file symtable--dot-el
                             (or (lm-header "package-version")
                                 (lm-version))))


;;;; Customizable variables

(defgroup symtable nil
  (format "%s." symtable--summary)
  :group 'lisp
  :link  '(emacs-library-link :tag "Lisp file" "symtable.el")
  :link  `(file-link :tag "README.org" ,symtable--readme-org)
  :link  `(url-link  :tag "Homepage"   ,symtable--homepage))

(defcustom symtable-default-in "demo"
  "Default file basename for tests."
  :package-version '(symtable "0.1.0")
  :type 'string)


;;;; Other variables

(defvar symtable-sep-rx "[^a-zA-Z0-9@]+"
  "Regexp of separator.")


;;;; Functions
;;;;; Query and report
;;;;;; Demos

(defun symtable-query-pre-demo (prefix)
  "Return list of packages that have PREFIX.
For the meaning of PREFIX, see ‘symtable-query-pre’.
The table comes from out/%s.el, where %s is ‘symtable-default-in’."
  (symtable-query-rx-demo (symtable--query-make-pre-rx prefix)))

(defun symtable-query-rx-demo (rx)
  "Return list of packages that have a symbol matching RX.
The table comes from out/%s.el, where %s is ‘symtable-default-in’."
  (let ((htbl-file (format "out/%s.el" symtable-default-in)))
    (symtable-query-rx htbl-file rx)))


;;;;;; Query prefixes

(defun symtable-query-pre (horhf prefix)
  "Return list of HORHF packages that have PREFIX.
HORHF is either a hash table or a file containing one.

For KEYS and VALUES of HORHF, see ‘symtable-h-make’.

A package has PREFIX if it defines any symbol that has PREFIX.

- If ‘symtable-sep-rx’ matches PREFIX's end, then the symbol has
PREFIX if the symbol starts with PREFIX.

- If ‘symtable-sep-rx’ does not match PREFIX's end, then the symbol
has PREFIX either if it's equal to PREFIX, or if it starts with
PREFIX followed by something that matches ‘symtable-sep-rx’."
  (symtable-query-rx horhf (symtable--query-make-pre-rx prefix)))

(defun symtable--query-make-pre-rx (prefix)
  "Make regexp for literal PREFIX using ‘symtable-sep-rx’."
  (let* ((pre  (regexp-quote prefix))
         (sep  symtable-sep-rx)
         (sep$ (format "%s$" sep)))
    (if (s-match sep$ pre)
        (format "^%s" pre)
      (format "^%s$\\|^%s%s" pre pre sep))))


;;;;;; Query any regexp

(defun symtable-query-rx (horhf rx)
  "Return list of HORHF packages that have a symbol matching RX.
HORHF is either a hash table or a file containing one.

For KEYS and VALUES of HORHF, see ‘symtable-h-make’."
  (let ((htbl  (symtable--read-h horhf))
        (res-h (h-new 1)))
    (h--each htbl
      (when (s-match rx key)
        (h-mix! res-h (h-as-set<-list value))))
    (-sort (-on #'string< #'h-as-string)
           (h-keys res-h))))


;;;;; Create hash table
;;;;;; Select input interactively and create output

;;;###autoload
(defun symtable-select (&optional h-file)
  "Read H-FILE and convert it."
  (interactive)
  (when h-file
    (unless (file-readable-p h-file)
      (error "Not readable: %s" h-file)))
  (let* ((dir (file-name-directory symtable--dot-el))
         (in  (expand-file-name "in/"  dir))
         (out (expand-file-name "out/" dir))
         (dem (format "%s.el" symtable-default-in)))
    (unless h-file
      (setq h-file (read-file-name "Select input file: " in dem t)))
    (setq out (expand-file-name
               (format "%s.el" (file-name-base h-file)) out))
    (symtable-h-write h-file out)))


;;;;;; From pack→symbols to symbol→packages hash tables

(defun symtable-h-write (horhf htable-file &optional h-fmt)
  "Given HORHF, write HTABLE-FILE.
HORHF is either a hash table or a file containing one.

For KEYS and VALUES of HORHF, see ‘symtable-h-make’.

H-FMT is the hash table format to use for writing the file.
When nil, default to :h*."
  (let ((res-h (symtable-h-make horhf)))
    (h-write-ht-like! htable-file (or h-fmt :h*) res-h)))

(defun symtable-h-make (horhf)
  "Given HORHF in packsyms format, output sympacks hash table.
HORHF is either a hash table or a file containing one.

HORHF's every KEY is a package, and its VALUE is a list of symbols
of a certain kind (e.g. functions) defined by the package. The keys
and list elements may be passed as either strings or symbols.

In the sympacks output, every symbol from the input's value's list
will become a KEY, and its VALUE will be the list of packages that
define that symbol."
  (let* ((sym-h (symtable--read-h horhf))
         ;; Avoid several resizes at the cost of an extra pass
         (size  (symtable--sum-of-length-of-values-lists sym-h))
         (res-h (h-new (ceiling (* 1.2 size))))
         (k) (v))
    (h--each sym-h
      (setq v (h-as-symbol key))
      (--each value
        (setq k (h-as-string it))
        (h-put! res-h k (cons v (h-get res-h k)))))
    res-h))

(defun symtable--sum-of-length-of-values-lists (horhf)
  "Given HORHF, add lengths of its values' lists.
For the meaning of HORHF, see ‘symtable--read-h’."
  (let ((htbl (symtable--read-h horhf))
        (sum 0))
    (h--each htbl
      (setq sum (+ sum (length value))))
    sum))


;;;;;;; Read hash table

(defun symtable--read-h (horhf)
  "Read HORHF: a hash table or a file containing one."
  (if (h? horhf) horhf (h-read-h horhf)))


;;;;; See README

;;;###autoload
(defun symtable-see-readme (&optional heading narrow)
  "Open symtable's README.org file.
Search for the file in symtable.el's directory.

If found, open it read-only.

If optional argument HEADING is passed, try to navigate to the
heading after opening it. HEADING should be a string.

If optional argument NARROW is non-nil, narrow to that heading.
This argument has no effect if HEADING is nil or not found."
  (interactive)
  (let ((readme symtable--readme-org))
    (if (file-exists-p readme)
        (let ((pr (make-progress-reporter
                   (format "Opening %s ... "
                           (abbreviate-file-name readme)))))
          (find-file-read-only readme)
          (when heading
            (symtable--goto-org-heading heading narrow))
          (progress-reporter-done pr))
      (message "Couldn't find %s's README.org" symtable--name))))

;;;###autoload
(defun symtable-see-news ()
  "See the News in symtable's README.org file."
  (interactive)
  (symtable-see-readme "News" 'narrow)
  (symtable--display-org-subtree))

(defun symtable--display-org-subtree ()
  "Selectively display org subtree."
  (let ((cmds '( outline-hide-subtree outline-show-children
                 outline-next-heading outline-show-branches)))
    (and (equal (mapcar #'fboundp cmds) '(t t t t))
         (mapc #'funcall cmds))))

(defun symtable--goto-org-heading (heading &optional narrow)
  "Navigate to org HEADING and optionally NARROW to it."
  (let* ((hrx (format "^[*]+ %s" heading))
         (pos (save-match-data
                (save-excursion
                  (save-restriction
                    (widen)  (goto-char (point-max))
                    (re-search-backward hrx nil t 1))))))
    (when pos
      (widen)  (goto-char pos)
      (if (and narrow (fboundp 'org-narrow-to-subtree))
          (org-narrow-to-subtree)
        (recenter-top-bottom 1))
      (when (fboundp 'outline-show-subtree)
        (outline-show-subtree))
      (when (fboundp 'org-flag-drawer)
        (save-excursion
          (forward-line 1)
          (org-flag-drawer t))))))


;;;; Wrapping up

(provide 'symtable)

;; Local Variables:
;; coding:                     utf-8
;; indent-tabs-mode:           nil
;; sentence-end-double-space:  nil
;; outline-regexp:             ";;;;* "
;; End:

;;; symtable.el ends here