Fix mines-mode

.gitignore

@@ -6,3 +6,4 @@
 /tramp
 /dape-breakpoints
 flycheck_init.el
+local-init.el*

README.md

@@ -6,4 +6,4 @@ course, editing text. Most of the configuration is in `init.el`. I use
 configuration start.
 
 The `elisp` directory holds some extra configuration for specific things that I
-thought was too big to fit into `init.el`.
+thought were too big to fit into `init.el`.

disabled.el

@@ -109,72 +109,240 @@
 ;;     "Hook to do stuff in llama buffers."
 ;;     (auto-fill-mode -1)))
 
-;; sly
-;; (use-package sly
-;;   :hook (lisp-mode . my/-lisp-mode-autoconnect-sly)
-;;   :bind (:map sly-mode-map
-;;          ("C-c e" . my/sly-show-notes-at-point))
-;;   :autoload sly-connected-p
-;;   :init
-;;   (defun my/-lisp-mode-autoconnect-sly ()
-;;     (unless (sly-connected-p)
-;;       (sly)))
-;;   (defun my/sly-notes-at-point (pos &optional buffer)
-;;     "Returns the sly notes at POS in BUFFER.
-;; If BUFFER is nil, the current buffer is used."
-;;     (with-current-buffer (or buffer (current-buffer))
-;;       (cl-loop for overlay in (overlays-at pos)
-;;                for note = (overlay-get overlay 'sly-note)
-;;                when note
-;;                collect note)))
-;;   (defun my/sly-show-notes-at-point ()
-;;     "Show all sly notes at point in a floating window."
-;;     (interactive)
-;;     (my/floating-tooltip " *sly-note-posframe*"
-;;                          (with-output-to-string
-;;                            (dolist (note (my/sly-notes-at-point (point)))
-;;                              (when-let  (msg (plist-get note :message))
-;;                                (princ "·")
-;;                                (princ msg)
-;;                                (terpri))))))
-;;   (setq inferior-lisp-program "/usr/bin/sbcl")
+;; company (in buffer auto-complete)
+;; (use-package company
+;;   :defer nil
+;;   :bind (("M-TAB" . company-complete)
+;;          ("M-<tab>" . company-complete)
+;;          ("C-c f" . company-files)
+;;          ([remap dabbrev-expand] . company-dabbrev)
+;;          :map prog-mode-map
+;;          ([remap company-dabbrev] . company-dabbrev-code))
+;;   :hook ((company-search-mode . my/-company-search-mode-add-lighter)
+;;          (sh-mode . my/-company-setup-shell-mode))
 ;;   :config
-;;   (sly-symbol-completion-mode -1))
-
-;; corfu (autocomplete)
-;; (use-package corfu
-;;   :bind (("M-<tab>" . completion-at-point)
-;;          :map corfu-map
-;;          ("M-SPC" . corfu-insert-separator)
-;;          ("M-m" . my/corfu-move-to-minibuffer))
-;;   :init
-;;   (defun my/corfu-move-to-minibuffer ()
-;;     (interactive)
-;;     (when completion-in-region--data
-;;       (let ((completion-extra-properties corfu--extra)
-;;             completion-cycle-threshold completion-cycling)
-;;         (apply #'consult-completion-in-region completion-in-region--data))))
-;;   (setq corfu-cycle t
-;;         corfu-auto t
-;;         corfu-on-exact-match nil
-;;         completion-cycle-threshold nil)
-;;   (global-corfu-mode 1)
-;;   (corfu-popupinfo-mode 1)
+;;   (defun my/-company-setup-shell-mode ()
+;;     (setq-local company-backends '(company-files company-keywords
+;;                                                  company-dabbrev-code)))
+;;   (defun my/-company-search-mode-add-lighter ()
+;;     (if company-search-mode
+;;         (cl-pushnew company-search-lighter global-mode-string :test 'equal)
+;;       (setq global-mode-string
+;;             (cl-delete company-search-lighter global-mode-string :test 'equal))))
+;;   (defun my/-company-set-completion-styles (oldfun &rest args)
+;;     (let ((completion-styles '(basic emacs21 flex)))
+;;       (apply oldfun args)))
+;;   (advice-add 'company-capf :around 'my/-company-set-completion-styles)
+;;   (setopt company-format-margin-function #'company-text-icons-margin
+;;           company-require-match nil
+;;           company-tooltip-align-annotations t)
+;;   (setq company-transformers '(company-sort-by-occurrence))
+;;   (global-company-mode 1))
+;; (use-package company-quickhelp
+;;   :bind (:map company-active-map
+;;          ("M-h" . company-quickhelp-manual-begin))
+;;   :after company
 ;;   :config
-;;   (add-to-list 'corfu-continue-commands #'my/corfu-move-to-minibuffer))
-;; (use-package corfu-terminal
-;;   :init
-;;   (corfu-terminal-mode 1))
+;;   (company-quickhelp-mode 1)
+;;   (setopt company-quickhelp-delay nil))
 
-;; ;; cape (a bunch of capfs!)
-;; (use-package cape
-;;   :bind (("C-c p" . cape-dabbrev)
-;;          ([remap dabbrev-expand] . cape-dabbrev)
-;;          ("C-c P" . cape-line)
-;;          ("C-c f" . cape-file))
-;;   :hook (text-mode . my/-cape-setup-text-mode)
+;; (La)TeX
+;; (use-package tex-mode
+;;   :hook ((latex-mode . eglot-ensure)
+;;          (tex-mode . my/-setup-tex-mode-compile-command))
 ;;   :init
-;;   (defun my/-cape-setup-text-mode ()
-;;     (setq-local completion-at-point-functions
-;;                 '(cape-dict cape-dabbrev)
-;;                 corfu-auto nil)))
+;;   (defun my/-setup-tex-mode-compile-command ()
+;;     "Setup `compile-command' for `tex-mode'."
+;;     (let ((quoted-name (shell-quote-argument buffer-file-name)))
+;;       (setq-local compile-command
+;;                   (concat "latexmk -pdf "
+;;                           "-auxdir=" quoted-name "-build"
+;;                           " " quoted-name))))
+;;   :config
+;;   (add-to-list 'auto-mode-alist '("/\\.latexmkrc\\'" . perl-mode)))
+
+;; flyspell
+;; (use-package flyspell
+;;   :hook
+;;   (((text-mode message-mode tex-mode) . flyspell-mode)
+;;    (prog-mode . flyspell-prog-mode))
+;;   :config
+;;   (setq ispell-program-name "hunspell"
+;;         flyspell-issue-message-flag nil
+;;         flyspell-issue-welcome-flag nil)
+;;   (define-key flyspell-mode-map (kbd "C-;") nil t)
+;;   (define-key flyspell-mode-map (kbd "C-,") nil t))
+
+;; (use-package aggressive-indent
+;;   :hook (prog-mode . aggressive-indent-mode)
+;;   :config
+;;   (add-to-list 'aggressive-indent-protected-commands
+;;                #'evil-undo))
+
+;; ;; easier identification of local variables
+;; (use-package color-identifiers-mode
+;;   :hook (prog-mode . color-identifiers-mode-maybe)
+;;   :init
+;;   (setq color-identifiers:num-colors 10
+;;         color-identifiers:recoloring-delay 0.5)
+;;   :config
+;;   ;; make sure that remapped treesitter modes are handled
+;;   (defun my/color-identifiers-mode-remap-ts-modes ()
+;;     (dolist (entry color-identifiers:modes-alist)
+;;       (cl-destructuring-bind (mode &rest props) entry
+;;         (when-let ((remapped-mode (alist-get mode major-mode-remap-alist))
+;;                    ((string-match-p "-ts-" (symbol-name remapped-mode)))
+;;                    ((not (assq remapped-mode color-identifiers:modes-alist))))
+;;           ;; no need to test with `add-to-list'
+;;           (push (cons remapped-mode props) color-identifiers:modes-alist)))))
+;;   (my/color-identifiers-mode-remap-ts-modes)
+;;   (setf (alist-get 'lisp-interaction-mode color-identifiers:modes-alist)
+;;         (alist-get 'emacs-lisp-mode color-identifiers:modes-alist))
+;;   (defun my/-color-identifiers-elisp-handle-let-like (sexp output)
+;;     (cl-destructuring-bind (_name &optional vars &rest body) sexp
+;;       (dolist (entry vars body)
+;;         (cond
+;;          ((and entry (symbolp entry)) (puthash entry t output))
+;;          ((and (car entry) (symbolp (car entry)))
+;;           (puthash (car entry) t output))))))
+;;   (defun my/-color-identifiers-parse-lambda-list (list output)
+;;     (dolist (entry list)
+;;       (cond
+;;        ((and entry (symbolp entry)
+;;              (not (string-prefix-p ":" (symbol-name entry)))
+;;              (not (string-prefix-p "&" (symbol-name entry))))
+;;         (puthash entry t output))
+;;        ((and (car-safe entry) (symbolp (car entry)))
+;;         (puthash (car entry) t output)))))
+;;   (defun my/-color-identifiers-elisp-handle-destructing-bind-like
+;;       (sexp output)
+;;     (cl-destructuring-bind (_name &optional vars &rest expr-and-body) sexp
+;;       (my/-color-identifiers-parse-lambda-list vars output)
+;;       expr-and-body))
+;;   (defun my/-color-identifiers-elisp-handle-defun-like
+;;       (sexp output)
+;;     (cl-destructuring-bind (_name _func &optional vars &rest body) sexp
+;;       (my/-color-identifiers-parse-lambda-list vars output)
+;;       body))
+;;   (defun my/-color-identifiers-elisp-handle-dolist-like
+;;       (sexp output)
+;;     (cl-destructuring-bind (_name &optional spec &rest body) sexp
+;;       (cl-destructuring-bind (&optional var &rest forms) spec
+;;         (when (symbolp var)
+;;           (puthash var t output))
+;;         (append body forms))))
+;;   (defun my/-color-identifiers-elisp-handle-loop (sexp output)
+;;     (let (body-forms)
+;;       (cl-maplist
+;;        (lambda (kwds)
+;;          (cl-case (car kwds)
+;;           (for ;; this could be a dotted list
+;;            (let ((tail (ensure-list (cadr kwds))))
+;;              (while tail
+;;                (when (and (consp tail) (symbolp (car tail)))
+;;                  (puthash (car tail) t output))
+;;                (when (and (consp tail) (symbolp (cdr tail)))
+;;                  (puthash (cdr tail) t output))
+;;                (setq tail (cdr-safe tail)))))
+;;           (using
+;;            (when (and (listp (cdr kwds))
+;;                       (symbolp (cl-second (cdr kwds))))
+;;              (puthash (cl-second (cdr kwds)) t output)))
+;;           ((with into)
+;;            (when (symbolp (cadr kwds))
+;;              (puthash (cadr kwds) t output)))
+;;           (t
+;;            (unless (atom (car kwds))
+;;              (push (car kwds) body-forms)))))
+;;        (cdr sexp))
+;;       body-forms))
+;;   (defun my/-color-identifiers-elisp-handle-do-like (sexp output)
+;;     (let ((eval-forms))
+;;       (cl-destructuring-bind (name &optional vars test-forms &rest body) sexp
+;;         (dolist (entry vars (append eval-forms test-forms body))
+;;           (cl-destructuring-bind (&optional var init step &rest _)
+;;               entry
+;;             (when (symbolp var)
+;;               (puthash var t output)
+;;               (cl-callf nconc eval-forms (list init step))))))))
+;;   (defvar my/-color-identifiers-eslip-handlers
+;;     (let ((table (make-hash-table)))
+;;       (puthash 'quote #'ignore table)
+;;       (puthash 'function #'ignore table)
+;;       (puthash 'let #'my/-color-identifiers-elisp-handle-let-like table)
+;;       (puthash 'let* #'my/-color-identifiers-elisp-handle-let-like table)
+;;       (puthash 'cl-destructuring-bind
+;;                #'my/-color-identifiers-elisp-handle-destructing-bind-like table)
+;;       (puthash 'with-slots
+;;                #'my/-color-identifiers-elisp-handle-destructing-bind-like table)
+;;       (puthash 'lambda
+;;                #'my/-color-identifiers-elisp-handle-destructing-bind-like table)
+;;       (puthash 'cl-function
+;;                #'my/-color-identifiers-elisp-handle-destructing-bind-like table)
+;;       (puthash 'defun
+;;                #'my/-color-identifiers-elisp-handle-defun-like table)
+;;       (puthash 'cl-defun
+;;                #'my/-color-identifiers-elisp-handle-defun-like table)
+;;       (puthash 'defmacro
+;;                #'my/-color-identifiers-elisp-handle-defun-like table)
+;;       (puthash 'cl-defmacro
+;;                #'my/-color-identifiers-elisp-handle-defun-like table)
+;;       (puthash 'cl-defmacro
+;;                #'my/-color-identifiers-elisp-handle-defun-like table)
+;;       (puthash 'cl-loop
+;;                #'my/-color-identifiers-elisp-handle-loop table)
+;;       (puthash 'dolist
+;;                #'my/-color-identifiers-elisp-handle-dolist-like table)
+;;       (puthash 'dotimes
+;;                #'my/-color-identifiers-elisp-handle-dolist-like table)
+;;       (puthash 'cl-dolist
+;;                #'my/-color-identifiers-elisp-handle-dolist-like table)
+;;       (puthash 'cl-dotimes
+;;                #'my/-color-identifiers-elisp-handle-dolist-like table)
+;;       (puthash 'cl-do
+;;                #'my/-color-identifiers-elisp-handle-do-like table)
+;;       table)
+;;     "A list of functions that find declarations in variables.
+;; This is used in `my/-color-identifiers-elisp-declarations-in-sexp'.  It is a
+;; hash table of function (or macro) names and a function that handles them.  The
+;; functions should be of two arguments.  The first is the sexp to parse.  The
+;; second is a hash table with the keys being the symbols of local variables.  The
+;; function should return a list of the forms that it contains that should be
+;; recursively searched.")
+;;   (defun my/-color-identifiers-lisp-declarations-in-sexp (sexp output table)
+;;     "Get all of the variable declarations in SEXP and place them in OUTPUT.
+;; OUTPUT is a hash table. TABLE is a table like
+;; `my/-color-identifiers-elisp-declarations-in-sexp'."
+;;     (let ((stack (list sexp)))
+;;       (while (and stack (not (input-pending-p)))
+;;         (let ((entry (pop stack)))
+;;           (when (proper-list-p entry)
+;;             (if-let ((handler (gethash (car entry) table)))
+;;                 (cl-callf nconc stack
+;;                   (copy-sequence (funcall handler entry output)))
+;;               (cl-callf nconc stack
+;;                 (copy-sequence (cdr entry)))))))))
+;;   (defun my/-color-identifiers-lisp-declarations-in-buffer (&optional buffer)
+;;     (let ((result (make-hash-table)))
+;;       (save-excursion
+;;         (goto-char (point-min))
+;;         (condition-case nil
+;;             (while t
+;;               (condition-case nil
+;;                   (let ((sexp (read (or buffer (current-buffer)))))
+;;                     (my/-color-identifiers-lisp-declarations-in-sexp
+;;                      sexp result my/-color-identifiers-eslip-handlers))
+;;                 (invalid-read-syntax nil)))
+;;           (end-of-file nil))
+;;         (let ((names))
+;;           (maphash (lambda (k _v)
+;;                      (unless (or (eq k t) (not k) (boundp k))
+;;                        (push (symbol-name k) names)))
+;;                    result)
+;;           names))))
+;;   (color-identifiers:set-declaration-scan-fn
+;;    'emacs-lisp-mode
+;;    'my/-color-identifiers-lisp-declarations-in-buffer)
+;;   (color-identifiers:set-declaration-scan-fn
+;;    'lisp-interaction-mode
+;;    'my/-color-identifiers-lisp-declarations-in-buffer))

elisp/corfu-terminal-popupinfo.el

@@ -0,0 +1,311 @@
+;;; corfu-terminal-popupinfo.el --- corfu-popupinfo support in the terminal -*- lexical-binding: t -*-
+
+;;; Commentary:
+;; To make use of this file, simply `require' it, and then enable
+;; `corfu-terminal-popupinfo-mode', which is a global mode.  Note that
+;; `corfu-terminal-mode' MUST be loaded and enabled for this to work.
+
+;;; Code:
+(require 'popon)
+(require 'corfu-terminal)
+(require 'corfu-popupinfo)
+(require 'cl-lib)
+
+(defvar ctp--popon nil
+  "The current popon, or nil if there is none.")
+
+(defvar ctp--buffer nil
+  "The buffer holding the current candidate's documentation.")
+
+(defun ctp--get-buffer ()
+  "Create or return `ctp--buffer'."
+  (unless (and (bufferp ctp--buffer) (buffer-live-p ctp--buffer))
+    (setq ctp--buffer (generate-new-buffer " *corfu-terminal-popupinfo*" t)))
+  ctp--buffer)
+
+(defun ctp--visible-p ()
+  "Return non-nil if the terminal popup window is visible."
+  (popon-live-p ctp--popon))
+
+(defun ctp--corfu-popupinfo--visible-p-advice (oldfun &optional frame)
+  "Advice for `corfu-popupinfo--visible-p'.
+If FRAME is nil, this will return `ctp--visible-p'.  If
+FRAME is `corfu--frame', this will return weather the `corfu-terminal--popon' is
+live or not.
+
+As this is :around advice, OLDFUN is the real (advised) function to call."
+  (cond
+   ((and (not frame) (ctp--visible-p)))
+   ((and (eq frame corfu--frame) (popon-live-p corfu-terminal--popon)))
+   ((funcall oldfun frame))))
+
+(defun ctp--close ()
+  "Close the popon."
+  (popon-kill ctp--popon)
+  (setq ctp--popon nil))
+
+(defalias 'ctp--corfu-popupinfo--hide-advice 'ctp--close
+  "Advice for `corfu-popupinfo--hide' that works in the terminal.")
+
+(defun ctp--load-content (candidate buffer)
+  "Load the documentation for CANDIDATE into BUFFER."
+  (when-let ((content (funcall corfu-popupinfo--function candidate)))
+    ;; A bunch of this comes straight from `corfu-popupinfo--show'
+    (with-current-buffer buffer
+      (dolist (var corfu-popupinfo--buffer-parameters)
+        (set (make-local-variable (car var)) (cdr var)))
+      (with-silent-modifications
+        (erase-buffer)
+        (insert content)
+        ;; popon.el requires that each line be of the same width. As we are in
+        ;; the terminal, we assume that each character is the same width (and
+        ;; we can't do anything, or even know, if this is not the case). Thus,
+        ;; we run over the buffer to pad out each line to the width of the
+        ;; longest line.
+        (goto-char (point-min))
+        (let ((wrap-p (and (not truncate-lines) word-wrap))
+              (longest-line 0))
+          (cl-block nil
+            (while (not (eobp))
+              (let ((len (- (pos-eol) (pos-bol))))
+                (when (> len longest-line)
+                  (setq longest-line len))
+                (when (and wrap-p (> longest-line corfu-popupinfo-max-width))
+                  (setq longest-line corfu-popupinfo-max-width)
+                  (cl-return)))
+              (forward-line)))
+          (setq-local fill-column longest-line)
+          (when wrap-p
+            (fill-region (point-min) (point-max)))
+          (goto-char (point-min))
+          (while (not (eobp))
+            (end-of-line)
+            (let ((len (- (point) (pos-bol))))
+              (when (< len longest-line)
+                (insert (make-string (- longest-line len) ? ))))
+            (forward-line))))
+      (goto-char (point-min))
+      (put-text-property (point-min) (point-max) 'face 'corfu-popupinfo)
+      (when-let ((m (memq 'corfu-default (alist-get 'default face-remapping-alist))))
+        (setcar m 'corfu-popupinfo)))
+    ;; We succeeded in loading the data
+    t))
+
+(defun ctp--popon-position (buffer)
+  "Find a good position to open the popon for BUFFER's content.
+Return a list of the position, the max line length that can be shown, and the
+max height that can be shown.  Each line of BUFFER _MUST_ be the same lenght."
+  (when-let ((point-posn (posn-at-point))
+             (point-x (car (posn-x-y point-posn)))
+             (point-y (cdr (posn-x-y point-posn))))
+    (with-current-buffer buffer
+      (when-let ((completion-pos (popon-position corfu-terminal--popon))
+                 (completion-size (popon-size corfu-terminal--popon))
+                 (comp-x (car completion-pos))
+                 (comp-y (cdr completion-pos))
+                 (comp-w (car completion-size))
+                 (comp-h (cdr completion-size))
+                 (win-w (window-max-chars-per-line))
+                 (win-h (window-body-height))
+                 (line-len (- (pos-eol) (pos-bol)))
+                 (num-lines (count-lines (point-min) (point-max))))
+        (let* ((align 'row)
+               (width (min line-len corfu-popupinfo-max-width))
+               (pop-x (cond
+                       ((<= (+ comp-x comp-w width) win-w)
+                        (+ comp-x comp-w))
+                       ((>= (- comp-x width) 0)
+                        (- comp-x width))
+                       ((<= (+ comp-x width) win-w)
+                        (setq align 'col)
+                        comp-x)
+                       ((>= (- win-w width) 0)
+                        (setq align 'col)
+                        (- win-w width))
+                       (t
+                        (setq align 'col
+                              width win-w)
+                        0)))
+               (height (min num-lines corfu-popupinfo-max-height))
+               (pop-y (cl-case align
+                        (row (if (<= (+ comp-y height) win-h)
+                                 comp-y
+                               (max 0 (- win-h height))))
+                        (col (cond
+                              ((<= (+ comp-y comp-h height)
+                                   (- win-h scroll-margin))
+                               (+ comp-y comp-h))
+                              ;; If the completion dialog is above the point
+                              ((and (< comp-y point-y)
+                                    (>= (- comp-y height) 0))
+                               (- comp-y height))
+                              ;; Emacs seems to hide the current text if this
+                              ;; number is 1 (I think it's too close to two
+                              ;; overlays)
+                              ((>= (- comp-y height 2) 0)
+                               (- comp-y height 2))
+                              (t (+ comp-y comp-h)))))))
+          (list (cons pop-x pop-y) width height))))))
+
+(defun ctp--extract-content (buffer width height)
+  "Extract the content from BUFFER for a popon.
+The content extracted is for a popon of size WIDTH by HEIGHT."
+  (let (start end)
+    (with-current-buffer buffer
+      ;; we assume that we are scrolled to the start of the region we care about
+      (save-excursion
+        (let ((rem-lines (count-lines (point) (point-max))))
+          (when (< rem-lines height)
+            (forward-line (- rem-lines height))))
+        (setq start (point)
+              end (pos-eol height))))
+    (with-temp-buffer
+      (insert-buffer-substring buffer start end)
+      (goto-char (point-min))
+      (cl-loop repeat height
+               until (eobp) do
+               (let ((len (- (pos-eol) (pos-bol))))
+                 (when (> len width)
+                   (delete-region (+ (pos-bol) width) (pos-eol))))
+               (forward-line))
+      ;; "delete" the rest of the lines
+      (narrow-to-region (point-min) (point))
+      (buffer-string))))
+
+(defun ctp--display-buffer (buffer)
+  "Display or redisplay BUFFER in a popon."
+  (let ((inhibit-redisplay t))
+    (cl-destructuring-bind (&optional pos width height)
+        (ctp--popon-position buffer)
+      (popon-kill ctp--popon)
+      (when-let ((pos)
+                 (content (ctp--extract-content buffer width height)))
+        (setq ctp--popon
+              ;; appear behind the auto-complete window, in case something
+              ;; happens
+              (popon-create content pos nil nil 100))))))
+
+(defun ctp--corfu-popupinfo--show-advice (oldfun candidate)
+  "Advice for `corfu-popupinfo--show' that works in the terminal.
+CANDIDATE is the same as for `corfu-popupinfo--show'.  As this is meant to be
+:around advice, OLDFUN is assumed to be the real (advised) function."
+  (if (display-graphic-p)
+      (progn
+        (popon-kill ctp--popon)
+        (funcall oldfun candidate))
+    (when corfu-popupinfo--timer
+      (cancel-timer corfu-popupinfo--timer)
+      (setq corfu-popupinfo--timer nil))
+    (when (and (frame-live-p corfu-popupinfo--frame)
+               (frame-visible-p corfu-popupinfo--frame))
+      (corfu--hide-frame corfu-popupinfo--frame))
+    (when (or (not (ctp--visible-p))
+              (not (corfu--equal-including-properties
+                    candidate corfu-popupinfo--candidate)))
+      (let ((buf (ctp--get-buffer)))
+        (if (ctp--load-content candidate buf)
+            (progn
+              (ctp--display-buffer buf)
+              (setq corfu-popupinfo--candidate candidate
+                    corfu-popupinfo--toggle t))
+          (corfu-popupinfo--hide))))))
+
+(defun ctp--move-away-from-eob ()
+  "Ensure the point isn't too close to the end of the buffer."
+  (if-let ((total-lines (count-lines (point-min) (point-max)))
+           ((> total-lines corfu-popupinfo-max-height))
+           (rem-lines (count-lines (point) (point-max)))
+           ((< rem-lines corfu-popupinfo-max-height)))
+      (forward-line (- (- corfu-popupinfo-max-height rem-lines)))))
+
+(defun ctp--corfu-popupinfo-scroll-up-advice
+    (oldfun &optional n)
+  "Advice for `corfu-popupinfo-scroll-up'.
+N is the number of lines.  As this is :around advice, OLDFUN is the real
+\(advised) function."
+  (if (ctp--visible-p)
+      (let ((buf (ctp--get-buffer)))
+        (with-current-buffer buf
+          (forward-line n)
+          (beginning-of-line)
+          (ctp--move-away-from-eob))
+        (ctp--display-buffer buf))
+    (funcall oldfun n)))
+
+(defun ctp--corfu-popupinfo-end-advice (oldfun &optional n)
+  "Advice for `corfu-popupinfo-end'.
+N is the same as for `corfu-popupinfo-end'.  As this is :around advice, OLDFUN
+is the real (advised) function."
+  (if (ctp--visible-p)
+      (let ((buf (ctp--get-buffer)))
+        (with-current-buffer buf
+          (let ((size (- (point-max) (point-min))))
+            (goto-char (if n
+                           (- (point-max) (/ (* size n) 10))
+                         (point-max))))
+          (beginning-of-line)
+          (ctp--move-away-from-eob))
+        (ctp--display-buffer buf))
+    (funcall oldfun n)))
+
+(defun ctp--corfu--popup-hide-advice ()
+  ":after advice for `corfu--popup-hide'."
+  (unless completion-in-region-mode
+    (ctp--close)))
+
+(defun ctp--enable ()
+  "Enable corfu terminal popupinfo by advising some corfu functions."
+  (advice-add 'corfu-popupinfo--visible-p :around
+              'ctp--corfu-popupinfo--visible-p-advice)
+  (advice-add 'corfu-popupinfo--hide :after
+              'ctp--corfu-popupinfo--hide-advice)
+  (advice-add 'corfu-popupinfo--show :around
+              'ctp--corfu-popupinfo--show-advice)
+  (advice-add 'corfu-popupinfo-scroll-up :around
+              'ctp--corfu-popupinfo-scroll-up-advice)
+  (advice-add 'corfu-popupinfo-end :around
+              'ctp--corfu-popupinfo-end-advice)
+  (advice-add 'corfu--popup-hide :after
+              'ctp--corfu--popup-hide-advice))
+
+(defun ctp--disable ()
+  "Disable corfu terminal popupinfo by remove advice added by `ctp--enable'."
+  (ctp--close)
+  (advice-remove 'corfu-popupinfo--visible-p
+                 'ctp--corfu-popupinfo--visible-p-advice)
+  (advice-remove 'corfu-popupinfo--hide
+                 'ctp--corfu-popupinfo--hide-advice)
+  (advice-remove 'corfu-popupinfo--show
+                 'ctp--corfu-popupinfo--show-advice)
+  (advice-remove 'corfu-popupinfo-scroll-up
+                 'ctp--corfu-popupinfo-scroll-up-advice)
+  (advice-remove 'corfu-popupinfo-end
+                 'ctp--corfu-popupinfo-end-advice)
+  (advice-remove 'corfu--popup-hide
+                 'ctp--corfu--popup-hide-advice))
+
+(defun ctp--corfu-terminal-mode-hook ()
+  "Hook run from `corfu-terminal-mode-hook'."
+  (if (and corfu-terminal-mode
+           (bound-and-true-p corfu-terminal-popupinfo-mode))
+      (ctp--enable)
+    (ctp--disable)))
+
+;;;###autoload
+(define-minor-mode corfu-terminal-popupinfo-mode
+  "Minor mode shows the `corfu-popupinfo-mode' popup in the terminal.
+Note that even with this enabled, you still need to enable the actual popup
+using `corfu-popupinfo-toggle'.  Also, this does not do anything if
+`corfu-terminal-mode' is not enabled."
+  :global t
+  :group 'corfu-terminal-popupinfo
+  (if corfu-terminal-popupinfo-mode
+      (progn
+        (add-hook 'corfu-terminal-mode-hook 'ctp--corfu-terminal-mode-hook)
+        (when corfu-terminal-mode
+          (ctp--enable)))
+    (remove-hook 'corfu-terminal-mode-hook 'ctp--corfu-terminal-mode-hook)
+    (ctp--disable)))
+
+(provide 'corfu-terminal-popupinfo)
+;;; corfu-terminal-popupinfo.el ends here

elisp/firejail-mode.el

@@ -1,134 +1,862 @@
 ;;; firejail-mode --- Major mode for editing firejail profiles -*- lexical-binding: t -*-
 ;;; Commentary:
 ;;; Code:
+(require 'find-file)
+(require 'custom)
+(require 'thingatpt)
+(require 'man)
+
+(eval-when-compile
+  (require 'rx))
+
+(defgroup firejail-mode ()
+  "Major mode for editing Firejail profiles."
+  :group 'programming
+  :prefix "firejail-")
+
+(defcustom firejail-executable "firejail"
+  "Executable to use when calling firejail."
+  :tag "Executable"
+  :group 'firejail-mode
+  :type 'string)
+
+(defcustom firejail-include-search-directories
+  '("./" "~/.config/firejail/" "/etc/firejail/" "/usr/local/etc/firejail/")
+  "List of directories to search for include files."
+  :tag "Include Search Directories"
+  :group 'firejail-mode
+  :type '(repeat string))
+
+(defcustom firejail-include-search-suffixes
+  '("inc" "local" "profile")
+  "List of file suffixes to use when searching for include files.
+These should _NOT_ have a leading period."
+  :tag "Include Search Suffixes"
+  :group 'firejail-mode
+  :type '(repeat string))
+
+(defcustom firejail-include-ignored-files
+  '(".git/")
+  "List of file names that should be ignored when searching for include files.
+These should end with a slash (/) if their are a directory."
+  :tag "Include Ignored Files"
+  :group 'firejail-mode
+  :type '(repeat string))
+
+(defface firejail-error-face
+  '((t :background "red"))
+  "Face for reporting Firejail syntax errors."
+  :tag "Error Face"
+  :group 'firejail-mode)
+
+(defun firejail--debug-output-to-list (&rest args)
+  "Convert the output from one of Firejail's --debug-* commands to a list.
+ARGS are passed uncaged to Firejail and should include the proper debug command."
+  (ignore-error file-missing
+    (mapcan (lambda (line)
+              (when (string-match (rx "- " (group (+ any)) eol) line)
+                (list (match-string 1 line))))
+            (apply 'process-lines firejail-executable args))))
+
+(defconst firejail--known-caps
+  (firejail--debug-output-to-list "--debug-caps")
+  "A list of known Linux capabilities.
+This will probably be empty on anything but Linux.")
+
+(defconst firejail--known-syscalls64
+  (firejail--debug-output-to-list "--debug-syscalls")
+  "A list of known 64 bit system calls.
+This will probably be empty on anything by Linux.")
+
+(defconst firejail--known-syscalls32
+  (firejail--debug-output-to-list "--debug-syscalls32")
+  "A list of known system 32 bit calls.
+This will probably be empty on anything by Linux.")
+
+(defconst firejail--known-errnos
+  (firejail--debug-output-to-list "--debug-errnos")
+  "A list of known system 32 bit calls.
+This will probably be empty on anything by Linux.")
+
+(defconst firejail--known-conditionals
+  '("HAS_APPIMAGE" "HAS_NET" "HAS_NODBUS" "HAS_NOSOUND" "HAS_PRIVATE"
+    "HAS_X11" "ALLOW_TRAY" "BROWSER_DISABLE_U2F" "BROWSER_ALLOW_DRM")
+  "List of conditionals known to Firejail.")
+
+(defun firejail--list-dbus-services (bus)
+  "List all DBus services on BUS.
+BUS is one of `:system' or `:session'."
+  (ignore-errors
+    (require 'dbus nil t)
+    (when (fboundp 'dbus-call-method) ;; silence byte compiler
+      (dbus-call-method bus "org.freedesktop.DBus" "/org/freedesktop/DBus"
+                        "org.freedesktop.DBus" "ListNames"))))
+
+(defun firejail--insert-entire-special-file (file)
+  "Insert all of FILE (e.g. /proc/cpuinfo), even if it's special."
+  (while (>= (cl-second (insert-file-contents file nil (1- (point))
+                                              (+ (point) 9999)))
+             10000)
+    (goto-char (point-max))))
+
+(defvar-local firejail--num-cpus-cache nil
+  "The number of CPUs the current system has.
+This might be nil on platforms other than Linux.")
+
+(defun firejail--get-num-cpus ()
+  "Return the number of CPUs the current system has."
+  (if (local-variable-p 'firejail--num-cpus-cache)
+      firejail--num-cpus-cache
+    (ignore-error file-missing
+      (with-temp-buffer
+        (firejail--insert-entire-special-file "/proc/cpuinfo")
+        (goto-char (point-max))
+        (when (re-search-backward (rx bol "processor" blank ":" blank
+                                      (group (+ digit)) eol))
+          (setq firejail--num-cpus-cache
+                (string-to-number (match-string-no-properties 1))))))))
+
+(defun firejail--find-next-glob-char (limit)
+  "Find the next glob char between point and LIMIT."
+  (let ((max-lisp-eval-depth 10000))
+    (when (search-forward "*" limit t)
+      (backward-char)
+      (if (not (eq t (nth 5 (syntax-ppss))))
+          (progn
+            (looking-at (regexp-quote "*"))
+            (forward-char)
+            t)
+        (forward-char)
+        (firejail--find-next-glob-char limit)))))
+
+(defun firejail--generate-documentation-table ()
+  "Parse the firejail-profile(5) man page to get a documentation table."
+  (ignore-error file-missing
+    (let ((path (car (process-lines-handling-status
+                      manual-program (lambda (status)
+                                       (when (not (zerop status))
+                                         (signal 'file-missing "")))
+                      "-w" "firejail-profile")))
+          (ht (make-hash-table)))
+      (with-temp-buffer
+        ;; Emacs will auto unzip this if needed
+        (insert-file-contents path)
+        (when (re-search-forward (rx bol ".TP\n"
+                                     bol "\\fBinclude other.profile" eol)
+                                 nil t)
+          (forward-line -1)
+          (while (and (not (looking-at-p (rx bol ".SH FILES" eol)))
+                      (re-search-forward (rx bol ".TP\n" bol
+                                             "\\fB" (group
+                                                     (+ (not (any "\n" blank)))))
+                                         nil t))
+            (let ((name (intern (match-string-no-properties 1)))
+                  (start (+ 3 (pos-bol))))
+              (when (re-search-forward (rx bol ".TP" eol) nil t)
+                (forward-line -1)
+                (when (looking-at-p (rx bol eol))
+                  (forward-line -1))
+                (let* ((raw-doc (buffer-substring-no-properties
+                                 start (pos-eol)))
+                       (new-doc (replace-regexp-in-string (rx bol ".br" eol)
+                                                          "\n" raw-doc))
+                       (cur-doc (gethash name ht)))
+                  (puthash name (concat cur-doc
+                                        (when cur-doc "\n\n")
+                                        new-doc)
+                           ht)))))))
+      ;; some manual fixing
+      (cl-macrolet ((summary (dir text)
+                      `(let ((old-val (gethash ',dir ht)))
+                         (puthash ',dir (concat (symbol-name ',dir) "\n"
+                                                ,text (when old-val "\n\n")
+                                                old-val)
+                                  ht))))
+        (summary net "Enable a new network namespace.")
+        (summary bind "Mount bind directories or files."))
+      ht)))
+
+(defvar-local firejail--documentation-table nil
+  "Table mapping Firejail directives to their documentation.")
+
+(defun firejail--documentation-for (dir)
+  "Lookup the documentation for DIR."
+  (unless firejail--documentation-table
+    (setq firejail--documentation-table
+          (firejail--generate-documentation-table)))
+  (gethash (intern-soft dir) firejail--documentation-table))
 
 (defconst firejail-profile-font-lock-keywords
-  (let* ((normal '("quiet" "include" "noblacklist" "nowhitelist"
-                   "blacklist" "blacklist-nolog" "bind" "disable-mnt"
-                   "keep-config-pulse" "keep-dev-shm" "keep-var-tmp"
-                   "mkdir" "mkfile" "noexec" "private" "private-bin"
-                   "private-cache" "private-cwd" "private-dev"
-                   "private-etc" "private-home" "private-lib"
-                   "private-opt" "private-srv" "private-tmp"
-                   "read-only" "read-write" "tmpfs" "tracelog"
-                   "whitelist" "whitelist-ro" "writable-etc"
-                   "writable-run-user" "writable-var"
-                   "writable-var-log" "allow-debuggers" "apparmor"
-                   "caps" "caps.keep" "caps.drop"
-                   "memory-deny-write-execute" "nonewprivs"
-                   "noprinters" "noroot" "restrict-namespaces"
-                   "seccomp" "seccomp.32" "seccomp.drop"
-                   "seccomp.32.drop" "seccomp.keep" "seccomp.32.keep"
-                   "protocol" "xephyr-screen" "dbus-system.own"
-                   "dbus-system.talk" "dbus-system.see"
-                   "dbus-system.call" "dbus-system.broadcast"
-                   "dbus-user.own" "dbus-user.talk" "dbus-user.see"
-                   "dbus-user.call" "dbus-user.broadcast" "nodbus"
-                   "cpu" "nice" "rlimit-as" "rlimit-cpu"
-                   "rlimit-fsize" "rlimit-nproc" "rlimit-nofile"
-                   "rlimit-sigpending" "timeout" "allusers" "env"
-                   "ipc-namespace" "keep-fd" "name" "no3d"
-                   "noautopulse" "nodvd" "nogroups" "noinput"
-                   "nosound" "notv" "nou2f" "novideo" "machine-id"
-                   "defaultgw" "dns" "hostname" "hosts-file" "x11"
-                   "dbus-system" "dbus-user" "ip" "ip6" "iprange"
-                   "mac" "mtu" "net" "netfilter" "netfilter" "netlock"
-                   "netmask" "netns" "veth-name"
-                   "deterministic-exit-code" "deterministic-shutdown"
-                   "join-or-start"))
-         (take-all-list '("caps.drop"))
-         (take-none-list '("shell" "net"))
-         (comment-rx '("^.*\\(#.*\\)$" 1 font-lock-comment-face))
-         (dbus-system-user-rx '("^ *\\(\\?[A-Z_]+: +\\)?\
-\\(\\(ignore +\\)?\
-dbus-\\(system\\|user\\) +\\(none\\|filter\\)?\\)" . 2))
-         (x11-rx '("^ *\\(?:\\?[A-Z_]+: +\\)?\
-\\(\\(?:ignore +\\)?x11 +\\(?:none\\|xephyr\\|xorg\\|xpra\\|xvfb\\)?\\)" . 1))
-         (ip-ip6-rx '("^ *\\(\\?[A-Z_]+: +\\)?\
-\\(\\(ignore +\\)?ip6? +\\(none\\|dhcp\\)\\)" . 2))
-         (take-all `(,(concat (regexp-opt take-all-list "^ *\\(\\?[A-Z_]+: +\\)?\
-\\(\\(ignore +\\)?\\<\\(") "\\>\\)")
-                     (2 font-lock-keyword-face)
-                     ("\\<all\\>" nil nil (0 font-lock-keyword-face))))
-         (take-none `(,(concat (regexp-opt take-none-list "^ *\\(\\?[A-Z_]+: +\\)?\
-\\(\\(ignore +\\)?\\<\\(") "\\>\\)")
-                      (2 font-lock-keyword-face)
-                      ("\\<none\\>" nil nil (0 font-lock-keyword-face))))
-         (protocol '("^ *\\(\\?A+: +\\)?\
-\\(\\(ignore +\\)?\\<protocol\\>\\)" (2 font-lock-keyword-face)
-("\\<unix\\>" nil nil (0 font-lock-keyword-face))
-("\\<inet\\>" nil nil (0 font-lock-keyword-face))
-("\\<inet6\\>" nil nil (0 font-lock-keyword-face))
-("\\<netlink\\>" nil nil (0 font-lock-keyword-face))
-("\\<packet\\>" nil nil (0 font-lock-keyword-face))
-("\\<bluetooth\\>" nil nil (0 font-lock-keyword-face))))
-         (variable-rx '("\\${[A-Za-z_]*}" 0 font-lock-variable-name-face))
-         (normal-rx `(,(concat (regexp-opt normal "^ *\\(\\?[A-Z_]+: +\\)?\
-\\(\\(ignore +\\)?\\<\\(") "\\>\\)") . 2)))
-    (list comment-rx x11-rx ip-ip6-rx take-all take-none protocol
-          dbus-system-user-rx normal-rx variable-rx
-          '("^ *\\(\\?[A-Z_]+: +\\)?\\(\\<ignore\\>\\)" . 2)))
+  (let* ((cond-rx (rx (* space) "?" (group (* (any alnum "_"))) (? ":")))
+         (ignore-rx (rx (group (+ (* space) bow "ignore"))))
+         (prefix-rx (rx bol (? (regexp cond-rx)) (? (regexp ignore-rx))
+                        (* space)))
+         kwds)
+    (cl-flet ((add (dirs &optional opts (face 'font-lock-keyword-face))
+                (push (list
+                       (rx (regexp prefix-rx)
+                           bow (regexp (regexp-opt (ensure-list dirs) t)) eow
+                           (* space)
+                           (? (regexp (regexp-opt (ensure-list opts) t)) eow))
+                       '(1 font-lock-builtin-face nil t)
+                       '(2 font-lock-keyword-face nil t)
+                       '(3 font-lock-keyword-face)
+                       `(4 ,face nil t))
+                      kwds))
+              (add-many (dirs opts &optional (face 'font-lock-keyword-face))
+                (push (list
+                       (rx (regexp prefix-rx)
+                           bow (regexp (regexp-opt (ensure-list dirs) t)) eow)
+                       '(1 font-lock-builtin-face nil t)
+                       '(2 font-lock-keyword-face nil t)
+                       '(3 font-lock-keyword-face)
+                       `(,(rx bow (regexp (regexp-opt opts t)) eow)
+                         nil nil (0 ,face)))
+                      kwds)))
+      ;; NOTE the order below matters
+      ;; glob asterisk
+      (push '("*" 0 'bold append) kwds)
+      ;; invalid characters
+      (push `(,(rx (or "\"" "\\")) 0 'firejail-error-face t) kwds)
+      ;; variables
+      (push (list (rx "${" (+ (any alnum "_")) "}") 0
+                  'font-lock-variable-name-face t)
+            kwds)
+      ;; ignore
+      (push (list (rx bol (? (regexp cond-rx)) (regexp ignore-rx) eow)
+                  2 'font-lock-keyword-face)
+            kwds)
+      ;; conditional
+      (push (list (rx bol (regexp cond-rx) eow) 1 'font-lock-builtin-face) kwds)
+      ;; can't have a conditional include or quiet
+      (push (list (rx bol (? (regexp ignore-rx)) (* space)
+                      bow (group (or "include" "quiet")) eow)
+                  2 'font-lock-keyword-face)
+            kwds)
+      ;; directives
+      (add '("noblacklist" "nowhitelist" "blacklist" "blacklist-nolog" "bind"
+             "disable-mnt" "keep-config-pulse" "keep-dev-shm" "keep-var-tmp"
+             "mkdir" "mkfile" "noexec" "private" "private-bin" "private-cache"
+             "private-cwd" "private-dev" "private-etc" "private-home"
+             "private-lib" "private-opt" "private-srv" "private-tmp" "read-only"
+             "read-write" "tmpfs" "tracelog" "whitelist" "whitelist-ro"
+             "writable-etc" "writable-run-user" "writable-var"
+             "writable-var-log" "allow-debuggers" "apparmor" "caps" "caps.keep"
+             "caps.drop" "memory-deny-write-execute" "nonewprivs" "noprinters"
+             "noroot" "restrict-namespaces" "seccomp" "seccomp.32"
+             "seccomp.drop" "seccomp.32.drop" "seccomp.keep" "seccomp.32.keep"
+             "seccomp.block-secondary" "protocol" "xephyr-screen"
+             "dbus-system.own" "dbus-system.talk" "dbus-system.see"
+             "dbus-system.call" "dbus-system.broadcast" "dbus-user.own"
+             "dbus-user.talk" "dbus-user.see" "dbus-user.call"
+             "dbus-user.broadcast" "nodbus" "cpu" "nice" "rlimit-as"
+             "rlimit-cpu" "rlimit-fsize" "rlimit-nproc" "rlimit-nofile"
+             "rlimit-sigpending" "timeout" "allusers" "env" "ipc-namespace"
+             "keep-fd" "name" "no3d" "noautopulse" "nodvd" "nogroups" "noinput"
+             "nosound" "notv" "nou2f" "novideo" "machine-id" "defaultgw" "dns"
+             "hostname" "hosts-file" "x11" "dbus-system" "dbus-user" "ip" "ip6"
+             "iprange" "mac" "mtu" "net" "netfilter" "netfilter" "netlock"
+             "netmask" "netns" "veth-name" "deterministic-exit-code"
+             "deterministic-shutdown" "join-or-start"))
+      (add "caps.drop" "all")
+      (add '("net" "shell") "none")
+      (add '("dbus-system" "dbus-user") '("none" "filter"))
+      (add '("ip" "ip6") '("none" "dhcp"))
+      (add "x11" '("none" "xephyr" "xorg" "xpra" "xvfb"))
+      (add-many "restrict-namespaces" '("cgroup" "ipc" "net" "mnt"
+                                        "time" "user" "uts"))
+      (add-many "protocol" '("unix" "inet" "inet6" "netlink"
+                             "packet" "bluetooth"))
+      (add-many '("caps.drop" "caps.keep")
+                firejail--known-caps 'font-lock-builtin-face)
+      (add-many '("seccomp" "seccomp.drop" "seccomp.keep")
+                firejail--known-syscalls64 'font-lock-builtin-face)
+      (add-many '("seccomp.32" "seccomp.32.drop" "seccomp.32.keep")
+                firejail--known-syscalls32 'font-lock-builtin-face)
+      (add "seccomp-error-action" '("kill" "log"))
+      (add "seccomp-error-action" firejail--known-errnos
+           'font-lock-builtin-face)
+      kwds))
   "Highlight keywords for `firejail-profile-mode'.")
 
 (defvar firejail-profile-syntax-table
   (let ((syn-table (make-syntax-table)))
     (modify-syntax-entry ?# "<" syn-table)
     (modify-syntax-entry ?\n ">" syn-table)
+    (modify-syntax-entry ?\" "." syn-table)
+    (modify-syntax-entry ?\( "." syn-table)
+    (modify-syntax-entry ?\) "." syn-table)
+    (modify-syntax-entry ?\[ "." syn-table)
+    (modify-syntax-entry ?\] "." syn-table)
     syn-table)
   "Syntax table for `firejail-profile-mode'.")
 
 (defconst firejail-profile--keyword-list
-  '("quiet" "include" "noblacklist" "nowhitelist" "blacklist"
-    "blacklist-nolog" "bind" "disable-mnt" "keep-config-pulse"
-    "keep-dev-shm" "keep-var-tmp" "mkdir" "mkfile" "noexec" "private"
-    "private-bin" "private-cache" "private-cwd" "private-dev"
-    "private-etc" "private-home" "private-lib" "private-opt"
-    "private-srv" "private-tmp" "read-only" "read-write" "tmpfs"
-    "tracelog" "whitelist" "whitelist-ro" "writable-etc"
-    "writable-run-user" "writable-var" "writable-var-log"
-    "allow-debuggers" "apparmor" "caps" "caps.keep" "caps.drop"
-    "memory-deny-write-execute" "nonewprivs" "noprinters" "noroot"
-    "restrict-namespaces" "seccomp" "seccomp.32" "seccomp.drop"
-    "seccomp.32.drop" "seccomp.keep" "seccomp.32.keep" "protocol"
-    "xephyr-screen" "dbus-system.own" "dbus-system.talk"
-    "dbus-system.see" "dbus-system.call" "dbus-system.broadcast"
-    "dbus-user.own" "dbus-user.talk" "dbus-user.see" "dbus-user.call"
-    "dbus-user.broadcast" "nodbus" "cpu" "nice" "rlimit-as"
+  '("ignore" "include" "noblacklist" "nowhitelist" "blacklist" "blacklist-nolog"
+    "bind" "disable-mnt" "keep-config-pulse" "keep-dev-shm" "keep-var-tmp"
+    "mkdir" "mkfile" "noexec" "private" "private-bin" "private-cache"
+    "private-cwd" "private-dev" "private-etc" "private-home" "private-lib"
+    "private-opt" "private-srv" "private-tmp" "read-only" "read-write" "tmpfs"
+    "tracelog" "whitelist" "whitelist-ro" "writable-etc" "writable-run-user"
+    "writable-var" "writable-var-log" "allow-debuggers" "apparmor" "caps"
+    "caps.keep" "caps.drop" "memory-deny-write-execute" "nonewprivs"
+    "noprinters" "noroot" "restrict-namespaces" "seccomp" "seccomp.32"
+    "seccomp.drop" "seccomp.32.drop" "seccomp.keep" "seccomp.32.keep"
+    "seccomp.block-secondary" "seccomp-error-action" "protocol" "xephyr-screen"
+    "dbus-system.own" "dbus-system.talk" "dbus-system.see" "dbus-system.call"
+    "dbus-system.broadcast" "dbus-user.own" "dbus-user.talk" "dbus-user.see"
+    "dbus-user.call" "dbus-user.broadcast" "nodbus" "cpu" "nice" "rlimit-as"
     "rlimit-cpu" "rlimit-fsize" "rlimit-nproc" "rlimit-nofile"
-    "rlimit-sigpending" "timeout" "allusers" "env" "ipc-namespace"
-    "keep-fd" "name" "no3d" "noautopulse" "nodvd" "nogroups" "noinput"
-    "nosound" "notv" "nou2f" "novideo" "machine-id" "defaultgw" "dns"
-    "hostname" "hosts-file" "x11" "dbus-system" "dbus-user" "ip" "ip6"
-    "iprange" "mac" "mtu" "net" "netfilter" "netfilter" "netlock"
-    "netmask" "netns" "veth-name" "deterministic-exit-code" "ignore"
-    "deterministic-shutdown" "join-or-start" "net" "shell" "protocol")
+    "rlimit-sigpending" "timeout" "allusers" "env" "ipc-namespace" "keep-fd"
+    "name" "no3d" "noautopulse" "nodvd" "nogroups" "noinput" "nosound" "notv"
+    "nou2f" "novideo" "machine-id" "defaultgw" "dns" "hostname" "hosts-file"
+    "x11" "dbus-system" "dbus-user" "ip" "ip6" "iprange" "mac" "mtu" "net"
+    "netfilter" "netfilter" "netlock" "netmask" "netns" "veth-name"
+    "deterministic-exit-code" "deterministic-shutdown" "join-or-start" "net"
+    "shell" "protocol")
   "List of keywords used for `firejail-profile-capf'.")
 
+(defun firejail--symlink-directory-p (symlink)
+  "Return non-nil if SYMLINK has a directory at the end of its chain."
+  (file-directory-p (file-truename symlink)))
+
+(defun firejail--collect-includes (&optional relative-to)
+  "Return a list of files that the user is likely to want to include.
+With RELATIVE-TO, return a list of files relative to each directory in it."
+  (let ((pat (concat "\\." (regexp-opt firejail-include-search-suffixes) "\\'"))
+        (buffer-file (file-name-nondirectory
+                      (directory-file-name (buffer-file-name)))))
+    (seq-difference
+     (mapcan (lambda (dir)
+               (ignore-error file-missing
+                 (cl-loop for (name type) in (directory-files-and-attributes dir)
+                          when (or (and (eq t type)
+                                        (not (member name (list "." ".."))))
+                                   (and (stringp type)
+                                        (firejail--symlink-directory-p type)))
+                          collect (concat name "/")
+                          when (and (string-match-p pat name)
+                                    (not (equal name buffer-file))
+                                    (not (auto-save-file-name-p name))
+                                    (not (backup-file-name-p name)))
+                          collect name)))
+             (or (ensure-list relative-to) firejail-include-search-directories))
+     firejail-include-ignored-files)))
+
+(defun firejail--include-completion-table (current-input)
+  "Return completion table for file name based on CURRENT-INPUT.
+The completion table contains just the last component.  Therefore, the capf
+should specify the START position of this table to be the first character after
+the last slash (/) on the line.  If none of that made sense, see the
+documentation for `completion-at-point-functions'."
+  (if-let ((last-slash (cl-position ?/ current-input :from-end t))
+           (base (file-truename
+                  (substring current-input 0 (1+ last-slash)))))
+      (let ((default-directory base))
+        (firejail--collect-includes default-directory))
+    (firejail--collect-includes)))
+
+(defun firejail--guess-system-cfg-directory ()
+  "Guess the system config directory.
+The return value will have a trailing slash."
+  (or (cl-find-if 'file-directory-p
+                  '("/etc/firejail/" "/usr/local/etc/firejail/"))
+      "/etc/firejail/"))
+
+(defun firejail--exec-path ()
+  "Parse the PATH environment variable.
+Return a list of files."
+  (cl-loop for (dir . rest) = exec-path then rest
+           while rest ;; ignore last element
+           collect (file-name-as-directory dir)))
+
+(defun firejail--parse-file-argument (arg)
+  "Parse ARG by resolving variables.
+This will return a list.  This is because the PATH variable has many directories
+in it."
+  (if (string-match (rx "${" (group (or "HOME" "CFG" "PATH"
+                                        "RUNUSER")) "}" (? "/")) arg)
+      (let ((var (match-string 1 arg))
+            (rest (substring arg (match-end 0))))
+        (cond
+         ((equal var "HOME")
+          (list (concat (expand-file-name "~/") rest)))
+         ((equal var "CFG")
+          (list (concat (firejail--guess-system-cfg-directory) rest)))
+         ((equal var "RUNUSER")
+          (list (concat (file-name-as-directory (getenv "XDG_RUNTIME_DIR"))
+                        rest)))
+         ((equal var "PATH")
+          (mapcar (lambda (elt)
+                    (concat elt rest))
+                  (firejail--exec-path)))))
+    (list arg)))
+
+(defun firejail--file-completion-table (current-input &optional dir-only)
+  "Generate a completion table for files.
+CURRENT-INPUT is the current text of the argument to complete.  With DIR-ONLY,
+only report directory completions."
+  (ignore-error file-missing
+    (let ((dir (if-let ((last-idx (cl-position ?/ current-input
+                                               :from-end t)))
+                   (substring current-input 0 (1+ last-idx))
+                 current-input)))
+      (cl-loop for (name type) in (directory-files-and-attributes dir)
+               when (or (and (eq t type)
+                             (not (member name '("." ".."))))
+                        (and (stringp type)
+                             (firejail--symlink-directory-p type)))
+               collect (concat name "/")
+               unless (or type dir-only)
+               collect name))))
+
+(defun firejail--move-over-string-chars (count)
+  "Move over COUNT characters, assuming the point is inside a string.
+This may move over more than COUNT characters if the string contains escapes."
+  (cl-loop repeat count
+           do (cl-loop with read-buf = (string (char-after))
+                       for read-val = (condition-case nil
+                                          (read (concat "\"" read-buf "\""))
+                                        (end-of-file))
+                       until read-val
+                       do (forward-char) and
+                       do (setq read-buf (concat read-buf (string
+                                                           (char-after))))
+                       finally (forward-char)
+                       finally return read-val)))
+
+(defun firejail--complete-file-from-table (table-fn index args)
+  "Complete INDEX of ARGS using TABLE-FN.
+TABLE-FN should be a function of one argument that takes the current arg and
+returns a completion table for it."
+  (cl-destructuring-bind (start _end text) (nth index args)
+    (let* ((base (or (file-name-directory text) ""))
+           (table (funcall table-fn base)))
+      (list (+ start (length base)) (+ start (length text)) table))))
+
+(defun firejail--complete-include (index args _directive)
+  "Complete an include directive's arg numbered INDEX of ARGS."
+  (firejail--complete-file-from-table #'firejail--include-completion-table
+                                      index args))
+
+(defun firejail--complete-file (index args _directive)
+  "Complete file taking directive's arg numbered INDEX of ARGS."
+  (firejail--complete-file-from-table #'firejail--file-completion-table
+                                      index args))
+
+(defun firejail--complete-directory (index args _directive)
+  "Complete directory taking directive's arg numbered INDEX of ARGS."
+  (firejail--complete-file-from-table #'(lambda (base)
+                                          (firejail--file-completion-table
+                                           base 'dironly))
+                                      index args))
+
+(defvar-local firejail--relative-to-cache nil
+  "Cache for `firejail--complete-relative-to'.")
+
+(defmacro firejail--complete-relative-to (dirs &optional no-absolute)
+  "Return a function that completes relative to DIRS.
+With NO-ABSOLUTE, don't complete absolute file names."
+  (let ((index (make-symbol "index"))
+        (args (make-symbol "args"))
+        (directive (make-symbol "directive"))
+        (out (make-symbol "out"))
+        (idirs (make-symbol "dirs"))
+        (dir (make-symbol "dir"))
+        (adirname (make-symbol "adirname"))
+        (evaled-dirs (eval dirs t)))
+    `(lambda (,index ,args ,directive)
+       (unless firejail--relative-to-cache
+         (setq firejail--relative-to-cache (make-hash-table :test 'equal)))
+       (let ((,idirs (cl-remove-if-not #'file-directory-p
+                                       (ensure-list ',evaled-dirs)))
+             (,adirname (file-name-directory (cl-third (nth ,index ,args)))))
+         (if-let ((cache (gethash (cons ,adirname ,dirs)
+                                  firejail--relative-to-cache)))
+             cache
+           (let (,out)
+             (dolist (,dir ,idirs)
+               ,(let ((stmt
+                       `(let ((default-directory ,dir))
+                          (push (firejail--complete-file ,index ,args
+                                                         ,directive)
+                                ,out))))
+                  (if no-absolute
+                      `(unless (file-name-absolute-p
+                                (cl-third (nth ,index ,args)))
+                         ,stmt)
+                    stmt)))
+             (puthash (cons ,adirname ,idirs)
+                      (append (seq-take (car ,out) 2)
+                              (list (seq-uniq (mapcan 'cl-third ,out))))
+                      firejail--relative-to-cache)))))))
+
+(defmacro firejail--complete-many-from-set (vals)
+  "Return a function to complete a multi-arg directive from VALS."
+  (let ((index (make-symbol "index"))
+        (args (make-symbol "args"))
+        (directive (make-symbol "directive"))
+        (i (make-symbol "i"))
+        (arg (make-symbol "arg"))
+        (present (make-symbol "present"))
+        (evaled-vals (eval vals t)))
+    `(lambda (,index ,args ,directive)
+       (let ((,present (cl-loop for ,i upfrom 0
+                                for ,arg in ,args
+                                unless (= ,i ,index)
+                                collect (cl-third ,arg))))
+         (append (seq-take (nth ,index ,args) 2)
+                 (list (seq-difference ,evaled-vals ,present)))))))
+
+(defun firejail--get-all-env-keys ()
+  "Return the name of every current environment variable."
+  (mapcar (lambda (elt)
+            (if-let ((sep (cl-position ?= elt)))
+                (substring elt 0 sep)
+              elt))
+          process-environment))
+
+(defun firejail--complete-env (index args _directive)
+  "Complete the arg numbered INDEX in ARGS for an \"env\" directive."
+  (cl-destructuring-bind (start _end text) (nth index args)
+    (let ((sep-pos (or (cl-position ?= text) (length text))))
+      (when (<= (point) (+ start sep-pos))
+        (list start (+ start sep-pos) (firejail--get-all-env-keys))))))
+
+(defconst firejail-profile--keyword-handlers
+  (let ((ht (make-hash-table :test 'equal)))
+    (cl-flet* ((complete (args fun dirs)
+                 (dolist (arg (ensure-list (or args (list nil))))
+                   (dolist (dir (ensure-list dirs))
+                     (puthash (cons dir arg) fun ht))))
+               (complete-all (fun dirs)
+                 (complete nil fun dirs)))
+      (complete 1 #'firejail--complete-include "include")
+      (complete 1 #'firejail--complete-file
+                '("whitelist" "nowhitelist" "blacklist" "noblacklist"
+                  "blacklist-nolog" "noexec" "read-only" "read-write"
+                  "whitelist-ro" "hosts-file"))
+      (complete 1 #'firejail--complete-directory
+                '("mkdir" "mkfile" "private" "private-cwd" "tmpfs"))
+      (complete '(1 2) #'firejail--complete-file "bind")
+      (complete-all (firejail--complete-relative-to
+                     '("/bin" "/sbin" "/usr/bin" "/usr/sbin" "/usr/local/bin")
+                     t)
+                    "private-bin")
+      (complete-all (firejail--complete-relative-to '(getenv "HOME") t)
+                    "private-home")
+      (complete-all (firejail--complete-relative-to "/lib" t)
+                    "private-lib")
+      (complete-all (firejail--complete-relative-to "/etc" t)
+                    "private-etc")
+      (complete-all (firejail--complete-relative-to "/opt" t)
+                    "private-opt")
+      (complete-all (firejail--complete-relative-to "/srv" t)
+                    "private-srv")
+      (complete-all (firejail--complete-many-from-set
+                     ;; evaluate at runtime
+                     'firejail--known-caps)
+                    "caps.keep")
+      (complete-all (firejail--complete-many-from-set
+                     ;; evaluate at runtime
+                     '(cons "all" firejail--known-caps))
+                    "caps.drop")
+      (complete-all (firejail--complete-many-from-set
+                     ''("unix" "inet" "inet6" "netlink" "packet" "bluetooth"))
+                    "protocol")
+      (complete-all (firejail--complete-many-from-set
+                     ''("cgroup" "ipc" "mnt" "pid" "time" "user" "uts"))
+                    "restrict-namespaces")
+      (complete-all (firejail--complete-many-from-set
+                     'firejail--known-syscalls64)
+                    '("seccomp" "seccomp.drop" "seccomp.keep" ))
+      (complete-all (firejail--complete-many-from-set
+                     'firejail--known-syscalls32)
+                    '("seccomp.32" "seccomp.32.drop" "seccomp.32.keep"))
+      (complete 1 (firejail--complete-many-from-set
+                   '(firejail--list-dbus-services :system))
+                '("dbus-system" "dbus-system.own" "dbus-system.talk"
+                  "dbus-system.see"))
+      (complete 1 (firejail--complete-many-from-set
+                   '(firejail--list-dbus-services :session))
+                '("dbus-user" "dbus-user.own" "dbus-user.talk" "dbus-user.see"))
+      (complete 1 (firejail--complete-many-from-set
+                   '(append '("kill" "log") firejail--known-errnos))
+                "seccomp-error-action")
+      (complete 1 (firejail--complete-many-from-set
+                   ''("none" "xephyr" "xorg" "xpra" "xvfb"))
+                "x11")
+      (complete 1 (firejail--complete-many-from-set
+                   ''("none" "filter"))
+                '("dbus-system" "dbus-user"))
+      (complete 1 (firejail--complete-many-from-set
+                   ''("none" "dhcp"))
+                '("ip" "ip6"))
+      (complete 1 (firejail--complete-many-from-set
+                   ''("none"))
+                '("net" "shell"))
+      (complete-all (firejail--complete-many-from-set
+                     '(mapcar 'number-to-string
+                              (number-sequence 0 (firejail--get-num-cpus))))
+                    "cpu")
+      (complete 1 #'firejail--complete-env "env"))
+    ht)
+  "Hash table mapping firejail profile directives to their handler.
+Each handler is a function of three arguments.  The first is the index of the
+current argument, the second is a list of the arguments, the third the
+directive.  These functions mustn't move the point.  The point will be on the
+first character of the argument.  The keys of this table are a cons of a
+directive and its argument number.  The values are the completion functions.")
+
+(defun firejail--quiet-allowed-p ()
+  "Return non-nil if the \"quiet\" directive is allowed on line under point."
+  (save-excursion
+    (let ((orig-line (line-number-at-pos)))
+      (goto-char (point-min))
+      (while (forward-comment 1))
+      (>= (line-number-at-pos) orig-line))))
+
+(defun firejail--ignored-line-p ()
+  "Return non-nil if the line under point is an \"ignore\" directive.
+Actually, return the position of the first character of the \"real\" directive."
+  (save-excursion
+    (beginning-of-line)
+    (when (looking-at (rx bol (* space) (? "?" (* (any alnum "_")) (? ":"))
+                          (+ (* space) "ignore" eow) (or eol (+ space))
+                          (group (* nonl)) eol))
+      (match-beginning 1))))
+
+(defun firejail--read-next-arg ()
+  "Return the bounds of the next argument from the buffer starting at point.
+This returns a list of four things, the first two are the start and end of the
+current argument.  The third is the text of the argument."
+  (skip-syntax-forward "-")
+  (looking-at (rx (group (* (not (any "\n" "," "#"))))
+                  (* space) (or eol "," "#")))
+  (goto-char (match-end 0))
+  (when (eql ?# (char-before))
+    (backward-char))
+  (list (match-beginning 1) (match-end 1)
+        (match-string-no-properties 1)))
+
+(defun firejail--has-more-args-p ()
+  "Return non-nil if there are probably more args beyond point on this line."
+  (save-excursion
+    (skip-syntax-forward "-")
+    (not (or (eobp) (memql (char-after) '(?\n ?#))))))
+
+(defun firejail--multi-arg-directive-p (name)
+  "Return non-nil if NAME is a multi-argument directive."
+  (member name '("bind" "private-bin" "private-etc" "private-home"
+                 "private-lib" "private-opt" "private-srv" "caps.drop"
+                 "caps.keep" "protocol" "restrict-namespaces"
+                 "seccomp" "seccomp.32" "seccomp.drop" "seccomp.32.drop"
+                 "seccomp.keep" "seccomp.32.keep" "cpu" "iprange")))
+
+(defun firejail--current-args (dir arg-start)
+  "Return a list of the text of each argument in the directive DIR under point.
+ARG-START is the first character of the list of arguments."
+  (if (firejail--multi-arg-directive-p dir)
+      (append (save-excursion
+                (goto-char arg-start)
+                (cl-loop while (firejail--has-more-args-p)
+                         collect (firejail--read-next-arg)))
+              (list (list (point) (point) "")))
+    (save-excursion
+      (goto-char arg-start)
+      (skip-syntax-forward "-")
+      (let ((eol (pos-eol)))
+        (list (list (point) eol
+                    (buffer-substring-no-properties
+                     (point) eol)))))))
+
+(defun firejail--count-args (start end)
+  "Return the number of arguments between START and END."
+  (1+ (how-many "," start end)))
+
+(defun firejail--complete-arguments (directive arg-start)
+  "Generate completions for the argument that the point is currently in.
+DIRECTIVE is the directive to generate completions for.  ARG-START is the first
+argument character on the current line."
+  (let* ((cur-arg (if (firejail--multi-arg-directive-p directive)
+                      (firejail--count-args arg-start (point))
+                    1)))
+    (when-let ((handler (or (gethash (cons directive nil)
+                                     firejail-profile--keyword-handlers)
+                            (gethash (cons directive cur-arg)
+                                     firejail-profile--keyword-handlers))))
+      (funcall handler (1- cur-arg)
+               (firejail--current-args directive arg-start)
+               directive))))
+
+(defun firejail--line-conditional-p ()
+  "Return non-nil if the line under point begins with a conditional.
+Actually, return a list of its bounds and the bounds of its name."
+  (save-excursion
+    (beginning-of-line)
+    (skip-syntax-forward "-")
+    (when (looking-at (rx (group "?" (group (* (any "_" alnum))) (? ":"))
+                          (or eol (+ space) "#")))
+      (list (match-beginning 1) (match-end 1) (match-beginning 2)
+            (match-end 2)))))
+
+(defun firejail--complete-conditional (start end)
+  "Complete the conditional around point.
+START and END are the bounds of the name of the conditional."
+  (list start end '()))
+
 (defun firejail-profile-capf ()
-  "Complete the firejail profile directive at point."
-  (if-let ((word-bounds (bounds-of-thing-at-point 'word)))
-      (cl-loop for kwd in firejail-profile--keyword-list
-               with word-at-point = (buffer-substring-no-properties
-                                     (car word-bounds)
-                                     (cdr word-bounds))
-               when (string-prefix-p word-at-point kwd)
-               collect kwd into candidates
-               finally return (list (car word-bounds)
-                                    (cdr word-bounds)
-                                    candidates))
-    (list (point)
-          (point)
-          firejail-profile--keyword-list)))
+  "Complete the Firejail profile directive at point."
+  (save-excursion
+    ;; don't complete comments
+    (unless (nth 4 (syntax-ppss (point)))
+      (let ((start-pos (point)))
+        (back-to-indentation)
+        (let ((condition (firejail--line-conditional-p))
+              (ignored (firejail--ignored-line-p)))
+          (if (and condition (>= start-pos (cl-first condition))
+                   (<= start-pos (cl-second condition)))
+              (list (cl-third condition) (cl-fourth condition)
+                    ;; is there already a '?'
+                    (if (= (cl-second condition) (cl-fourth condition))
+                        (mapcar (lambda (elt)
+                                  (concat elt ":"))
+                                firejail--known-conditionals)
+                      firejail--known-conditionals))
+            (cond
+             (ignored (goto-char ignored))
+             (condition
+              (goto-char (1+ (cl-second condition)))
+              (skip-syntax-forward "-")))
+            ;; read the directive name
+            (looking-at (rx (group (* (not (any space "#" "\n"))))
+                            (? (group space))))
+            (let ((directive-start (match-beginning 1))
+                  (directive-end (match-end 1))
+                  (arg-start (match-end 2)))
+              (if (and arg-start (>= start-pos arg-start))
+                  (progn
+                    (goto-char start-pos)
+                    (firejail--complete-arguments
+                     (buffer-substring-no-properties directive-start
+                                                     directive-end)
+                     arg-start))
+                (cond
+                 ((= directive-start directive-end)
+                  (setq directive-start start-pos
+                        directive-end start-pos))
+                 ((and (< start-pos directive-start)
+                       (eql 2 (syntax-class (syntax-after (1- start-pos)))))
+                  (save-excursion
+                    (goto-char start-pos)
+                    (forward-word -1)
+                    (setq directive-start (point)
+                          directive-end start-pos)))
+                 ((< start-pos directive-start)
+                  (setq directive-start start-pos
+                        directive-end start-pos)))
+                (list
+                 directive-start directive-end
+                 (append (when (and (not condition) (not ignored)
+                                    (firejail--quiet-allowed-p))
+                           '("quiet"))
+                         firejail-profile--keyword-list))))))))))
+
+(defun firejail--directive-at-point ()
+  "Return the name of the directive at point."
+  (save-excursion
+    (beginning-of-line)
+    (when (looking-at (rx bol (* space)
+                          (? "?" (* (any alnum "_")) (? ":")
+                             (+ space))
+                          (* "ignore" (+ space))
+                          (group (+ (not (any space "\n" "#"))))))
+      (let ((name (match-string-no-properties 1)))
+        (unless (or (equal name "ignore")
+                    (string-prefix-p "?" name)
+                    (string-suffix-p ":" name))
+          name)))))
+
+(defun firejail--read-next-sentence ()
+  "Return from point up to the next sentance end."
+  (let ((start (point))
+        (end (or (re-search-forward (rx eow "." (or " " eol))
+                                    nil t)
+                 (point-max))))
+    (when (eql (char-before end) ? )
+      (cl-decf end)
+      (backward-char))
+    (cl-substitute ?  ?\n (buffer-substring-no-properties
+                           start end))))
+
+(defun firejail--format-doc-string-and-get-summary (dir doc)
+  "Format DOC and get a summary for DIR.
+Return a list of the formatted doc and a summary."
+  (with-temp-buffer
+    (insert doc)
+    (goto-char (point-min))
+    (forward-line)
+    (let ((summary (save-excursion
+                     (firejail--read-next-sentence))))
+      (cl-loop for start = (point)
+               until (eobp) do
+               (forward-paragraph)
+               (fill-region-as-paragraph start (point))
+               (forward-line)
+               when (looking-at-p (rx bol (literal dir) (or eol " ")))
+               do (forward-line))
+      (goto-char (point-min))
+      (replace-regexp-in-region (rx (>= 3 "\n")) "\n\n")
+      (replace-regexp-in-region (rx eow "." (+ blank)) ".  ")
+      (while (re-search-forward (rx ":" eol) nil t)
+        (forward-line)
+        (while (and (not (eobp))
+                    (not (char-uppercase-p (char-after))))
+          (if (= (pos-bol) (pos-eol))
+              (delete-char 1)
+            (insert "  ")
+            (forward-line)))
+        (unless (eobp)
+          (insert "\n")))
+      (list (buffer-string) summary))))
+
+(defun firejail-eldoc-documentation-function (callback &rest _args)
+  "Call CALLBACK with the documentation of the directive under point."
+  (save-excursion
+    (when-let ((name (firejail--directive-at-point))
+               (doc (firejail--documentation-for name)))
+      (cl-destructuring-bind (clean-doc summary)
+          (firejail--format-doc-string-and-get-summary name doc)
+        (funcall callback clean-doc `(:thing ,name
+                                      :echo ,summary))))))
+
+(defvar-keymap firejail-profile-mode-map
+  :doc "Keymap for `firejail-profile-mode'."
+  :parent prog-mode-map
+  "C-c C-o" #'ff-find-other-file)
 
 (define-derived-mode firejail-profile-mode prog-mode "Firejail-Profile"
   "Major mode for editing firejail profiles."
-  (add-to-list (make-local-variable 'completion-at-point-functions)
-               #'firejail-profile-capf)
-  (setq-local font-lock-defaults '(firejail-profile-font-lock-keywords))
-  (set-syntax-table firejail-profile-syntax-table))
+  :group 'firejail-mode
+  :syntax-table firejail-profile-syntax-table
+  (add-hook 'completion-at-point-functions #'firejail-profile-capf nil t)
+  (setq-local font-lock-defaults '(firejail-profile-font-lock-keywords)
+              comment-start "#"
+              comment-end ""
+              electric-pair-pairs '((?{ . ?}))
+              ff-search-directories firejail-include-search-directories
+              ff-other-file-alist '(("\\.local\\'" (".profile"))
+                                    ("\\.profile\\'" (".local")))
+              eldoc-documentation-functions
+              '(firejail-eldoc-documentation-function
+                t)))
 
 (add-to-list 'auto-mode-alist
-             '("\\.\\(firejail\\|profile\\|local\\)$" . firejail-profile-mode))
+             '("\\.\\(firejail\\|profile\\|local\\|inc\\)\\'" . firejail-profile-mode))
 
 (provide 'firejail-mode)
 ;;; firejail-mode.el ends here
+
+;; Local Variables:
+;; jinx-local-words: "Firejail Firejail's"
+;; End:

elisp/inferior-cc.el

@@ -0,0 +1,499 @@
+;;; inferior-cc.el --- Run interpreters for cc-mode languages -*- lexical-binding: t; -*-
+;;; Commentary:
+;;; Code:
+(require 'comint)
+(require 'cl-lib)
+(require 'cc-mode)
+(require 'treesit)
+(require 'shell)
+(eval-when-compile (require 'rx))
+
+(defgroup inferior-cc ()
+  "Run interpreters for `cc-mode' languages."
+  :group 'comint)
+
+(defclass inferior-cc-interpreter ()
+  ((name :type string
+         :initarg :name
+         :accessor inf-cc-name
+         :doc "The name of this interpreter.")
+   (command :type string
+            :initarg :command
+            :accessor inf-cc-command
+            :doc "The command (program) for this interpreter.")
+   (args :type (list-of string)
+         :initarg :args
+         :accessor inf-cc-args
+         :initform nil
+         :doc "Command-line arguments to pass to the interpreter.")
+   (font-lock-mode :type (or null function)
+                   :initarg :font-lock-mode
+                   :accessor inf-cc-font-lock-mode
+                   :initform nil
+                   :doc "Major mode to use for font locking of the interpreter's
+input. A value of nil means don't do font locking.")
+   (modes :type (list-of function)
+          :initarg :modes
+          :accessor inf-cc-modes
+          :initform nil
+          :doc "The major modes that this interpreter corresponds to.")
+   (exp-at-point-func :type (or function null)
+                      :initarg :exp-at-point-func
+                      :accessor inf-cc-exp-at-point-func
+                      :initform nil
+                      :doc "Function to retrieve the expression at point for
+languages supported by this interpreter."))
+  (:documentation "An interpreter for a `cc-mode'-like language."))
+
+(define-widget 'inferior-cc-interpreter 'lazy
+  "Interpreter for `cc-mode'-like languages."
+  :offset 4
+  :tag "Interpreter"
+  :type '(list (string :tag "Name")
+               (repeat :tag "Command line" (string :tag "Argument"))
+               (choice :tag "Font lock mode"
+                       (function :tag "Major mode")
+                       (const :tag "None" nil))
+               (repeat :tag "Major modes" (function :tag "Major mode"))
+               (choice :tag "Expression at point function"
+                       (function :tag "Function")
+                       (const :tag "None" nil))))
+
+(defun inf-cc--interpreter-list-to-obj (list)
+  "Return LIST as a proper `inferior-cc-interpreter' object."
+  (cl-destructuring-bind (name (command &rest args) font-lock-mode modes
+                               exp-at-point-func)
+      list
+    (inferior-cc-interpreter :name name :command command
+                             :args args :font-lock-mode font-lock-mode
+                             :modes modes :exp-at-point-func exp-at-point-func)))
+
+(defun inf-cc--interpreter-obj-to-list (obj)
+  "Return OBJ, a proper `inferior-cc-interpreter', object as a list."
+  (with-slots (name command args font-lock-mode modes exp-at-point-func) obj
+    (list name (cons command args) font-lock-mode modes exp-at-point-func)))
+
+(defun inf-cc--remove-trailing-semicolon (str)
+  "Remove a trailing semicolon and whitespace from STR."
+  (if (string-match (rx (* (syntax whitespace))
+                        ";"
+                        (* (syntax whitespace)) eos)
+                    str)
+      (substring str  0 (match-beginning 0))
+    str))
+
+(defun inf-cc--remove-surrounding-parens (str)
+  "Remove surrounding parenthesis from STR."
+  (if (string-match (rx bos (* (syntax whitespace)) "("
+                        (group (* any))
+                        ")" (* (syntax whitespace)) eos)
+                    str)
+      (match-string 1 str)
+    str))
+
+(defun inf-cc--c-c++-ts-exp-at-point ()
+  "Return the expression at point in `c-ts-mode' and `c++-ts-mode' buffers."
+  (unless (or (derived-mode-p 'c-ts-mode 'c++-ts-mode))
+    (user-error "Major mode does not support find expressions: %s" major-mode))
+  (save-excursion
+    (let ((start (point)))
+      (back-to-indentation)
+      (unless (> (point) start)
+        (goto-char start)))
+    (when-let ((thing (treesit-thing-at-point "_" 'nested)))
+      (inf-cc--remove-trailing-semicolon (treesit-node-text thing)))))
+
+(defun inf-cc--java-ts-exp-at-point ()
+  "Return the expression at point in `java-ts-mode' buffers."
+  (unless (or (derived-mode-p 'java-ts-mode))
+    (user-error "Major mode does not support find expressions: %s" major-mode))
+  (save-excursion
+    (let ((start (point)))
+      (back-to-indentation)
+      (unless (> (point) start)
+        (goto-char start)))
+    (let ((root (treesit-buffer-root-node)))
+      (let ((node (car (or (treesit-query-range
+                            root '([(expression_statement)
+                                    (field_declaration)
+                                    (local_variable_declaration)
+                                    (import_declaration)]
+                                   @exp)
+                            (point) (1+ (point)))
+                           (treesit-query-range
+                            root '([(parenthesized_expression)
+                                    (binary_expression)
+                                    (update_expression)
+                                    (unary_expression)]
+                                   @exp)
+                            (point) (1+ (point)))))))
+        (inf-cc--remove-surrounding-parens
+         (inf-cc--remove-trailing-semicolon
+          (buffer-substring-no-properties (car node) (cdr node))))))))
+
+(defcustom inferior-cc-interpreters
+  (list (inferior-cc-interpreter :name "jshell"
+                                 :command "jshell"
+                                 :font-lock-mode 'java-mode
+                                 :modes '(java-mode java-ts-mode)
+                                 :exp-at-point-func
+                                 'inf-cc--java-ts-exp-at-point)
+        (inferior-cc-interpreter :name "root"
+                                 :command "root"
+                                 :font-lock-mode 'c++-mode
+                                 :modes '(c-mode c-ts-mode c++-mode c++-ts-mode)
+                                 :exp-at-point-func
+                                 'inf-cc--c-c++-ts-exp-at-point))
+  "List of inferior-cc interpreters."
+  :type '(repeat inferior-cc-interpreter)
+  :get (lambda (sym)
+         (mapcar 'inf-cc--interpreter-obj-to-list (default-toplevel-value sym)))
+  :set (lambda (sym newval)
+         (set-default-toplevel-value
+          sym (mapcar #'(lambda (elt)
+                          (if (inferior-cc-interpreter-p elt)
+                              elt
+                            (inf-cc--interpreter-list-to-obj elt)))
+                      newval)))
+  :group 'inferior-cc)
+
+(defvar-local inf-cc--obj nil
+  "The current buffer's interpreter object.")
+(put 'inf-cc--obj 'permanent-local t)
+
+(defvar-local inf-cc--fontification-buffer nil
+  "The fontification buffer for the current buffer.")
+
+(defvar-local inf-cc--skip-next-lines 0
+  "Number of lines of output to skip.")
+
+(defun inf-cc--preoutput-filter-function (output)
+  "Preoutput filter function for inferior cc buffers.
+OUTPUT is the new text to be inserted."
+  (if (<= inf-cc--skip-next-lines 0)
+      output
+    (let* ((lines (string-lines output))
+           (cnt (length lines)))
+      (if (> cnt inf-cc--skip-next-lines)
+          (prog1
+              (string-join (nthcdr inf-cc--skip-next-lines lines) "\n")
+            (setq inf-cc--skip-next-lines 0))
+        (cl-decf inf-cc--skip-next-lines cnt)
+        (when (and (not (string-empty-p output))
+                   (/= ?\n (elt output (1- (length output)))))
+          (cl-incf inf-cc--skip-next-lines))
+        ""))))
+
+(defun inf-cc--get-fontification-buffer ()
+  "Return or create the current buffer's fontification buffer."
+  (if (buffer-live-p inf-cc--fontification-buffer)
+      inf-cc--fontification-buffer
+    (let ((buffer (generate-new-buffer
+                   (format " %s-fontification-buffer" (buffer-name))))
+          (obj inf-cc--obj))
+      (with-current-buffer buffer
+        (setq-local inf-cc--obj obj)
+        (unless (and (inf-cc-font-lock-mode inf-cc--obj)
+                     (derived-mode-p (inf-cc-font-lock-mode inf-cc--obj)))
+          (let ((delayed-mode-hooks nil))
+            (delay-mode-hooks
+              (funcall (inf-cc-font-lock-mode inf-cc--obj)))))
+        (when (eq c-basic-offset 'set-from-style)
+          (setq-local c-basic-offset standard-indent))
+        (let ((inhibit-message t))
+          (indent-tabs-mode -1))
+        (unless font-lock-mode
+          (font-lock-mode 1)))
+      (setq-local inf-cc--fontification-buffer buffer))))
+
+(defmacro inf-cc--with-font-lock-buffer (&rest body)
+  "Execute BODY in the current buffer's fortification buffer.
+Note that this erases the buffer before doing anything."
+  `(with-current-buffer (inf-cc--get-fontification-buffer)
+     (erase-buffer)
+     ,@body))
+
+(defun inf-cc--fontify-current-input ()
+  "Function called from `post-command-hook' to fontify the current input."
+  (when-let (((inf-cc-font-lock-mode inf-cc--obj))
+             (proc (get-buffer-process (current-buffer)))
+             (start (process-mark proc))
+             (end (point-max))
+             (input (buffer-substring-no-properties start end))
+             (fontified (inf-cc--with-font-lock-buffer
+                         (insert input)
+                         (font-lock-ensure)
+                         (buffer-string)))
+             (len (length fontified))
+             (i 0))
+    ;; mostly from:
+    ;; `python-shell-font-lock-post-command-hook'
+    (while (not (= i len))
+      (let* ((props (text-properties-at i fontified))
+             (change-i (or (next-property-change i fontified)
+                           len)))
+        (when-let ((face (plist-get props 'face)))
+          (setf (plist-get props 'face) nil
+                (plist-get props 'font-lock-face) face))
+        (set-text-properties (+ start i) (+ start change-i) props)
+        (setq i change-i)))))
+
+(defun inf-cc--bounds-of-last-prompt ()
+  "Return the bounds of the last prompt.
+This returns a cons."
+  (save-excursion
+    (let ((end (process-mark (get-buffer-process (current-buffer)))))
+      (goto-char end)
+      (cons (pos-bol) end))))
+
+(defun inf-cc--remove-extra-indentation (count)
+  "Remove COUNT spaces from the start of each line."
+  (save-excursion
+    (goto-char (point-min))
+    (while (not (eobp))
+      (back-to-indentation)
+      (let ((indent (- (point) (pos-bol))))
+        (when (> indent count)
+          (delete-char (- count))))
+      (forward-line))))
+
+(defun inf-cc--indent-line-function ()
+  "`indent-line-function' for inferior cc comint buffers."
+  (when (inf-cc-font-lock-mode inf-cc--obj)
+    (let* ((start (process-mark (get-buffer-process (current-buffer)))))
+      ;; don't indent the first line
+      (unless (= (pos-bol) (save-excursion (goto-char start) (pos-bol)))
+        (let* ((input (buffer-substring-no-properties start (pos-eol)))
+               (prompt-size (let ((bound (inf-cc--bounds-of-last-prompt)))
+                              (- (cdr bound) (car bound))))
+               (col (inf-cc--with-font-lock-buffer
+                     (insert input)
+                     (inf-cc--remove-extra-indentation prompt-size)
+                     (c-indent-line nil t)
+                     (back-to-indentation)
+                     (- (point) (pos-bol)))))
+          (save-excursion
+            (indent-line-to (+ prompt-size col)))
+          (skip-syntax-forward "-"))))))
+
+(defun inferior-cc-send-input ()
+  "Like `comint-send-input', but with some extra stuff for inferior cc."
+  (interactive)
+  (let ((pmark (process-mark (get-buffer-process (current-buffer))))
+        (end (if comint-eol-on-send (pos-eol) (point))))
+    (with-restriction pmark end
+      (let ((res (syntax-ppss (point-max))))
+        (without-restriction
+          (cond
+           ;; open string
+           ((cl-fourth res)
+            (message "Unterminated string"))
+           ;; unmatched blocks or comment
+           ((or (numberp (cl-fifth res))
+                (not (zerop (cl-first res)))
+                ;; trailing . character
+                (save-excursion
+                  (end-of-line)
+                  (skip-syntax-backward "-")
+                  (eql (char-before) ?.)))
+            (newline-and-indent))
+           (t
+            ;; ignore the interpreter echoing back our lines
+            (setq-local inf-cc--skip-next-lines (count-lines pmark end))
+            (when (= pmark end)
+              (cl-incf inf-cc--skip-next-lines))
+            ;; also, methods add a bunch of extra newlines
+            (when (>= inf-cc--skip-next-lines 2)
+              (cl-incf inf-cc--skip-next-lines (- inf-cc--skip-next-lines 2)))
+            (comint-send-input))))))))
+
+(defvar-keymap inferior-cc-shell-mode-map
+  :doc "Keymap for `inferior-cc-shell-mode'."
+  :parent comint-mode-map
+  "RET" #'inferior-cc-send-input)
+
+(defun inf-cc--kill-fontification-buffer ()
+  "Kill the current `inf-cc--fontification-buffer'."
+  (ignore-errors
+    (kill-buffer inf-cc--fontification-buffer)))
+
+(define-derived-mode inferior-cc-shell-mode comint-mode ""
+  "Major mode for buffers running inferior cc interpreters.
+You MUST set `inf-cc--obj' before activating this major mode."
+  :interactive nil
+  :group 'inferior-jshell
+  :syntax-table nil
+  (with-slots (name font-lock-mode) inf-cc--obj
+    (setq-local comint-highlight-input nil
+                indent-line-function #'inf-cc--indent-line-function
+                electric-indent-chars '(?\n ?})
+                mode-name (concat "Inferior " (upcase-initials name)))
+    (when-let ((font-lock-mode)
+               (sym (intern-soft (format "%s-syntax-table" font-lock-mode)))
+               (syntax-table (symbol-value sym)))
+      (set-syntax-table syntax-table)))
+  (add-hook 'comint-preoutput-filter-functions
+            #'inf-cc--preoutput-filter-function
+            nil t)
+  (add-hook 'post-command-hook
+            #'inf-cc--fontify-current-input
+            nil t)
+  (add-hook 'kill-buffer-hook
+            #'inf-cc--kill-fontification-buffer
+            nil t))
+
+(cl-defun inf-cc--find-buffer ()
+  "Find and return a live inferior cc buffer for the current major mode."
+  (let ((target-mode major-mode))
+    (dolist (buffer (buffer-list))
+      (with-current-buffer buffer
+        (when (and (process-live-p (get-buffer-process buffer))
+                   inf-cc--obj
+                   (member target-mode (inf-cc-modes inf-cc--obj)))
+          (cl-return-from inf-cc--find-buffer buffer))))))
+
+(defun inferior-cc-eval (code)
+  "Evaluate CODE in a live inferior cc buffer."
+  (interactive "sEval: " inferior-cc-shell-mode)
+  (let ((buffer (inf-cc--find-buffer)))
+    (unless buffer
+      (user-error "No live inferior cc buffer found"))
+    (with-current-buffer buffer
+      (let* ((start (process-mark (get-buffer-process buffer)))
+             (end (point-max))
+             (old (buffer-substring-no-properties start end)))
+        (delete-region start end)
+        (goto-char (point-max))
+        (insert code)
+        (goto-char (point-max))
+        ;; don't save history
+        (let ((comint-input-filter #'ignore))
+          (inferior-cc-send-input))
+        (goto-char (point-max))
+        (insert old)
+        (goto-char (point-max))))))
+
+(defun inferior-cc-eval-region (start end)
+  "Evaluate the current buffer from START to END in a live inferior cc buffer.
+START and END default to the current region."
+  (interactive "r" inferior-cc-shell-mode)
+  (inferior-cc-eval (buffer-substring-no-properties start end))
+  (message "Evaluated %s lines" (count-lines start end)))
+
+(defun inferior-cc-eval-buffer ()
+  "Send the current buffer to a live inferior cc buffer."
+  (interactive nil inferior-cc-shell-mode)
+  (inferior-cc-eval-region (point-min) (point-max))
+  (message "Evaluated buffer %s" (current-buffer)))
+
+(defun inferior-cc-eval-defun ()
+  "Send the defun under point to a live inferior cc buffer."
+  (interactive nil inferior-cc-shell-mode)
+  (let ((bounds (bounds-of-thing-at-point 'defun)))
+    (unless bounds
+      (user-error "No defun under point"))
+    (inferior-cc-eval-region (car bounds) (cdr bounds))
+    (message "Evaluated defun (%s lines)" (count-lines (car bounds)
+                                                       (cdr bounds)))))
+
+(defun inferior-cc-eval-line ()
+  "Send the line under point to a live inferior cc buffer."
+  (interactive nil inferior-cc-shell-mode)
+  (inferior-cc-eval-region (pos-bol) (pos-eol))
+  (message "Evaluated %s" (buffer-substring (pos-bol) (pos-eol))))
+
+(defun inferior-cc-eval-expression ()
+  "Evaluate the expression under point in a live inferior cc buffer.
+This only works in modes that have defined an \\=:exp-at-point-func."
+  (interactive nil inferior-cc-shell-mode)
+  (let ((obj (inf-cc--find-interpreter-for-mode)))
+    (unless obj
+      (user-error "Cannot get expression for major mode: %s" major-mode))
+    (with-slots ((func exp-at-point-func)) obj
+      (unless func
+        (user-error "Cannot get expression for major mode: %s" major-mode))
+      (let ((code (funcall func)))
+        (unless code
+          (user-error "No expression under point"))
+        (inferior-cc-eval code)
+        (message "Evaluated expression (%s lines)"
+                 (1+ (cl-count ?\n code)))))))
+
+(defun inf-cc--find-interpreter-for-mode (&optional mode)
+  "Find a suitable interpreter for MODE, defaulting to `major-mode'."
+  (unless mode (setq mode major-mode))
+  (cl-find-if (lambda (elt)
+                (with-slots (modes) elt
+                  (member mode modes)))
+              inferior-cc-interpreters))
+
+(defun inf-cc--interpreter-by-name (name)
+  "Find the interpreter named NAME."
+  (cl-find-if (lambda (elt)
+                (equal (inf-cc-name elt) name))
+              inferior-cc-interpreters))
+
+(defun inf-cc--prompt-for-interpreter ()
+  "Prompt for an inferior cc interpreter."
+  (inf-cc--interpreter-by-name
+   (completing-read "Interpreter: "
+                    (mapcar 'inf-cc-name inferior-cc-interpreters) nil t)))
+
+(defun inf-cc--prompt-for-command (int)
+  "Prompt for a command line for INT."
+  (with-slots (command args) int
+    (let* ((def-cmd (string-join (mapcar 'shell-quote-argument
+                                         (cons command args))
+                                 " "))
+           (choice (read-shell-command "Command: " def-cmd)))
+      (split-string-shell-command choice))))
+
+(defun run-cc-interpreter (int &optional command)
+  "Run the `cc-mode'-like interpreter INT.
+Interactively, INT will be an interpreter suitable for the current
+`major-mode'.  With a prefix argument, prompt for an interpreter.
+
+If COMMAND is non-nil, it should be a list with the first element being the
+program to execute and the rest of the elements being the arguments to pass to
+the interpreter.  This overrides the default settings in INT.  Interactively,
+prompt for COMMAND with two prefix arguments."
+  (interactive (let ((int (if current-prefix-arg
+                              (inf-cc--prompt-for-interpreter)
+                            (or (inf-cc--find-interpreter-for-mode)
+                                (inf-cc--prompt-for-interpreter)))))
+                 (list int
+                       (when (>= (prefix-numeric-value current-prefix-arg) 16)
+                         (inf-cc--prompt-for-command int)))))
+  (with-slots (name (def-cmd command) args) int
+    (unless command
+      (setq command (cons def-cmd args)))
+    (pop-to-buffer
+     (with-current-buffer (get-buffer-create (format "*%s*" name))
+       (prog1 (current-buffer)
+         (unless (process-live-p (get-buffer-process (current-buffer)))
+           (setq-local inf-cc--obj int)
+           (inferior-cc-shell-mode)
+           (comint-exec (current-buffer)
+                        (format "Inferior %s" (upcase-initials name))
+                        (car command) nil (cdr command))))))))
+
+(defun run-jshell (command)
+  "Run JShell in a comint buffer.
+COMMAND is the same as for `run-cc-interpreter', except that any prefix arg
+causes the user to be prompted."
+  (interactive (list (when current-prefix-arg
+                       (inf-cc--prompt-for-command
+                        (inf-cc--interpreter-by-name "jshell")))))
+  (run-cc-interpreter (inf-cc--interpreter-by-name "jshell") command))
+
+(defun run-root (command)
+  "Run CERN root in a comint buffer.
+COMMAND is the same as for `run-cc-interpreter', except that any prefix arg
+causes the user to be prompted."
+  (interactive (list (when current-prefix-arg
+                       (inf-cc--prompt-for-command
+                        (inf-cc--interpreter-by-name "root")))))
+  (run-cc-interpreter (inf-cc--interpreter-by-name "root") command))
+
+(provide 'inferior-cc)
+;;; inferior-cc.el ends here

elisp/khard.el

@@ -1,42 +1,38 @@
-;;; khard.el --- Emacs integration with khard
+;;; khard.el --- Emacs integration with khard -*- lexical-binding: t -*-
 ;;; Commentary:
 ;;; Code:
 
 (require 'with-editor)
+(require 'cl-lib)
+(require 'message)
 
-(add-to-list 'display-buffer-alist '(" \\*khard output\\*" . (display-buffer-no-window)))
+(defcustom khard-executable "khard"
+  "The executable to use to run khard."
+  :group 'khard
+  :type 'string)
+
+(defvar-local khard--contacts-cache ()
+  "List of contacts used while completing at point.
+This exists so that Emacs doesn't slow down while running
+`completion-at-point-functions'.  This is local to each buffer.")
 
 (defun khard--build-list-entry-detail (&rest items)
   "Build a detail in the format \" (ITEMS)\", or an empty string."
   (let ((clean-items (remove "" items)))
-    (if (not (seq-empty-p clean-items))
-        (format " (%s)"
-                (string-join clean-items ", "))
+    (if clean-items
+        (format " (%s)" (string-join clean-items ", "))
       "")))
 
-(defun khard--remove-leading-label (field)
-  "Remove a leading \"name: \" from FIELD."
-  (if-let (index (string-search ":" field))
-      (substring field (+ index 2))
-    field))
-
 (defun khard--build-uid-email-phone-list ()
   "Build a list in the format (info . uid)."
-  (let ((lines (process-lines "khard"
-                              "ls"
-                              "--parsable"
-                              "--fields=uid,name,email,phone")))
-    (mapcar (lambda (line)
-              (let* ((fields (split-string line "\t"))
-                     (uid (car fields))
-                     (name (cadr fields))
-                     (email (khard--remove-leading-label (caddr fields)))
-                     (phone (khard--remove-leading-label (cadddr fields))))
-                (cons (format "%s%s"
-                              name
-                              (khard--build-list-entry-detail email phone uid))
-                      uid)))
-            lines)))
+  (cl-loop for line in
+           (process-lines "khard" "ls"
+                          "--parsable" "--fields=uid,name,email,phone")
+           for (uid name email phone) = (split-string line "\t")
+           collect
+           (cons (format "%s%s" name
+                         (khard--build-list-entry-detail email phone uid))
+                 uid)))
 
 (defun khard--prompt-contact (&optional prompt)
   "Prompt user for a contact, optionally make the prompt text PROMPT."
@@ -48,69 +44,69 @@
   "Process sentinel for kahrd commands.
 For info on PROC and STATUS, see `set-process-sentinel'."
   (when (memq (process-status proc) '(exit signal))
-    (shell-command-set-point-after-cmd (process-buffer proc))
     (message "khard: %s." (substring status 0 -1))))
 
+(cl-defun khard--run-khard (args &key filter)
+  "Run khard with ARGS.
+FILTER is a process filter to install on the child process."
+  (let ((process-environment process-environment))
+    (setenv "EDITOR" with-editor-sleeping-editor)
+    (make-process
+     :name (concat "khard" (car args))
+     :command (apply 'list khard-executable args)
+     :buffer nil
+     :filter filter
+     :sentinel 'khard--process-sentinel)))
+
 (defun khard-delete (contact no-confirm)
   "Delete CONTACT, which is of the form (name . uid).
 When called interactively, prompt the user.
 If NO-CONFIRM is nil, do not ask the user."
   (interactive (list (khard--prompt-contact "Delete Contact ") nil))
   (when (or no-confirm (yes-or-no-p (format "Really delete \"%s\"? "
-                                            (car-safe contact))))
-    (make-process :name "khard delete"
-                  :command
-                  `("khard" "delete" "--force"
-                    ,(format "uid:%s" (cdr-safe contact)))
-                  :buffer " *khard output*"
-                  :sentinel #'khard--process-sentinel)))
+                                            (car contact))))
+    (khard--run-khard (list "delete" "--force"
+                            (format "uid:%s" (cdr contact))))))
 
 (defun khard--prompt-address-book ()
   "Prompt for an address book."
   (completing-read "Address Book " (process-lines "khard" "abooks")))
 
 (defun khard--new-process-filter (proc str)
-  "Process filter for `khard-new'.
+  "Process filter for `khard-new' and `khard-edit'.
 PROC and STR are described in `set-process-filter'."
   (let ((lines (string-split str "\n"))
-        (error-msg nil))
+        (errors nil))
     (dolist (line lines)
-      (if (equal
-           "Do you want to open the editor again? (y/N) "
-           line)
-          (if (y-or-n-p (format "%sReopen the editor? "
-                                (or error-msg
-                                    "Unknown error")))
-              (process-send-string proc "y\n")
-            (process-send-string proc "n\n"))
-        (setq error-msg (concat error-msg "\n" line)))))
+      (cond
+       ((string-prefix-p "Do you want to open the editor again? " line)
+        (if (y-or-n-p (format "%sReopen the editor? "
+                              (cond
+                               ((null errors)
+                                "")
+                               ((length= errors 1)
+                                (concat (cl-first errors) ". "))
+                               (t
+                                (concat (string-join errors "\n") "\n")))))
+            (process-send-string proc "y\n")
+          (process-send-string proc "n\n")))
+       ((string-match (rx bos "Error: " (group (+ any)) eol) line)
+        (push (match-string 1 line) errors)))))
   (with-editor-process-filter proc str t))
 
 (defun khard-new (abook)
   "Create a new card and open it in an new buffer to edit.
 When called interactively, prompt for ABOOK."
   (interactive (list (khard--prompt-address-book)))
-  (when abook
-    (let ((error-msg nil))
-      (make-process :name "khard new"
-                    :command
-                    `("env" ,(concat "EDITOR=" with-editor-sleeping-editor)
-                      "khard" "new" "--edit" "-a" ,abook)
-                    :buffer " *khard output*"
-                    :filter #'khard--new-process-filter
-                    :sentinel #'khard--process-sentinel))))
+  (khard--run-khard (list "new" "--edit" "-a" abook)
+                    :filter 'khard--new-process-filter))
 
 (defun khard-edit (uid)
   "Edit the contact with UID.
 When called interactively, prompt the user."
   (interactive (list (cdr-safe (khard--prompt-contact "Edit Contact "))))
-  (make-process :name "khard edit"
-                :command
-                `("env" ,(concat "EDITOR=" with-editor-sleeping-editor)
-                 "khard" "edit" "--edit" ,(format "uid:%s" uid))
-                :buffer " *khard output*"
-                :filter #'khard--new-process-filter
-                :sentinel #'khard--process-sentinel))
+  (khard--run-khard (list "edit" "--edit" (format "uid:%s" uid))
+                    :filter 'khard--new-process-filter))
 
 (defun khard--parse-email-list (list-str)
   "Parse LIST-STR, a python dictionary and array string of emails."
@@ -133,7 +129,7 @@ When called interactively, prompt the user."
                ((= char ?\\)
                 (setq backslash t))
                ((= char ?')
-                (add-to-list 'output cur-str)
+                (push cur-str output)
                 (setq cur-str ""
                       in-quote nil))
                (t
@@ -148,27 +144,65 @@ When called interactively, prompt the user."
 
 (defun khard--make-email-contacts-list ()
   "Make a list of email contacts from khard."
-  (let ((lines (process-lines "khard"
-                              "ls"
-                              "--parsable"
-                              "--fields=name,emails"))
+  (let ((lines (process-lines "khard" "ls"
+                              "--parsable" "--fields=name,emails"))
         (output nil))
     (dolist (line lines)
-      (let* ((fields (split-string line "\t"))
-             (name (car fields))
-             (email-list (cadr fields)))
+      (cl-destructuring-bind (name email-list)
+          (split-string line "\t")
         (dolist (email (khard--parse-email-list email-list))
-          (add-to-list 'output (format "%s <%s>"
-                                       name
-                                       email)))))
-    output))
+          (push (format "%s <%s>"
+                        name
+                        email)
+                output))))
+    (seq-uniq output)))
+
+(defun khard--contacts-cache (&optional force)
+  "Return the contacts cache, building it if nessesary.
+With FORCE, rebuild the cache no matter what."
+  (when (or force (not khard--contacts-cache))
+    (setq-local khard--contacts-cache (khard--make-email-contacts-list)))
+  khard--contacts-cache)
 
 (defun khard-insert-email-contact ()
   "Use `completing-read' to prompt for and insert a khard contact."
   (interactive)
   (if-let (contact (completing-read "Insert Contact "
-                                    (khard--make-email-contacts-list)))
+                                    (khard--contacts-cache t)))
       (insert contact)))
 
+(defun khard--message-in-header-p (name &optional testfn)
+  "If in field NAME, return the start of the header, otherwise, return nil.
+The name is compared with the field name using TESTFN (defaults to `equal')."
+  (save-excursion
+    (when (and (message-point-in-header-p)
+               (message-beginning-of-header t))
+      (beginning-of-line)
+      (when (and (looking-at (rx bol (group (+? any)) ":" (? " ")))
+                 (funcall (or testfn 'equal) (match-string 1) name))
+        (match-end 0)))))
+
+(defun khard-message-mode-capf ()
+  "Completion at point function for khard contacts in message mode."
+  (interactive)
+  (when-let ((field-start (khard--message-in-header-p "To")))
+    (save-excursion
+      (let ((end (point)))
+        (re-search-backward (rx (any "\n" "," ":") (* whitespace))
+                            field-start t)
+        (list (match-end 0) end (khard--contacts-cache))))))
+
+(defun khard-refresh-contact-cache (all-buffers &optional no-refresh)
+  "Refresh the khard contact cache.
+When ALL-BUFFERS is non-nil, as it is with a prefix argument, refresh the cache
+of all buffers.  With NO-REFRESH, don't refresh the cache, just clear it."
+  (interactive "P")
+  (let ((new-cache (and (not no-refresh) (khard--make-email-contacts-list))))
+    (if all-buffers
+        (cl-loop for buf being the buffers do
+                 (setf (buffer-local-value 'khard--contacts-cache buf)
+                       new-cache))
+      (setq-local khard--contacts-cache new-cache))))
+
 (provide 'khard)
 ;;; khard.el ends here

elisp/latex-help.el

@@ -0,0 +1,681 @@
+;;; latex-help.el --- Lookup LaTeX symbols  -*- lexical-binding: t -*-
+
+;;; Commentary:
+;; This is inspired by an old package (originally from the 90s!!) called
+;; ltx-help.el.  That package used to be called latex-help.el too, but it seems
+;; to have had its name changed sometime around 2010.  This package aims for
+;; similar functionality, but using more up to date and convention-conforming
+;; Elisp.  For example, the original package still assumes that you may not have
+;; `add-hook' or `buffer-substring-no-properties'.  Only very old versions of
+;; Emacs are missing these, so almost everyone has them nowadays.
+;;
+;; This file is mostly internal functions.  People looking to use this are
+;; probably only interested in the following commands:
+;;   - `latex-help-command'
+;;   - `latex-help-environment'
+;;   - `latex-help-package'
+;;   - `latex-help-class'
+;;   - `latex-help-texdoc'
+;;   - `latex-help-at-point'
+;;   - `latex-help'
+;; The configuration options controlling these can be found by running
+;;   M-x customize-group RET latex-help RET
+
+;;; Code:
+(require 'info)
+(require 'cl-lib)
+(require 'shr)
+
+(defcustom latex-help-info-manual "latex2e"
+  "The name of the info manual to use when looking up latex commands."
+  :group 'latex-help
+  :type '(choice
+	      (string :tag "English" "latex2e")
+	      (string :tag "French" "latex2e-fr")
+	      (string :tag "Spanish" "latex2e-es")))
+
+(defcustom latex-help-buffer-name "*latex-help*"
+  "The name of the info buffer to use when showing LaTeX documentation."
+  :group 'latex-help
+  :type 'string)
+
+(defcustom latex-help-texdoc-buffer-name "*latex-help-texdoc*"
+  "The name of the buffer to use when showing texdoc files."
+  :group 'latex-help
+  :type 'string)
+
+(defcustom latex-help-texdoc-program "texdoc"
+  "The program to use when looking things up with texdoc."
+  :group 'latex-help
+  :type '(string :tag "Executable name"))
+
+(defcustom latex-help-max-texdoc-entries 10
+  "Maximum number of texdoc entries to show when prompting."
+  :group 'latex-help
+  :type 'interger)
+
+(defcustom latex-help-pdf-view-program '(emacs "evince")
+  "The program to use to view PDF documentation files."
+  :group 'latex-help
+  :type '(choice
+          (string :tag "External program")
+          (const :tag "Texdoc default" texdoc)
+          (function :tag "Custom function")
+          (list :tag "Emacs Doc-View mode"
+                (const :tag "Emacs will be used as the default" emacs)
+                (choice :tag "Backup"
+                        (string :tag "Use external program as a backup")
+                        (const :tag "Use texdoc default as a backup" texdoc)
+                        (function :tag "Use a custom function as a backup")))))
+
+(defcustom latex-help-html-view-program 'emacs
+  "The program to use to view HTML documentation files."
+  :group 'latex-help
+  :type '(choice
+          (string :tag "External program")
+          (const :tag "Texdoc default" texdoc)
+          (const :tag "Emacs internal HTML engine" emacs)
+          (function :tag "Custom function")))
+
+(defcustom latex-help-documentation-roots '("/usr/share/texmf-dist/doc/")
+  "The directories to search to discover texdoc entries."
+  :group 'latex-help
+  :type '(repeat directory))
+
+(defvar latex-help--class-cache nil
+  "Cache of discovered LaTeX document classes.")
+
+(defvar latex-help--environment-cache nil
+  "Cache of discovered LaTeX environments.")
+
+(defvar latex-help--package-cache nil
+  "Cache of discovered LaTeX packages.")
+
+(defvar latex-help--commands-cache nil
+  "Cache of discovered of LaTeX commands.
+These do NOT have a leading '\\'.")
+
+(defvar latex-help--texdoc-cache nil
+  "Cache of texdoc entries.")
+
+(defvar latex-help--caches-initialized-p nil
+  "Non-nil if the latex-help caches have been initialized.")
+
+(defun latex-help--maybe-init-caches ()
+  "Init the latex-help caches if they ware empty."
+  (unless latex-help--caches-initialized-p
+    (setq latex-help--commands-cache (latex-help--discover-commands)
+          latex-help--package-cache (latex-help--discover-packages)
+          latex-help--environment-cache (latex-help--discover-environments)
+          latex-help--class-cache (latex-help--discover-classes)
+          latex-help--texdoc-cache (latex-help--discover-texdoc-entries)
+          latex-help--caches-initialized-p t)))
+
+(defun latex-help--open-file-with (cmd file)
+  "Open FILE with shell command CMD."
+  (call-process-shell-command (format "%s %s" cmd
+                                      (shell-quote-argument file))
+                              nil 0))
+
+(defun latex-help--open-file-with-texdoc (file)
+  "Open FILE with texdoc."
+  (call-process latex-help-texdoc-program nil 0 nil "--just-view" file))
+
+(defun latex-help--texdoc-open-pdf-file (file)
+  "Open the PDF file FILE."
+  (cond
+   ((and (listp latex-help-pdf-view-program)
+         (eq (car latex-help-pdf-view-program) 'emacs))
+    (let ((backup (cadr latex-help-pdf-view-program)))
+      (cond
+       ((display-graphic-p)
+        (find-file-other-window file))
+       ((eq backup 'texdoc)
+        (latex-help--open-file-with-texdoc file))
+       ((functionp backup)
+        (funcall backup file))
+       ((stringp backup)
+        (latex-help--open-file-with backup file)))))
+   ((eq latex-help-pdf-view-program 'texdoc)
+    (latex-help--open-file-with-texdoc file))
+   ((functionp latex-help-pdf-view-program)
+    (funcall latex-help-pdf-view-program file))
+   ((stringp latex-help-pdf-view-program)
+    (latex-help--open-file-with latex-help-pdf-view-program file))))
+
+(defun latex-help--pop-to-texdoc-buffer ()
+  "Pop to (and possibly create) the texdoc buffer.
+The buffer's name is from `latex-help-texdoc-buffer-name'."
+  (pop-to-buffer (get-buffer-create latex-help-texdoc-buffer-name))
+  (setq buffer-read-only t)
+  (special-mode))
+
+(defun latex-help--texdoc-open-html-file (file)
+  "Open the HTML file FILE."
+  (cond
+   ((eq latex-help-html-view-program 'emacs)
+    (latex-help--pop-to-texdoc-buffer)
+    (let ((buffer-read-only nil))
+      (erase-buffer)
+      (insert-file-contents file nil)
+      (shr-render-region (point-min) (point-max))
+      (goto-char (point-min))))
+   ((eq latex-help-html-view-program 'texdoc)
+    (latex-help--open-file-with-texdoc file))
+   ((functionp latex-help-html-view-program)
+    (funcall latex-help-html-view-program file))
+   ((stringp latex-help-html-view-program)
+    (latex-help--open-file-with latex-help-html-view-program file))))
+
+(defun latex-help--texdoc-maybe-text-file (file)
+  "Try to open FILE as a text file.
+Read FILE into a buffer.  If it is a text file, show the user that buffer, and
+return t. Otherwise, kill the buffer and return nil."
+  (with-current-buffer (generate-new-buffer "*latex-help-texdoc-temp*")
+    (setq buffer-read-only t)
+    (special-mode)
+    (let ((buffer-read-only nil))
+      (erase-buffer)
+      (insert-file-contents file nil)
+      (if (eq buffer-file-coding-system 'no-conversion)
+          ;; the file was a binary file
+          (progn
+            (let ((kill-buffer-query-functions nil))
+              (set-buffer-modified-p nil)
+              (kill-buffer (current-buffer))
+              (user-error "File \"%s\" is binary" file)))
+        ;; we are good to go
+        (when-let (old-buffer (get-buffer latex-help-texdoc-buffer-name))
+          (kill-buffer old-buffer))
+        (rename-buffer latex-help-texdoc-buffer-name)
+        (pop-to-buffer (current-buffer))))))
+
+(defun latex-help--texdoc-open-file (file)
+  "Open the texdoc file FILE.
+This will attempt to detect the file's type and open it with the correct
+program."
+  (let ((ext (or (file-name-extension file) "")))
+    (cond
+     ((string-equal-ignore-case ext "pdf")
+      (latex-help--texdoc-open-pdf-file file))
+     ((string-equal-ignore-case ext "html")
+      (latex-help--texdoc-open-html-file file))
+     (t (latex-help--texdoc-maybe-text-file file)))))
+
+(defun latex-help--get-thing-at-point ()
+  "Return a cons of the LaTeX thing at point and its type (as a symbol).
+If nothing is found, return nil.
+The following types are known:
+  - command
+  - package
+  - environment
+  - class
+
+The following are some examples:
+  - \\textbf{Hello World}                     -> \\='(\"textbf\" . command)
+  - \\begin{math} (on \"math\")               -> \\='(\"math\" . environment)
+  - \\begin{math} (on \"begin\")              -> \\='(\"begin\" . command)
+  - \\usepackage{amsmath} (on \"amsmath\")    -> \\='(\"amsmath\" . package)
+  - \\usepackage{amsmath} (on \"usepackage\") -> \\='(\"usepackage\" . command)"
+  (save-excursion
+    (let ((orig-point (point)))
+      (when (eq (char-after) ?\\)
+        (forward-char))
+      (when (and (search-backward "\\" nil t)
+                 (looking-at (rx "\\"
+                                 (group (+ (not (any " " "\n" "("
+                                                     "{" "[" "|"
+                                                     "}" "]" ")" "%")))))))
+        (let ((cmd (match-string-no-properties 1)))
+          (if (> (match-end 1) orig-point)
+              (cons cmd 'command)
+            (goto-char orig-point)
+            (condition-case _
+                (progn
+                  (backward-up-list nil t t)
+                  (when (looking-at (rx "{" (group (+ (not (any "}" "\n"))))))
+                    (let ((thing (match-string-no-properties 1)))
+                      (cond
+                       ((equal cmd "usepackage")
+                        (cons thing 'package))
+                       ((or (equal cmd "begin")
+                            (equal cmd "end"))
+                        (cons thing 'environment))
+                       ((equal cmd "documentclass")
+                        (cons thing 'class))))))
+              ;; just return nil
+              ((or user-error scan-error)))))))))
+
+(defun latex-help--is-marker-file (file root)
+  "Return non-nil if FILE is a texdoc marker file under ROOT.
+A marker file is a file that signifies that its parent is a texdoc entry."
+  (let ((name (file-name-nondirectory file))
+        (dirname (file-name-nondirectory
+                  (directory-file-name (file-name-parent-directory file))))
+        (case-fold-search t))
+    (and
+     (not (length= (file-name-split (file-relative-name file root)) 2))
+     (or (string-match (rx bos "readme" (* "." (+ (any (?a . ?z))))) name)
+         (string-match (rx bos "doc" eos) name)
+         (string-match (rx bos "base" eos) name)
+         ;; check if file is just its parent directories name with an .tex or
+         ;; .pdf
+         (string-match (format "^%s[-0-9]*\\.\\(?:tex\\|pdf\\)$"
+                               (regexp-quote dirname))
+                       name)))))
+
+(defun latex-help--search-texdoc-root (root found)
+  "Search the texdoc root directory ROOT and discover package names.
+FOUND is the hash table in which to put the entries."
+  (cl-loop with to-search = nil
+           for dir = root then (pop to-search)
+           while dir
+           when (file-directory-p dir) do
+           (let ((files (directory-files dir t)))
+             (if (cl-member-if (lambda (file)
+                                 (latex-help--is-marker-file file root))
+                               files)
+                 ;; dir is an entry
+                 (puthash (file-name-nondirectory dir) nil found)
+               ;; search all subdirs
+               (setq to-search
+                     (nconc to-search
+                            (seq-filter
+                             (lambda (file)
+                               (let ((name (file-name-nondirectory file)))
+                                 (and (not (equal name "."))
+                                      (not (equal name "..")))))
+                             files)))))))
+
+(defun latex-help--texdoc-config-files ()
+  "Return a list of texdoc config files."
+  (with-temp-buffer
+    (call-process latex-help-texdoc-program nil t nil "--files")
+    ;; goto line 3
+    (goto-char (point-min))
+    (forward-line 2)
+    (cl-loop while (re-search-forward (rx bol (+ " ") "active" "\t"
+                                          (group (+ any)) eol) nil t)
+             collect (match-string 1))))
+
+(defun latex-help--texdoc-config-file-entries (file found)
+  "Parse the texdoc config file FILE to find entries.
+This attempts to find entries that might have been missed during the initial
+scan.  The entries will be `puthash'ed into FOUND as keys."
+  (with-temp-buffer
+    (insert-file-contents file)
+    (goto-char (point-min))
+    (while (re-search-forward (rx bol "adjscore("
+                                  (group (+ (not ")"))) ")")
+                              nil t)
+      (puthash (match-string 1) nil found))
+    (goto-char (point-min))
+    (while (re-search-forward
+            (rx bol "alias" (? "(" (+ (any (?0 . ?9) ".")) ")")
+                " " (group (+ (not " ")))
+                " = " (group (* (not (any "#" "\n" " ")))))
+            nil t)
+      (puthash (match-string 1) nil found)
+      (let ((m2 (match-string 2)))
+        (unless (or (zerop (length m2))
+                    (seq-contains-p m2 ?/))
+          (puthash m2 nil found))))))
+
+(defun latex-help--discover-texdoc-entries ()
+  "Discover texdoc entries in each of `latex-help-documentation-roots'."
+  (let ((found (make-hash-table :test 'equal)))
+    (dolist (root latex-help-documentation-roots)
+      (latex-help--search-texdoc-root root found))
+    (dolist (file (latex-help--texdoc-config-files))
+      (latex-help--texdoc-config-file-entries file found))
+    (cl-loop for entry being the hash-keys of found
+             collect entry)))
+
+(defun latex-help--texdoc-files-for-entry (entry)
+  "List the texdoc files for ENTRY.
+This returns a list of conses of the display name of the entry and the file it
+belongs to.  The first item the the returned list is the default value when
+prompting with `completing-read'."
+  (with-temp-buffer
+    (when-let ((exit-code (call-process latex-help-texdoc-program nil t
+                                        nil "-Ml" entry))
+               ((not (zerop exit-code))))
+      ;; try to get the programs output without the normal Emacs process
+      ;; sentinel message
+      (goto-char (point-max))
+      (forward-line -2)
+      (end-of-line)
+      (let ((msg (buffer-substring-no-properties (point-min)
+                                                 (point))))
+        (user-error "Texdoc exited with a non-zero code: %d%s"
+                    exit-code (if (not (zerop (length msg)))
+                                  (concat "\n\n" msg)
+                                ""))))
+    ;; the process succeeded, try to extract the files it found
+    (goto-char (point-min))
+    (cl-loop repeat latex-help-max-texdoc-entries
+             while (re-search-forward (rx (and bol (= 2 (+ (not "\t")) "\t")
+                                               (group (+ (not "\t")))
+                                               "\t"
+                                               (? (+ (not "\t")))
+                                               "\t"
+                                               (group (* any))))
+                                      nil t)
+             for file = (match-string 1)
+             for desc = (match-string 2)
+             unless (zerop (length desc))
+             collect (cons (format "%s (%s)" desc file) file)
+             else
+             collect (cons (format "%s (%s)" (file-name-nondirectory file) file)
+                           file))))
+
+(defun latex-help--texdoc-prompt-for-entry-file (entry)
+  "Prompt the user to open a texdoc file from ENTRY.
+This will return nil if the user does not want to open the file."
+  (let ((entries (latex-help--texdoc-files-for-entry entry)))
+    (if (length= entries 1)
+        (and (y-or-n-p (format "Open texdoc \"%s\"?" (caar entries)))
+             (cdar entries))
+      (let ((ans (completing-read "Texdoc File: " (mapcar 'car entries) nil t
+                                  nil nil (caar entries))))
+        (unless (zerop (length ans))
+          (cdr (assoc ans entries)))))))
+
+(defvar latex-help--texdoc-history nil
+  "History for `latex-heklp--list-texdoc-files'.")
+
+(defun latex-help--prompt-texdoc-entry ()
+  "Ask the user for a texdoc entry."
+  (latex-help--maybe-init-caches)
+  (let* ((tap (latex-help--get-thing-at-point))
+         (has-default-p (and (member (cdr tap) '(package class))
+                             (member (car tap) latex-help--texdoc-cache)))
+         (ans (completing-read (format "Texdoc Entry%s: "
+                                       (if has-default-p
+                                           (format " (default %s)" (car tap))
+                                         ""))
+                               latex-help--texdoc-cache
+                               nil nil nil 'latex-help--texdoc-history
+                               (and has-default-p (car tap)))))
+    (unless (zerop (length ans))
+      ans)))
+
+(defun latex-help--run-index-search (regexp)
+  "Search the LaTeX info pages index for REGEXP.
+This returns a list of cache entries suitable for use in
+`latex-help--commands-cache'."
+  (with-temp-buffer
+    (Info-mode)
+    (Info-find-node latex-help-info-manual "Index" nil t)
+    (let ((found))
+      (while (re-search-forward regexp nil t)
+        (let ((match (match-string-no-properties 1))
+              (node (match-string-no-properties 2)))
+          (if (equal (caar found) match)
+              (push (cons node (pos-bol)) (cdar found))
+            (push (list match (cons node (pos-bol))) found))))
+      found)))
+
+(defun latex-help--discover-commands ()
+  "Discover LaTeX commands.
+This is done by parsing the index for `latex-help-info-manual'."
+  (let ((found (latex-help--run-index-search
+                (rx (and bol "* \\"
+                         (group (or
+                                 ","
+                                 (+ (not (any " " "{" ",")))))
+                         (*? any) ":" (+ " ")
+                         (group (+? any)) ".")))))
+    (push (list "(SPACE)" "\\(SPACE)") found)
+    (when-let (entry (assoc "(...\\)" found))
+      (setq found (assoc-delete-all "(...\\)" found))
+      (push (cons "(" (cdr entry)) found)
+      (push (cons ")" (cdr entry)) found))
+    (when-let (entry (assoc "[...\\]" found))
+      (setq found (assoc-delete-all "[...\\]" found))
+      (push (cons "[" (cdr entry)) found)
+      (push (cons "]" (cdr entry)) found))
+    found))
+
+(defun latex-help--discover-packages ()
+  "Discover LaTeX packages.
+This is done by parsing the index for `latex-help-info-manual'."
+  (latex-help--run-index-search (rx (and bol "* package, "
+                                         (group (+? any))
+                                         (any " " ":")
+                                         (+? any) (+ " ")
+                                         (group (+? any))
+                                         "."))))
+
+(defun latex-help--discover-environments ()
+  "Discover LaTeX environments.
+This is done by parsing the index for `latex-help-info-manual'."
+  (latex-help--run-index-search (rx (and bol "* environment, "
+                                         (group (+? any))
+                                         (any " " ":" "-")
+                                         (+? any) (+ " ")
+                                         (group (+? any))
+                                         "."))))
+
+(defun latex-help--discover-classes ()
+  "Discover LaTeX document classes.
+This is done by parsing the index for `latex-help-info-manual'."
+  (latex-help--run-index-search (rx (and bol "* "
+                                         (group (+ (not (any "," " "))))
+                                         " class:" (+ " ")
+                                         (group (+ (not ".")))))))
+
+(defun latex-help--info-goto-entry (entry)
+  "Open the info page for ENTRY, a cache entry."
+  (let ((buffer (get-buffer-create latex-help-buffer-name)))
+    (with-current-buffer buffer
+      (unless (derived-mode-p 'Info-mode)
+        (Info-mode))
+      (Info-find-node latex-help-info-manual "Index" nil t)
+      (goto-char (cdr entry))
+      (Info-follow-nearest-node))
+    (pop-to-buffer buffer)))
+
+(defun latex-help--get-cache-for-type (type)
+  "Lookup the cache for TYPE.
+If the caches are not yet initialized, do that first."
+  (latex-help--maybe-init-caches)
+  (cl-case type
+    (command latex-help--commands-cache)
+    (package latex-help--package-cache)
+    (environment latex-help--environment-cache)
+    (class latex-help--class-cache)))
+
+(defvar latex-help--info-history nil
+  "History list for `latex-help--prompt-for'.")
+
+(defun latex-help--maybe-prompt-entry (name type &optional default)
+  "Lookup and prompt the user for the node of NAME.
+The lookup is performed in the correct cache for TYPE.  If there is only one
+node associated with NAME, return its entry.  Otherwise, ask the user which node
+they want to use.
+
+If DEFAULT is non-nil, use that instead of prompting.  If it does not exist,
+return nil."
+  (when-let (entries (cdr (assoc name (latex-help--get-cache-for-type type))))
+    (cond
+     (default
+      (assoc default entries))
+     ((length= entries 1)
+      (car entries))
+     (t
+      (let ((resp (completing-read "Select Node: " (mapcar 'car entries)
+                                   nil t nil)))
+        (assoc resp entries))))))
+
+(defun latex-help--prompt-for (type)
+  "Prompt for a command, environment, etc. from TYPE.
+This returns the name of the thing that was prompted."
+  (let* ((cache (latex-help--get-cache-for-type type))
+         (tap (latex-help--get-thing-at-point))
+         (default (and (eq (cdr tap) type) (car tap))))
+    (unless (assoc default cache)
+      (setq default nil))
+    (completing-read (format "LaTeX %s%s: "
+                             (capitalize (symbol-name type))
+                             (if default
+                                 (format " (default %s)" default)
+                               ""))
+                     (latex-help--get-cache-for-type type)
+                     nil t nil 'latex-help--info-history
+                     default)))
+
+;;;###autoload
+(defun latex-help-command (name &optional node)
+  "Lookup the LaTeX command NAME.
+Unless NODE is non-nil, if NAME is in more than one node, prompt the user for
+which to use.  If NODE is non-nil, use that instead."
+  (interactive (list (latex-help--prompt-for 'command)))
+  (when-let (entry (latex-help--maybe-prompt-entry name 'command node))
+    (latex-help--info-goto-entry entry)))
+
+;;;###autoload
+(defun latex-help-environment (name &optional node)
+  "Lookup the LaTeX environment NAME.
+Unless NODE is non-nil, if NAME is in more than one node, prompt the user for
+which to use.  If NODE is non-nil, use that instead."
+  (interactive (list (latex-help--prompt-for 'environment)))
+  (when-let (entry (latex-help--maybe-prompt-entry name 'environment node))
+    (latex-help--info-goto-entry entry)))
+
+;;;###autoload
+(defun latex-help-package (name &optional node)
+  "Lookup the LaTeX package NAME.
+Unless NODE is non-nil, if NAME is in more than one node, prompt the user for
+which to use.  If NODE is non-nil, use that instead."
+  (interactive (list (latex-help--prompt-for 'package)))
+  (when-let (entry (latex-help--maybe-prompt-entry name 'package node))
+    (latex-help--info-goto-entry entry)))
+
+;;;###autoload
+(defun latex-help-class (name &optional node)
+  "Lookup the LaTeX document class NAME.
+Unless NODE is non-nil, if NAME is in more than one node, prompt the user for
+which to use.  If NODE is non-nil, use that instead."
+  (interactive (list (latex-help--prompt-for 'class)))
+  (when-let (entry (latex-help--maybe-prompt-entry name 'class node))
+    (latex-help--info-goto-entry entry)))
+
+;;;###autoload
+(defun latex-help-texdoc (name)
+  "Lookup NAME in the texdoc cache.
+When used interactively, prompt for NAME."
+  (interactive (list (latex-help--prompt-texdoc-entry)))
+  (latex-help--maybe-init-caches)
+  (when-let ((file (latex-help--texdoc-prompt-for-entry-file name)))
+    (latex-help--texdoc-open-file file)))
+
+(defun latex-help--prompt-info-and-texdoc (info-entry texdoc-entry)
+  "Prompt the user for both info and texdoc entries.
+INFO-ENTRY is an entry from one of the info caches.  TEXDOC-ENTRY is an entry
+from the texdoc cache."
+  (let* ((texdoc-files (and texdoc-entry
+                            (latex-help--texdoc-files-for-entry
+                             texdoc-entry)))
+         (prompts (nconc (mapcar (lambda (file)
+                                   (concat "(Texdoc) " (car file)))
+                                 texdoc-files)
+                         (mapcar (lambda (node)
+                                   (concat "(Info) " (car node)))
+                                 (cdr info-entry)))))
+    (when prompts
+      (let ((selected (completing-read "LaTeX Help: " prompts nil t nil
+                                       nil (when texdoc-files
+                                             (car prompts)))))
+        (when (string-match (rx bos "(" (group (+ (any (?a . ?z))
+                                                  (any (?A . ?Z))))
+                                ") " (group (* any)))
+                            selected)
+          (if (equal (match-string 1 selected) "Info")
+              (cons (assoc (match-string 2 selected) (cdr info-entry)) 'info)
+            (cons (cdr (assoc (match-string 2 selected) texdoc-files))
+                  'texdoc)))))))
+
+;;;###autoload
+(defun latex-help-at-point ()
+  "Try to lookup the LaTeX thing at point, whatever it may be.
+This will try to look up the command, package, document class, or environment at
+point.  If that thing at point is valid, it will open an info buffer to the
+documentation for that thing."
+  (interactive)
+  (latex-help--maybe-init-caches)
+  (if-let (thing (latex-help--get-thing-at-point))
+      (let ((info-entry (assoc (car thing) (latex-help--get-cache-for-type
+                                            (cdr thing))))
+            (texdoc-entry (and (member (cdr thing) '(class package environment))
+                               (cl-find (car thing) latex-help--texdoc-cache
+                                        :test 'equal))))
+        (unless (or info-entry texdoc-entry)
+          (user-error "Unknown %s: \"%s\""
+                      (symbol-name (cdr thing))
+                      (if (eq (cdr thing) 'command)
+                          (concat "\\" (car thing))
+                        (car thing))))
+        (cl-destructuring-bind (thing . type)
+            (latex-help--prompt-info-and-texdoc info-entry texdoc-entry)
+          (cl-case type
+            (texdoc
+             (latex-help--texdoc-open-file thing))
+            (info
+             (latex-help--info-goto-entry thing)))))
+    (user-error "Nothing at point to look up")))
+
+(defvar latex-help--general-history nil
+  "History for `latex-help'.")
+
+;;;###autoload
+(defun latex-help ()
+  "Get help with LaTeX.
+Prompt the user for an info topic or texdoc file, then open that thing."
+  (interactive)
+  (let ((prompts)
+        (tap (latex-help--get-thing-at-point))
+        (def-entry nil)
+        (def-name nil))
+    (latex-help--maybe-init-caches)
+    (cl-flet ((add-cache-for-type (type)
+                (dolist (entry (latex-help--get-cache-for-type type))
+                  (push (format "(Info) %s - %s"
+                                (capitalize (symbol-name type))
+                                (car entry))
+                        prompts)
+                  (when (and (eq type (cdr tap))
+                             (equal (car entry) (car tap)))
+                    (setq def-entry (car prompts)
+                          def-name (car entry))))))
+      (add-cache-for-type 'command)
+      (add-cache-for-type 'package)
+      (add-cache-for-type 'class)
+      (add-cache-for-type 'environment)
+      (dolist (entry latex-help--texdoc-cache)
+        (push (format "(Texdoc) %s" entry) prompts)
+        (when (and (member (cdr tap) '(class package environment))
+                   (equal entry (car tap)))
+          (setq def-entry (car prompts)
+                def-name entry)))
+      (when-let ((ans (completing-read (format "LaTeX Help%s: "
+                                               (if def-name
+                                                   (format " (default %s)"
+                                                           def-name)
+                                                 ""))
+                                       prompts
+                                       nil t nil 'latex-help--general-history
+                                       def-entry))
+                 ((not (zerop (length ans)))))
+        (if (string-prefix-p "(Texdoc) " ans)
+            (latex-help-texdoc (seq-subseq ans (length "(Texdoc) ")))
+          (string-match (rx "(Info) " (group (+ (not " ")))
+                            " - " (group (+ any)))
+                        ans)
+          (when-let ((thing (match-string 2 ans))
+                     (type (intern (downcase (match-string 1 ans))))
+                     (entry (latex-help--maybe-prompt-entry thing type)))
+            (latex-help--info-goto-entry entry)))))))
+
+(provide 'latex-help)
+;;; latex-help.el ends here

elisp/ltex-eglot.el

@@ -0,0 +1,416 @@
+;;; ltex-eglot.el --- LTeX support for Eglot. -*- lexical-binding: t -*-
+;;; Commentary:
+;;; Code:
+(require 'eglot)
+
+(defconst ltex-eglot-supported-languages
+  '("ar" "ast-ES" "be-BY" "br-FR" "ca-ES" "ca-ES-valencia" "da-DK" "de" "de-AT"
+    "de-CH" "de-DE" "de-DE-x-simple-language" "el-GR" "en" "en-AU" "en-CA" "en-GB"
+    "en-NZ" "en-US" "en-ZA" "eo" "es" "es-AR" "fa" "fr" "ga-IE" "gl-ES" "it"
+    "ja-JP" "km-KH" "nl" "nl-BE" "pl-PL" "pt" "pt-AO" "pt-BR" "pt-MZ" "pt-PT"
+    "ro-RO" "ru-RU" "sk-SK" "sl-SI" "sv" "ta-IN" "tl-PH" "uk-UA" "zh-CN")
+  "List of languages supportd by LTeX.")
+
+(defcustom ltex-eglot-server-binary "ltex-ls"
+  "The binary to use for the LTeX LSP server."
+  :group 'ltex-eglot
+  :type 'string)
+
+(defconst ltex-eglot-modes
+  ;; Source:
+  ;; https://github.com/emacs-languagetool/eglot-ltex/blob/master/eglot-ltex.el
+  '((org-mode :language-id "org")
+    (git-commit-elisp-text-mode :language-id "gitcommit")
+    (bibtex-mode :language-id "bibtex")
+    (context-mode :language-id "context")
+    (latex-mode :language-id "latex")
+    (LaTeX-mode :language-id "latex")
+    (markdown-mode :language-id "markdown")
+    (rst-mode :language-id "restructuredtext")
+    (text-mode :language-id "plaintext"))
+  "List of major mode that work with LanguageTool.")
+
+(defcustom ltex-eglot-mother-tounge "en-US"
+  "The user's native language."
+  :group 'ltex-eglot
+  :type '(string :tag "Language Code"))
+
+(defcustom ltex-eglot-language ltex-eglot-mother-tounge
+  "The main language to use when checking documents."
+  :group 'ltex-eglot
+  :type '(choice :tag "Language"
+                 (const :tag "Detect Automatically" "auto")
+                 (string :tag "Language Code"))
+  :set-after '(ltex-eglot-mother-tounge)
+  :safe 'stringp)
+
+(defcustom ltex-eglot-enable-spell-check nil
+  "Weather or not to enable spell checking with LTeX."
+  :group 'ltex-eglot
+  :type '(choice :tag "Status"
+                 (const :tag "Enabled" t)
+                 (const :tag "Disabled" nil)))
+
+(defcustom ltex-eglot-spell-check-rules
+  '(:en-US ["EN_CONTRACTION_SPELLING" "MORFOLOGIK_RULE_EN_US"])
+  "Rules to disable if `ltex-eglot-enable-spell-check' is nil."
+  :group 'ltex-eglot
+  :type '(plist :tag "Entries by language"
+                :key-type (string :tag "Language Code")
+                :value-type (repeat :tag "Rules" string)))
+
+(defun ltex-eglot--entry-file-p (entry)
+  "Check if ENTRY would be concidered a file by LTex LSP."
+  (when (stringp entry)
+    (string-prefix-p ":" entry)))
+
+(defun ltex-eglot--non-file-settings-plist-p (plist)
+  "Return non-nil if none of the values of PLIST refer to files.
+This is meant to check file-local saftey for the likes of
+`ltex-eglot-disabled-rules'."
+  (cl-loop for (_ entries) on plist by 'cddr
+           when (cl-some 'ltex-eglot--entry-file-p entries)
+           do (cl-return)
+           finally return t))
+
+(defcustom ltex-eglot-disabled-rules ()
+  "List of diagnostic rules to disable."
+  :group 'ltex-eglot
+  :type '(plist :tag "Entries by language"
+                :key-type (string :tag "Language Code")
+                :value-type (repeat :tag "Rules" string))
+  :safe 'ltex-eglot--non-file-settings-plist-p)
+
+(defcustom ltex-eglot-enabled-rules ()
+  "List of diagnostic rules to enable."
+  :group 'ltex-eglot
+  :type '(plist :tag "Entries by language"
+                :key-type (string :tag "Language Code")
+                :value-type (repeat :tag "Rules" string))
+  :safe 'ltex-eglot--non-file-settings-plist-p)
+
+(defcustom ltex-eglot-dictionary ()
+  "List of words in the LTeX dictionary."
+  :group 'ltex-eglot
+  :type '(plist :tag "Entries by language"
+                :key-type (string :tag "Language Code")
+                :value-type (repeat :tag "Words" string))
+  :safe 'ltex-eglot--non-file-settings-plist-p)
+
+(defun ltex-eglot--valid-latex-environments-p (plist)
+  "Check if PLIST is an OK value for the `ltex-eglot-latex-environemnts'."
+  (cl-loop for (name handling) on plist by 'cddr
+           unless (and (stringp name)
+                       (member handling '("ignore" "default")))
+           do (cl-return)
+           finally return t))
+
+(defcustom ltex-eglot-latex-environments ()
+  "Plist controlling the handling of LaTeX environments."
+  :group 'ltex-eglot
+  :type '(plist
+          :tag "Environments"
+          :key-type (string :tag "Name")
+          :value-type (choice :tag "Handling"
+                              (const :tag "Ignore" "ignore")
+                              (const :tag "Check" "default")))
+  :safe 'ltex-eglot--valid-latex-plist-p)
+
+(defun ltex-eglot--valid-latex-commands-p (plist)
+  "Check if PLIST is an OK value for the `ltex-eglot-latex-commands'."
+  (cl-loop for (name handling) on plist by 'cddr
+           unless (and (stringp name)
+                       (member handling '("ignore" "default" "dummy"
+                                          "pluralDummy" "vowelDummy")))
+           do (cl-return)
+           finally return t))
+
+(defcustom ltex-eglot-latex-commands ()
+  "Plist controlling the handling of LaTeX commands."
+  :group 'ltex-eglot
+  :type '(plist
+          :tag "Commands"
+          :key-type (string :tag "Name")
+          :value-type (choice :tag "Handling"
+                              (const :tag "Default" "default")
+                              (const :tag "Ignore" "ignore")
+                              (const :tag "Replace with dummy word" "dummy")
+                              (const :tag "Replace with dummy plural word"
+                                     "pluralDummy")
+                              (const :tag "Replace with dummy vowel word"
+                                     "vowelDummy")))
+  :safe 'ltex-eglot--valid-latex-plist-p)
+
+(defun ltex-eglot--valid-bibtex-plist-p (plist)
+  "Return non-nil if PLIST is an OK value for BibTeX options."
+  (cl-loop for (name handling) on plist by 'cddr
+           unless (and (stringp name)
+                       (booleanp handling))
+           do (cl-return)
+           finally return t))
+
+(defcustom ltex-eglot-bibtex-fields ()
+  "Plist controlling the handling of BibTeX fields."
+  :group 'ltex-eglot
+  :type '(plist
+          :tag "Fields"
+          :key-type (string :tag "Name")
+          :value-type (choice :tag "Handling"
+                              (const :tag "Ignore" nil)
+                              (const :tag "Check" t)))
+  :safe 'ltex-eglot--valid-bibtex-plist-p)
+
+(defcustom ltex-eglot-enable-picky-rules nil
+  "Weather or not to enable picky rules."
+  :group 'ltex-eglot
+  :type '(choice :tag "Status"
+                 (const :tag "Enabled" t)
+                 (const :tag "Disabled" nil))
+  :safe 'booleanp)
+
+(defcustom ltex-eglot-variable-save-method 'dir
+  "How to save variables added by quick fixes.
+This is one of the following:
+  - \\='dir\tSave in .dir-locals.el
+  - \\='file\tSave as a file local variable
+  - nil\tJust set the buffer local value, don't save the variable"
+  :group 'ltex-eglot
+  :type '(choice :tag "Save method"
+                 (const :tag "Directory local (saved)" dir)
+                 (const :tag "File local (saved)" file)
+                 (const :tag "Buffer local (not saved)" nil))
+  :safe 'symbolp)
+
+(defvar ltex-eglot-hidden-false-positives nil
+  "List of hidden false positives.
+This is intented to be set from .dir-locals.el.")
+(put 'ltex-eglot-hidden-false-positives 'safe-local-variable
+     'ltex-eglot--non-file-settings-plist-p)
+
+(defun ltex-eglot--merge-options-plists (value-type &rest lists)
+  "Merge each of the options plist LISTS.
+The values of each of the props can be any sequence, and will be converted to
+VALUE-TYPE.  Any keys will be converted to keyword symbols if they are strings."
+  (let ((output))
+    (dolist (list lists output)
+      (cl-loop for (prop value) on list by 'cddr
+               for norm-prop = (if (stringp prop)
+                                   (intern (concat ":" prop))
+                                 prop)
+               do
+               (setf (plist-get output norm-prop)
+                     (cl-coerce (seq-uniq
+                                 (seq-concatenate 'list
+                                                  (plist-get output norm-prop)
+                                                  value))
+                                value-type))))))
+
+(defun ltex-eglot--process-and-add-global (global &rest lists)
+  "Merge each of LISTS with `ltex-eglot--merge-options-plists'.
+If the result of the merger results in a list with the key t, merge GLOBAL in as
+well."
+  (let ((merged (apply 'ltex-eglot--merge-options-plists 'vector lists)))
+    (cl-loop with found-t = nil
+             for (prop value) on merged by 'cddr
+             when (eq prop t) do
+             (setq found-t t)
+             else collect prop into output
+             and collect value into output
+             finally return
+             (if found-t
+                 (ltex-eglot--merge-options-plists 'vector output global)
+               output))))
+
+(defun ltex-eglot--make-plist-props-symbols (plist)
+  "Make each of PLIST's props a symbol by calling `intern' on it."
+  (cl-loop for (prop value) on plist by 'cddr
+           collect (if (stringp prop)
+                       (intern (concat ":" prop))
+                     prop)
+           collect value))
+
+(defun ltex-eglot--process-bibtex-fields-plist (plist)
+  "Process a PLIST that might be `ltex-eglot-bibtex-fields'."
+  (cl-loop for (prop value) on plist by 'cddr
+           collect (if (stringp prop)
+                       (intern (concat ":" prop))
+                     prop)
+           collect (or value :json-false)))
+
+;; The ltex server doesn't work with eglot when running in standard io mode
+(defclass ltex-eglot-server (eglot-lsp-server)
+  ((setup-done-p :initform nil
+                 :accessor ltex-eglot-server--setup-done-p)
+   (hidden-positives :initform nil
+                     :accessor ltex-eglot-server--hidden-positives)
+   (dictionary :initform nil
+               :accessor ltex-eglot-server--dictionary)
+   (disabled-rules :initform nil
+                   :accessor ltex-eglot-server--disabled-rules)
+   (language :initform nil
+             :accessor ltex-eglot-server--language))
+  "LTeX server class.")
+
+(cl-defmethod ltex-eglot--disabled-rules-plist ((server ltex-eglot-server))
+  "Create a plist of disabled rules by language.
+SERVER is the server from which to get the rules."
+  (ltex-eglot--process-and-add-global
+   (default-value 'ltex-eglot-disabled-rules)
+   (ltex-eglot-server--disabled-rules server)
+   (and (not ltex-eglot-enable-spell-check)
+        ltex-eglot-spell-check-rules)))
+
+(cl-defmethod ltex-eglot--setup-server ((server ltex-eglot-server))
+  "Setup up SERVER for the first time."
+  ;; make sure that dir local stuff is picked up
+  (save-current-buffer
+    (when-let ((buf (cl-first (eglot--managed-buffers server))))
+      (set-buffer buf))
+    (setf
+     ;; merger of global values is mediated elsewhere
+     (ltex-eglot-server--hidden-positives server)
+     (if (local-variable-p 'ltex-eglot-hidden-false-positives)
+         ltex-eglot-hidden-false-positives
+       '(t))
+     (ltex-eglot-server--disabled-rules server)
+     (if (local-variable-p 'ltex-eglot-disabled-rules)
+         ltex-eglot-disabled-rules
+       '(t))
+     (ltex-eglot-server--dictionary server)
+     (if (local-variable-p 'ltex-eglot-dictionary)
+         ltex-eglot-dictionary
+       '(t))
+     (ltex-eglot-server--language server) ltex-eglot-language
+     (ltex-eglot-server--setup-done-p server) t)))
+
+(cl-defmethod ltex-eglot--build-workspace-settings-plist ((server ltex-eglot-server))
+  "Build the workspace settings plist for SERVER."
+  (unless (ltex-eglot-server--setup-done-p server)
+    (ltex-eglot--setup-server server))
+  (list
+   :language (ltex-eglot-server--language server)
+   :dictionary (ltex-eglot--process-and-add-global
+                (default-value 'ltex-eglot-dictionary)
+                (ltex-eglot-server--dictionary server))
+   :disabledRules (ltex-eglot--disabled-rules-plist server)
+   :enabledRules (ltex-eglot--merge-options-plists
+                  'vector
+                  ltex-eglot-enabled-rules)
+   :hiddenFalsePositives (ltex-eglot--process-and-add-global
+                          (default-value 'ltex-eglot-hidden-false-positives)
+                          (ltex-eglot-server--hidden-positives server))
+   :latex (list :commands (ltex-eglot--make-plist-props-symbols
+                           ltex-eglot-latex-commands)
+                :environments (ltex-eglot--make-plist-props-symbols
+                               ltex-eglot-latex-environments))
+   :bibtex (list :fields (ltex-eglot--process-bibtex-fields-plist
+                          ltex-eglot-bibtex-fields))
+   :additionalRules (list :motherTongue ltex-eglot-mother-tounge
+                          :enablePickyRules
+                          (or ltex-eglot-enabled-rules :json-false))))
+
+(defun ltex-eglot--cleanup-plist-for-dir-locals (plist)
+  "Cleanup PLIST for use in a .dir-locals.el file."
+  (cl-loop with has-global = nil
+           for (prop value) on plist by 'cddr
+           when (eq prop t) do
+           (setq has-global t)
+           else collect prop into output
+           and collect value into output
+           finally
+           (when has-global
+             (cl-callf nconc output (list t)))
+           finally return output))
+
+(cl-defmethod ltex-eglot--set-variable ((server ltex-eglot-server)
+                                        variable value)
+  "Set VARIABLE to VALUE in each buffer for SERVER.
+Also, maybe save VARIABLE in .dir-locals.el or as a file local variable."
+  (cl-case ltex-eglot-variable-save-method
+    (dir (add-dir-local-variable nil variable value))
+    (file (add-file-local-variable variable value)))
+  (dolist (buf (eglot--managed-buffers server))
+    (setf (buffer-local-value variable buf) value)))
+
+(defun ltex-eglot--handle-client-action (server command slot)
+  "Handle the client side action COMMAND for SERVER.
+SLOT is a slot in SERVER."
+  (let* ((arg (cl-case slot
+                (disabled-rules :ruleIds)
+                (hidden-positives :falsePositives)
+                (dictionary :words)))
+         (local-var (cl-case slot
+                      (disabled-rules 'ltex-eglot-disabled-rules)
+                      (hidden-positives 'ltex-eglot-hidden-false-positives)
+                      (dictionary 'ltex-eglot-dictionary)))
+         (args (elt (plist-get command :arguments) 0))
+         (newval (ltex-eglot--merge-options-plists
+                  'list
+                  (slot-value server slot) (plist-get args arg))))
+    (setf (slot-value server slot) newval)
+    (ltex-eglot--set-variable server local-var newval)
+    (eglot-signal-didChangeConfiguration server)))
+
+(cl-defmethod eglot-execute ((server ltex-eglot-server) action)
+  "Handler for LTeX actions.
+ACTION is the action which to run on SERVER."
+  (let ((kind (plist-get action :kind)))
+    (pcase kind
+      ("quickfix.ltex.disableRules"
+       (ltex-eglot--handle-client-action server (plist-get action :command)
+                                         'disabled-rules))
+      ("quickfix.ltex.hideFalsePositives"
+       (ltex-eglot--handle-client-action server (plist-get action :command)
+                                         'hidden-positives))
+      ("quickfix.ltex.addToDictionary"
+       (ltex-eglot--handle-client-action server (plist-get action :command)
+                                         'dictionary))
+      (_ (cl-call-next-method)))))
+
+(defun ltex-eglot--hack-server-config (oldfun server &optional path)
+  "Hack the config for SERVER into the return of ODLFUN.
+PATH is the same as for OLDFUN, which is probably
+`eglot--workspace-configuration-plist'."
+  (let ((conf (funcall oldfun server path)))
+    (when (ltex-eglot-server-p server)
+      (let ((ltex-conf (plist-get conf :ltex)))
+        (cl-loop for (prop val) on
+                 (ltex-eglot--build-workspace-settings-plist server)
+                 by 'cddr
+                 unless (plist-member ltex-conf prop)
+                 do (setf (plist-get ltex-conf prop) val))
+        (setf (plist-get conf :ltex) ltex-conf)))
+    conf))
+
+(defun ltex-eglot-set-language (language server &optional no-save)
+  "Set the SERVER's language to LANGUAGE.
+When called interactively, prompt for LANGUAGE.  With NO-SAVE, don't save the
+language setting in any file."
+  (interactive (list (completing-read "Language"
+                                      ltex-eglot-supported-languages)
+                     (eglot-current-server)
+                     current-prefix-arg))
+  (unless (ltex-eglot-server-p server)
+    (user-error "Current server is not an LTeX server!"))
+  (when-let ((server (eglot-current-server)))
+    (setf (ltex-eglot-server--language server) language)
+    (let ((ltex-eglot-variable-save-method
+           (and (not no-save)
+                ltex-eglot-variable-save-method)))
+      (ltex-eglot--set-variable server 'ltex-eglot-language language))
+    (eglot-signal-didChangeConfiguration server)))
+
+;;;###autoload
+(add-to-list 'eglot-server-programs
+             (cons ltex-eglot-modes
+                   (list
+                    'ltex-eglot-server
+                    ltex-eglot-server-binary "--server-type" "TcpSocket"
+                    "--no-endless" "--port" :autoport)))
+
+;;;###autoload
+(advice-add 'eglot--workspace-configuration-plist :around
+            'ltex-eglot--hack-server-config)
+
+(provide 'ltex-eglot)
+;;; ltex-eglot.el ends here

elisp/org-mu4e-compose.el

@@ -0,0 +1,365 @@
+;;; org-mu4e-compose.el --- Write mu4e messages with org-mode.  -*- lexical-binding: t; -*-
+;;; Commentary:
+
+;; I use evil.  This file does not depend on evil, but some of these keybindings
+;; shadow useful org keybinding with message mode keybindings because the org
+;; bindings being shadowed are available with evil under some other key sequence.
+
+;;; Code:
+(require 'mu4e)
+(require 'org-mime)
+(require 'shr)
+(require 'dom)
+(require 'sgml-mode)
+(require 'cl-lib)
+
+(defvar-local org-mu4e--html-message-p t
+  "Weather or not the current message should be htmlized.")
+
+(defvar-local org-mu4e--override-org-mode-check nil
+  "Internal variable.
+See `org-mu4e--override-org-mode-check-advice' for information about what this
+does.")
+
+(defvar org-mu4e--internal-message-mode-function
+  (symbol-function 'mu4e-compose-mode)
+  "The `message-mode' (or derived mode) used by `org-mu4e-compose-mode'.")
+
+(defun org-mu4e--override-org-mode-check-advice (oldfun &rest r)
+  "Around advice for various org mode functions.
+This function will call OLDFUN with arguments R with `major-mode' let-bound to
+\\='org-mode when `org-mu4e--override-org-mode-check' is t."
+  (let ((major-mode (if org-mu4e--override-org-mode-check
+                        'org-mode
+                      major-mode)))
+    (apply oldfun r)))
+
+(advice-add 'org-element-at-point :around
+            'org-mu4e--override-org-mode-check-advice)
+
+(defun org-mu4e-toggle-htmlize-mssage (&optional arg no-message)
+  "Toggle weather the current message should be htmlized.
+If ARG is a positive number or zero, enable htmlization, if it is negative,
+disable it.  Otherwise, toggle it.  With NO-MESSAGE, don't display a message
+about this change."
+  (interactive "P")
+  (setq org-mu4e--html-message-p (or (wholenump arg)
+                                     (and (not arg)
+                                          (not org-mu4e--html-message-p))))
+  (unless no-message
+    (message "Message will be %ssent with an HTML part."
+             (if org-mu4e--html-message-p "" "not ")))
+  (force-mode-line-update))
+
+(defun org-mu4e--bounds-of-mime-part (type)
+  "Find the bounds of the mime part for TYPE in the current buffer."
+  (save-excursion
+    (goto-char (point-min))
+    (when (and
+           (re-search-forward (rx bol (literal mail-header-separator) eol)
+                              nil t)
+           (re-search-forward (rx "<#multipart" (* any) ">")
+                              nil t)
+           (re-search-forward (rx "<#part " (* any)
+                                  "type=" (literal type) (* any) ">")
+                              nil t))
+      (let ((start (match-end 0))
+            (end (point-max)))
+        (when (re-search-forward
+               (rx (or (and "<#/" (or "part" "multipart") ">")
+                       (and "<#part" (* any) ">")))
+               nil t)
+          (setq end (match-beginning 0)))
+        (cons (1+ start) end)))))
+
+(defun org-mu4e--pretty-print-fontify-html-part ()
+  "Pretty print and fontify the HTML part of the current buffer."
+  (when-let ((bounds (org-mu4e--bounds-of-mime-part "text/html"))
+             (real-buf (current-buffer)))
+    (save-excursion
+      (let ((content
+             (with-temp-buffer
+               (insert-buffer-substring real-buf (car bounds) (cdr bounds))
+               (let (sgml-mode-hook html-mode-hook text-mode-hook)
+                 (html-mode))
+               (sgml-pretty-print (point-min) (point-max))
+               (indent-region (point-min) (point-max))
+               (put-text-property (point-min) (point-max) 'fontified nil)
+               (font-lock-ensure)
+               (buffer-string))))
+        (delete-region (car bounds) (cdr bounds))
+        (goto-char (car bounds))
+        (insert content)))))
+
+(defun org-mu4e--htmlize-and-cleanup ()
+  "HTMLize and cleanup the visible portion of the buffer.
+This moves point, wrap it in `save-excursion' if that is a problem."
+  (org-mime-htmlize)
+  ;; IDK why, but the above function adds a bunch of newlines to the end
+  ;; of the buffer.
+  (goto-char (point-min))
+  (when (re-search-forward (rx (group (* "\n")) "\n" eos) nil t)
+    (delete-region (match-beginning 1)
+                   (match-end 1)))
+  (font-lock-ensure)
+  (org-mu4e--pretty-print-fontify-html-part))
+
+(defun org-mu4e-preview-html ()
+  "Preview the HTML version of the current buffer in a new buffer.
+Return the newly created buffer."
+  (interactive)
+  (let ((msg-buffer (current-buffer))
+        (buffer (get-buffer-create "*Org-Mu4e HTML Preview*"))
+        (bounds (point-min))
+        (cur-max (point-max)))
+    (without-restriction
+      (with-current-buffer buffer
+        (special-mode)
+        (setq-local org-mu4e--override-org-mode-check t)
+        ;; Setup font-lock without all the other pesky major mode stuff
+        (org-set-font-lock-defaults)
+        (font-lock-add-keywords nil message-font-lock-keywords)
+        (let ((inhibit-read-only t))
+          (erase-buffer)
+          (insert-buffer-substring msg-buffer)
+          (narrow-to-region bounds cur-max)
+          (org-mu4e--htmlize-and-cleanup))
+        (goto-char (point-min))))
+    (switch-to-buffer-other-window buffer)
+    buffer))
+
+(defun org-mu4e-render-preview ()
+  "Render a preview of the HTML message."
+  (interactive)
+  (let ((msg-buffer (current-buffer))
+        (buffer (get-buffer-create "*Org-Mu4e Render Preview*")))
+    (save-excursion
+      (without-restriction
+        (goto-char (point-min))
+        (if (re-search-forward (rx bol (literal mail-header-separator) eol)
+                               nil t)
+            (let* ((start (1+ (match-end 0)))
+                   (org-export-with-latex org-mime-org-html-with-latex-default)
+                   (org-preview-latex-image-directory
+                    (expand-file-name "ltximg/" mm-tmp-directory))
+                   (default-directory org-preview-latex-image-directory)
+                   (org-html-postamble nil))
+              (narrow-to-region start (point-max))
+              (if-let ((export-data (org-export-as
+                                     'html nil t nil
+                                     org-mime-export-options)))
+                  (progn
+                    (with-current-buffer buffer
+                      (special-mode)
+                      (let ((inhibit-read-only t)
+                            (default-directory
+                             org-preview-latex-image-directory))
+                        (erase-buffer)
+                        (insert export-data)
+                        (shr-render-region (point-min) (point-max))
+                        ;; The above function inserts a text directionality
+                        ;; character and then two newlines, just to be safe,
+                        ;; check for them, then hide them
+                        (goto-char (point-min))
+                        (let ((new-start (point-min)))
+                          (when (or (eq (char-after) #x200e)
+                                    (eq (char-after) #x200f))
+                            (cl-incf new-start))
+                          (dotimes (_ 2)
+                            (forward-char)
+                            (when (eq (char-after) ?\n)
+                              (cl-incf new-start)))
+                          (narrow-to-region new-start (point-max)))))
+                    (switch-to-buffer-other-window buffer))
+                (user-error "HTML export failed")))
+          (user-error "Can't find message start in current buffer"))))))
+
+(defun org-mu4e-send (&optional arg)
+  "HTMLize and send the message in the current buffer.
+ARG is passed directly to `message-send'."
+  ;; This has to return a non-nil value so that org knows we handled the C-c C-c
+  (interactive "P")
+  (let ((modified (buffer-modified-p))
+        ;; we only restore the restriction if the sending below fails
+        (old-rest (cons (point-min) (point-max))))
+    (widen)
+    (let ((save-text (buffer-substring-no-properties (point-min)
+                                                     (point-max))))
+      (condition-case _
+          (progn
+            (when org-mu4e--html-message-p
+              (org-mu4e--htmlize-and-cleanup))
+            (message-send arg)
+            'sent)
+        ((or error quit)
+         (erase-buffer)
+         (insert save-text)
+         (narrow-to-region (car old-rest) (cdr old-rest))
+         (restore-buffer-modified-p modified)
+         'failed)))))
+
+(defun org-mu4e-send-and-exit (&optional arg)
+  "Call `org-mu4e-send', the save and kill the buffer.
+ARG is passed directly to `message-send'."
+  (interactive "P")
+  (when (eq (org-mu4e-send arg) 'sent)
+    (message-kill-buffer))
+  t ;; this tells org that we have handled the C-c C-c
+  )
+
+;;;###autoload
+(defun org-mu4e-compose-new (&rest r)
+  "This is like `mu4e-compose-new', but it utilizes `org-mu4e-compose-mode'.
+Each of the arguments in R are the same as `mu4e-compose-new', and are directly
+passed to it."
+  (interactive)
+  ;; Save local variables set by `mu4e-compose-new'
+  (let ((org-mu4e--internal-message-mode-function
+         (symbol-function 'mu4e-compose-mode)))
+    (cl-letf (((symbol-function 'mu4e-compose-mode) 'org-mu4e-compose-mode))
+      (apply 'mu4e-compose-new r))))
+
+;;;###autoload
+(defun org-mu4e-compose-reply-to (&optional to wide)
+  "This is like `mu4e-compose-reply-to', but utilizes `org-mu4e-compose-mode'.
+TO and WIDE are the same as `mu4e-compose-reply-to'."
+  (interactive)
+  ;; Save local variables set by `mu4e-compose-reply-to'
+  (let ((html-part-p (seq-find (lambda (handle)
+                                 (equal (mm-handle-media-type (cdr handle))
+                                        "text/html"))
+                               gnus-article-mime-handle-alist))
+        (org-mu4e--internal-message-mode-function
+         (symbol-function 'mu4e-compose-mode)))
+    (cl-letf (((symbol-function 'mu4e-compose-mode) 'org-mu4e-compose-mode))
+      (let ((buf (mu4e-compose-reply-to to wide)))
+        (with-current-buffer buf
+          (setq org-mu4e--html-message-p
+                ;; make the variable look nicer by not having random data in it
+                (not (not html-part-p))))))))
+
+;;;###autoload
+(defun org-mu4e-compose-reply (&optional wide)
+  "This is like `mu4e-compose-reply', but utilizes `org-mu4e-compose-mode'.
+WIDE is the same as `mu4e-compose-reply'."
+  (interactive "P")
+  (org-mu4e-compose-reply-to nil wide))
+
+;;;###autoload
+(defvar-keymap org-mu4e-compose-mode-map
+  :parent org-mode-map
+  ;; These come straight from `message-mode-map' and override `org-mode-map'
+  "C-c C-f C-t" #'message-goto-to
+  "C-c C-f C-o" #'message-goto-from
+  "C-c C-f C-b" #'message-goto-bcc
+  "C-c C-f C-w" #'message-goto-fcc
+  "C-c C-f C-c" #'message-goto-cc
+  "C-c C-f C-s" #'message-goto-subject
+  "C-c C-f C-r" #'message-goto-reply-to
+  "C-c C-f C-d" #'message-goto-distribution
+  "C-c C-f C-f" #'message-goto-followup-to
+  "C-c C-f C-m" #'message-goto-mail-followup-to
+  "C-c C-f C-k" #'message-goto-keywords
+  "C-c C-f C-u" #'message-goto-summary
+  "C-c C-f C-i" #'message-insert-or-toggle-importance
+  "C-c C-f C-a" #'message-generate-unsubscribed-mail-followup-to
+
+  ;; modify headers (and insert notes in body)
+  "C-c C-f s" #'message-change-subject
+  ;;
+  "C-c C-f x" #'message-cross-post-followup-to
+  ;; prefix+message-cross-post-followup-to = same without cross-post
+  "C-c C-f t" #'message-reduce-to-to-cc
+  "C-c C-f a" #'message-add-archive-header
+  ;; mark inserted text
+  "C-c M-m" #'message-mark-inserted-region
+  "C-c M-f" #'message-mark-insert-file
+
+  "C-c C-b" #'message-goto-body
+  "C-c C-i" #'message-goto-signature
+
+  "C-c C-t" #'message-insert-to
+  "C-c C-f w" #'message-insert-wide-reply
+  "C-c C-f C-e" #'message-insert-expires
+  "C-c M-u" #'message-insert-or-toggle-importance
+  "C-c M-n" #'message-insert-disposition-notification-to
+
+  "C-c C-y" #'message-yank-original
+  "C-c C-M-y" #'message-yank-buffer
+  "C-c C-S-q" #'message-fill-yanked-message
+  "C-c M-s" #'message-insert-signature
+  "C-c M-h" #'message-insert-headers
+  "C-c M-o" #'message-sort-headers
+
+  ;; C-c C-c to send and exit is handled by `org-ctrl-c-ctrl-c-hook'
+  "C-c C-s" #'org-mu4e-send
+  "C-c C-k" #'message-kill-buffer
+  "C-c C-d" #'message-dont-send
+
+  "C-c M-k" #'message-kill-address
+  "C-c M-e" #'message-elide-region
+  "C-c M-v" #'message-delete-not-region
+  "C-c M-z" #'message-kill-to-signature
+  "<remap> <split-line>" #'message-split-line
+  "<remap> <beginning-of-buffer>" #'mu4e-compose-goto-top
+  "<remap> <end-of-buffer>" #'mu4e-compose-goto-bottom
+
+  "C-c M-r" #'message-insert-screenshot
+
+  "M-n" #'message-display-abbrev
+
+  "C-c C-a" #'mail-add-attachment
+  "C-c M-t" #'org-mu4e-toggle-htmlize-mssage
+  "C-c M-p C-p" #'org-mu4e-preview-html
+  "C-c M-p C-w" #'org-mu4e-render-preview
+  "C-c C-;" #'mu4e-compose-context-switch)
+
+;;;###autoload
+(define-derived-mode org-mu4e-compose-mode org-mode "mu4e:org-compose"
+  "Major mode for editing mu4e messages with `org-mode' syntax.
+This is derived from `org-mode', but it also essentially runs
+`mu4e-compose-mode' and `message-mode'.  Therefore, it runs their hooks too."
+  ;; Enable all the things from `mu4e-compose-mode' (which derives from
+  ;; `message-mode'), but don't let it change the major mode (or other things we
+  ;; care about).
+  (when org-mu4e--internal-message-mode-function
+    (let ((major-mode major-mode)
+          (mode-name mode-name)
+          (local-abbrev-table local-abbrev-table)
+          (font-lock-defaults font-lock-defaults)
+          ;; some of these are not actually changed, but they are here just in
+          ;; case they change in the future...
+          (comment-start comment-start)
+          (comment-end comment-end)
+          (comment-start-skip comment-start-skip)
+          (comment-add comment-add)
+          (comment-style comment-style))
+      (cl-letf (((symbol-function 'kill-all-local-variables) 'ignore)
+                ((symbol-function 'use-local-map) 'ignore)
+                ((symbol-function 'set-syntax-table) 'ignore))
+        (funcall org-mu4e--internal-message-mode-function))))
+  ;; Add `message-mode' keyword and quote highlighting on top of the org syntax
+  ;; highlighting
+  (font-lock-add-keywords nil message-font-lock-keywords)
+  (setq-local org-mu4e--override-org-mode-check t)
+  (add-to-list (make-local-variable 'org-ctrl-c-ctrl-c-final-hook)
+               'org-mu4e-send-and-exit)
+  (add-to-list (make-local-variable 'mode-line-misc-info)
+               '(:eval (if org-mu4e--html-message-p
+                           "Text/HTML "
+                         "Text Only "))))
+
+;;;###autoload
+(define-mail-user-agent 'org-mu4e-user-agent
+  #'org-mu4e-compose-new
+  #'org-mu4e-send-and-exit
+  #'message-kill-buffer
+  'message-send-hook)
+
+;;;###autoload
+(defun org-mu4e-user-agent ()
+  "Return `org-mu4e-user-agent'."
+  'org-mu4e-user-agent)
+
+(provide 'org-mu4e-compose)
+;;; org-mu4e-compose.el ends here

third-party/kdl-ts-mode.el

@@ -29,10 +29,10 @@
 
 (defvar kdl-ts-mode--syntax-table
   (let ((table (make-syntax-table)))
-    (modify-syntax-entry ?=  ".")
-    (modify-syntax-entry ?/  ". 124")
-    (modify-syntax-entry ?*  ". 23b")
-    (modify-syntax-entry ?\n ">")
+    (modify-syntax-entry ?=  "." table)
+    (modify-syntax-entry ?/  ". 124" table)
+    (modify-syntax-entry ?*  ". 23b" table)
+    (modify-syntax-entry ?\n ">" table)
     table)
   "Syntax table for `kdl-ts-mode'.")