Compare commits

..
10 Commits
Author SHA1 Message Date
zedhugh 52f3c3ee66 use "creature/pkg-active" manage packages manually
- replace "add-pkg-in-pkg-dir" (recursive load-path scanning) with a
  central "creature/pkgs" registry that handles load path, autoloads,
  info dirs and dependencies
- adapt all init-*.el files to the new activation function
- add a top-level Makefile to byte-compile site-lisp packages
- remove unused "emacs-kv" and "emacs-db" submodules
2026-09-14 14:45:56 +08:00
zedhugh 283ff41a5e use "use-short-answers" instead of (fset 'yes-or-no-p 'y-or-n-p) 2026-08-31 00:55:45 +08:00
zedhugh 78172b20d7 don't add to "load-path" any directory contains ".nosearch" file 2026-08-31 00:52:45 +08:00
zedhugh b301edb39e use "\\'" instead of "$" in auto-mode-alist 2026-08-31 00:51:52 +08:00
zedhugh 525799407e remove duplicated defvar "creature/mode-line-region-info" 2026-08-31 00:51:00 +08:00
zedhugh 2e8ef80c3c fix typos 2026-08-31 00:49:51 +08:00
zedhugh 612d75d2a1 add submodule "deflate" needed by "plantuml-mode" 2026-08-31 00:47:04 +08:00
zedhugh daef732009 replace pinentry.el with pinentry submodule 2026-08-16 17:20:59 +08:00
zedhugh 6c3aca3bc0 add configuration for native-comp 2026-08-16 17:20:54 +08:00
zedhugh 0ae8a2a08c enable json-ts-mode for jsonc file 2026-08-01 20:26:10 +08:00
37 changed files with 481 additions and 624 deletions

No files matched your search

+1
View File
@@ -18,3 +18,4 @@
/network-security.eld
/nov-places
/url/
/eln-cache/
+6 -6
View File
@@ -193,12 +193,6 @@
[submodule "site-lisp/esxml"]
path = site-lisp/esxml
url = https://github.com/tali713/esxml.git
[submodule "site-lisp/emacs-kv"]
path = site-lisp/emacs-kv
url = https://github.com/nicferrier/emacs-kv.git
[submodule "site-lisp/emacs-db"]
path = site-lisp/emacs-db
url = https://github.com/nicferrier/emacs-db.git
[submodule "site-lisp/edit-indirect"]
path = site-lisp/edit-indirect
url = https://github.com/Fanael/edit-indirect.git
@@ -214,3 +208,9 @@
[submodule "site-lisp/crontab-mode"]
path = site-lisp/crontab-mode
url = https://github.com/emacs-pe/crontab-mode.git
[submodule "site-lisp/pinentry"]
path = site-lisp/pinentry
url = https://github.com/ueno/pinentry-el.git
[submodule "site-lisp/deflate"]
path = site-lisp/deflate
url = https://github.com/skuro/deflate.git
+239
View File
@@ -0,0 +1,239 @@
EMACS ?= emacs
ROOT := $(patsubst %/,%,$(dir $(abspath $(lastword $(MAKEFILE_LIST)))))
SITE_LISP := $(ROOT)/site-lisp
INSTALL_INFO ?= $(shell command -v ginstall-info || printf install-info)
INFO_DIR ?= $(ROOT)/.cache
.PHONY: transient emms
all: magit git-modes emmet-mode expand-region rg wgrep avy mwim symbol-overlay markdown-mode emms dash yasnippet yaml file gptel nov org plantuml-mode posframe prettier rime f s sdcv vertico
clean: compat-clean cond-let-clean llama-clean transient-clean with-editor-clean magit-clean git-modes-clean emmet-mode-clean expand-region-clean rg-clean wgrep-clean avy-clean mwim-clean symbol-overlay-clean markdown-mode-clean emms-clean dash-clean yasnippet-clean yaml-clean file-clean gptel-clean nov-clean org-clean plantuml-mode-clean posframe-clean prettier-clean rime-clean f-clean s-clean sdcv-clean vertico-clean
compat:
$(MAKE) -C $(SITE_LISP)/compat compile compat.info
$(INSTALL_INFO) --info-dir=$(INFO_DIR) $(SITE_LISP)/compat/compat.info
compat-clean:
$(INSTALL_INFO) --delete --quiet --info-dir=$(INFO_DIR) $(SITE_LISP)/compat/compat.info
$(MAKE) -C $(SITE_LISP)/compat clean
cond-let:
$(MAKE) -C $(SITE_LISP)/cond-let lisp
cond-let-clean:
$(MAKE) -C $(SITE_LISP)/cond-let clean
llama: compat
$(MAKE) -C $(SITE_LISP)/llama lisp
llama-clean:
$(MAKE) -C $(SITE_LISP)/llama clean
transient: compat cond-let
$(MAKE) -C $(SITE_LISP)/transient lisp info
transient-clean:
$(MAKE) -C $(SITE_LISP)/transient clean
with-editor: compat cond-let
$(MAKE) -C $(SITE_LISP)/with-editor lisp info
with-editor-clean:
$(MAKE) -C $(SITE_LISP)/with-editor clean
magit: compat cond-let llama transient with-editor
$(MAKE) -C $(SITE_LISP)/magit/lisp lisp
$(MAKE) -C $(SITE_LISP)/magit info
magit-clean:
$(MAKE) -C $(SITE_LISP)/magit clean
git-modes: compat
$(MAKE) -C $(SITE_LISP)/git-modes lisp
git-modes-clean:
$(MAKE) -C $(SITE_LISP)/git-modes clean
emmet-mode:
$(MAKE) -C $(SITE_LISP)/emmet-mode
emmet-mode-clean:
$(MAKE) -C $(SITE_LISP)/emmet-mode clean
expand-region:
$(EMACS) -Q --batch -L $(SITE_LISP)/expand-region -f batch-byte-compile $(SITE_LISP)/expand-region/*.el
expand-region-clean:
$(RM) $(SITE_LISP)/expand-region/*.elc
rg: transient wgrep
$(EMACS) -Q --batch -L $(SITE_LISP)/rg -L $(SITE_LISP)/transient -L $(SITE_LISP)/Emacs-wgrep -f batch-byte-compile $(SITE_LISP)/rg/*.el
$(INSTALL_INFO) --info-dir=$(INFO_DIR) $(SITE_LISP)/rg/rgel.info
rg-clean:
$(RM) $(SITE_LISP)/rg/*.elc
$(INSTALL_INFO) --delete --quiet --info-dir=$(INFO_DIR) $(SITE_LISP)/rg/rgel.info
wgrep:
$(MAKE) -C $(SITE_LISP)/Emacs-wgrep compile
wgrep-clean:
$(MAKE) -C $(SITE_LISP)/Emacs-wgrep clean
avy:
$(MAKE) -C $(SITE_LISP)/avy compile
avy-clean:
$(MAKE) -C $(SITE_LISP)/avy clean
mwim:
$(MAKE) -C $(SITE_LISP)/mwim
mwim-clean:
$(MAKE) -C $(SITE_LISP)/mwim clean
symbol-overlay:
$(MAKE) -C $(SITE_LISP)/symbol-overlay compile
symbol-overlay-clean:
rm -f $(SITE_LISP)/symbol-overlay/*.elc
markdown-mode:
$(MAKE) -C $(SITE_LISP)/markdown-mode
markdown-mode-clean:
$(MAKE) -C $(SITE_LISP)/markdown-mode clean
emms:
$(MAKE) -C $(SITE_LISP)/emms
$(INSTALL_INFO) --info-dir=$(INFO_DIR) $(SITE_LISP)/emms/doc/emms.info
emms-clean:
$(INSTALL_INFO) --delete --info-dir=$(INFO_DIR) $(SITE_LISP)/emms/doc/emms.info
$(MAKE) -C $(SITE_LISP)/emms clean
dash:
$(MAKE) -C $(SITE_LISP)/dash lisp
dash-clean:
$(MAKE) -C $(SITE_LISP)/dash clean
yasnippet:
$(MAKE) -C $(SITE_LISP)/yasnippet compile
$(EMACS) -Q --batch -L $(SITE_LISP)/yasnippet -f batch-byte-compile $(SITE_LISP)/yasnippet-snippets/*.el
$(EMACS) -Q --batch -L $(SITE_LISP)/yasnippet -f batch-byte-compile $(SITE_LISP)/auto-yasnippet/auto-yasnippet.el
yasnippet-clean:
$(MAKE) -C $(SITE_LISP)/yasnippet clean
$(RM) $(SITE_LISP)/yasnippet-snippets/*.elc
$(RM) $(SITE_LISP)/auto-yasnippet/*.elc
yaml:
$(MAKE) -C $(SITE_LISP)/yaml-mode
yaml-clean:
$(MAKE) -C $(SITE_LISP)/yaml-mode clean
lua:
$(MAKE) -C $(SITE_LISP)/lua-mode lua-mode.elc
lua-clean:
$(RM) $(SITE_LISP)/lua-mode/lua-mode.elc
file:
$(EMACS) -Q --batch -f batch-byte-compile $(SITE_LISP)/vimrc-mode/*.el
$(EMACS) -Q --batch -f batch-byte-compile $(SITE_LISP)/nginx-mode/*.el
$(EMACS) -Q --batch -L $(SITE_LISP)/tablist -f batch-byte-compile $(SITE_LISP)/tablist/*.el
$(EMACS) -Q --batch -L $(SITE_LISP)/pdf-tools/lisp -L $(SITE_LISP)/tablist -f batch-byte-compile $(SITE_LISP)/pdf-tools/lisp/*.el
$(MAKE) -C $(SITE_LISP)/pdf-tools loaddefs autobuild
$(EMACS) -Q --batch -f batch-byte-compile $(SITE_LISP)/saveplace-pdf-view/*.el
$(EMACS) -Q --batch -f batch-byte-compile $(SITE_LISP)/graphviz-dot-mode/*.el
$(EMACS) -Q --batch -f batch-byte-compile $(SITE_LISP)/meson-mode/*.el
$(EMACS) -Q --batch -f batch-byte-compile $(SITE_LISP)/crontab-mode/*.el
file-clean:
$(RM) $(SITE_LISP)/vimrc-mode/*.elc
$(RM) $(SITE_LISP)/nginx-mode/*.elc
$(RM) $(SITE_LISP)/tablist/*.elc
$(MAKE) -C $(SITE_LISP)/pdf-tools clean
$(RM) $(SITE_LISP)/pdf-tools/lisp/pdf-tools-autoloads.el
$(RM) $(SITE_LISP)/pdf-tools/lisp/*.elc
$(RM) $(SITE_LISP)/saveplace-pdf-view/*.elc
$(RM) $(SITE_LISP)/graphviz-dot-mode/*.elc
$(RM) $(SITE_LISP)/meson-mode/*.elc
$(RM) $(SITE_LISP)/crontab-mode/*.elc
gptel: transient compat
$(EMACS) -Q --batch -L $(SITE_LISP)/transient -L $(SITE_LISP)/compat -L $(SITE_LISP)/gptel -f batch-byte-compile $(SITE_LISP)/gptel/*.el
gptel-clean:
$(RM) $(SITE_LISP)/gptel/*.elc
nov:
$(EMACS) -Q --batch -L $(SITE_LISP)/esxml -f batch-byte-compile $(SITE_LISP)/esxml/esxml.el $(SITE_LISP)/esxml/esxml-query.el
$(EMACS) -Q --batch -L $(SITE_LISP)/esxml -f batch-byte-compile $(SITE_LISP)/nov/*.el
nov-clean:
$(RM) $(SITE_LISP)/esxml/*.elc
$(RM) $(SITE_LISP)/nov/*.elc
org:
$(EMACS) -Q --batch -f batch-byte-compile $(SITE_LISP)/gntp/*.el
$(EMACS) -Q --batch -L $(SITE_LISP)/alert -L $(SITE_LISP)/gntp -f batch-byte-compile $(SITE_LISP)/alert/alert.el
$(EMACS) -Q --batch -L $(SITE_LISP)/alert -L $(SITE_LISP)/org-pomodoro -f batch-byte-compile $(SITE_LISP)/org-pomodoro/*.el
$(EMACS) -Q --batch -f batch-byte-compile $(SITE_LISP)/tomelr/*.el
$(EMACS) -Q --batch -L $(SITE_LISP)/tomelr -L $(SITE_LISP)/ox-hugo -f batch-byte-compile $(SITE_LISP)/ox-hugo/*.el
org-clean:
$(RM) $(SITE_LISP)/gntp/*.elc
$(RM) $(SITE_LISP)/alert/*.elc
$(RM) $(SITE_LISP)/org-pomodoro/*.elc
$(RM) $(SITE_LISP)/tomelr/*.elc
$(RM) $(SITE_LISP)/ox-hugo/*.elc
plantuml-mode:
$(EMACS) -Q --batch -L $(SITE_LISP)/dash -f batch-byte-compile $(SITE_LISP)/deflate/*.el
$(EMACS) -Q --batch -L $(SITE_LISP)/dash -L $(SITE_LISP)/deflate -f batch-byte-compile $(SITE_LISP)/plantuml-mode/*.el
plantuml-mode-clean:
$(RM) $(SITE_LISP)/deflate/*.elc
$(RM) $(SITE_LISP)/plantuml-mode/*.elc
posframe:
$(EMACS) -Q --batch -f batch-byte-compile $(SITE_LISP)/posframe/posframe.el
posframe-clean:
$(RM) $(SITE_LISP)/posframe/*.elc
prettier:
$(EMACS) -Q --batch -f batch-byte-compile $(SITE_LISP)/iter2/iter2.el
$(EMACS) -Q --batch -L $(SITE_LISP)/s -L $(SITE_LISP)/dash -L $(SITE_LISP)/f -f batch-byte-compile $(SITE_LISP)/nvm/*.el
$(EMACS) -Q --batch -L $(SITE_LISP)/iter2 -L $(SITE_LISP)/nvm -L $(SITE_LISP)/s -L $(SITE_LISP)/dash -L $(SITE_LISP)/f -f batch-byte-compile $(SITE_LISP)/prettier/*.el
prettier-clean:
$(RM) $(SITE_LISP)/iter2/*.elc
$(RM) $(SITE_LISP)/nvm/*.elc
$(RM) $(SITE_LISP)/prettier/*.elc
.PHONY: rime
rime:
$(MAKE) -C $(SITE_LISP)/emacs-rime lib
$(EMACS) -Q --batch -L $(SITE_LISP)/emacs-rime -L $(SITE_LISP)/dash -L $(SITE_LISP)/posframe -f batch-byte-compile $(SITE_LISP)/emacs-rime/rime*.el
rime-clean:
$(MAKE) -C $(SITE_LISP)/emacs-rime clean
$(RM) $(SITE_LISP)/emacs-rime/*.elc
f:
$(EMACS) -Q --batch -L $(SITE_LISP)/s -L $(SITE_LISP)/dash -f batch-byte-compile $(SITE_LISP)/f/*.el
f-clean:
$(RM) $(SITE_LISP)/f/*.elc
s:
$(EMACS) -Q --batch -f batch-byte-compile $(SITE_LISP)/s/*.el
s-clean:
$(RM) $(SITE_LISP)/s/*.elc
sdcv:
$(EMACS) -Q --batch -f batch-byte-compile $(SITE_LISP)/sdcv/*.el
sdcv-clean:
$(RM) $(SITE_LISP)/sdcv/*.elc
vertico:
$(EMACS) -Q --batch -f batch-byte-compile $(SITE_LISP)/marginalia/*.el
$(EMACS) -Q --batch -f batch-byte-compile $(SITE_LISP)/vertico/*.el
$(EMACS) -Q --batch -L $(SITE_LISP)/vertico -L $(SITE_LISP)/vertico/extensions -f batch-byte-compile $(SITE_LISP)/vertico/extensions/*.el
$(EMACS) -Q --batch -f batch-byte-compile $(SITE_LISP)/corfu/*.el
$(EMACS) -Q --batch -L $(SITE_LISP)/corfu -L $(SITE_LISP)/corfu/extensions -f batch-byte-compile $(SITE_LISP)/corfu/extensions/*.el
$(EMACS) -Q --batch -L $(SITE_LISP)/orderless -f batch-byte-compile $(SITE_LISP)/orderless/*.el
$(EMACS) -Q --batch -L $(SITE_LISP)/cape -f batch-byte-compile $(SITE_LISP)/cape/*.el
$(EMACS) -Q --batch -L $(SITE_LISP)/consult -f batch-byte-compile $(SITE_LISP)/consult/*.el
$(EMACS) -Q --batch -f batch-byte-compile $(SITE_LISP)/emacs-popon/*.el
$(EMACS) -Q --batch -L $(SITE_LISP)/corfu -L $(SITE_LISP)/emacs-popon/ -f batch-byte-compile $(SITE_LISP)/emacs-corfu-terminal/*.el
$(EMACS) -Q --batch -L $(SITE_LISP)/embark -L $(SITE_LISP)/consult -L $(SITE_LISP)/avy -f batch-byte-compile $(SITE_LISP)/embark/*.el
vertico-clean:
$(RM) $(SITE_LISP)/marginalia/*.elc
$(RM) $(SITE_LISP)/vertico/*.elc
$(RM) $(SITE_LISP)/vertico/extensions/*.elc
$(RM) $(SITE_LISP)/corfu/*.elc
$(RM) $(SITE_LISP)/corfu/extensions/*.elc
$(RM) $(SITE_LISP)/orderless/*.elc
$(RM) $(SITE_LISP)/cape/*.elc
$(RM) $(SITE_LISP)/consult/*.elc
$(RM) $(SITE_LISP)/emacs-popon/*.elc
$(RM) $(SITE_LISP)/emacs-corfu-terminal/*.elc
$(RM) $(SITE_LISP)/embark/*.elc
+13 -2
View File
@@ -1,5 +1,13 @@
;; -*- coding: utf-8; lexical-binding: t; -*-
(defconst creature/native-comp-enable t
"Enable `native-comp' feature when supported.")
(let ((enable-native-comp creature/native-comp-enable))
(setq native-comp-jit-compilation enable-native-comp
native-comp-deferred-compilation enable-native-comp))
(setq package-enable-at-startup nil)
(setq frame-inhibit-implied-resize t)
@@ -18,7 +26,7 @@
(scroll-bar-mode -1))
(defun creature/welcom-message ()
(defun creature/welcome-message ()
(let (init-time startup-time)
(setq startup-time (time-since before-init-time))
(setq init-time
@@ -35,8 +43,11 @@
(insert initial-scratch-message)
(set-buffer-modified-p nil)))
(add-hook 'emacs-startup-hook #'creature/welcom-message 1999)
(add-hook 'emacs-startup-hook #'creature/welcome-message 1999)
(setq warning-minimum-level :error)
(setq warning-minimum-log-level :error)
(load-theme 'modus-vivendi t)
;; (load-theme 'wheatgrass t)
+1 -1
View File
@@ -1,7 +1,7 @@
;; -*- coding: utf-8; lexical-binding: t; -*-
(require 'init-package)
(add-pkg-in-pkg-dir "emacs-websocket")
(add-to-list 'load-path (file-name-concat creature/pkg-dir "emacs-websocket"))
(require 'websocket)
+1 -2
View File
@@ -1,9 +1,8 @@
;; -*- coding: utf-8; lexical-binding: t; -*-
(require 'init-package)
(add-pkg-in-pkg-dir "awesome-pair")
(require 'lazy-load)
(creature/pkg-active 'awesome-pair)
(with-eval-after-load 'awesome-pair
+3 -2
View File
@@ -13,11 +13,12 @@
(set-selection-coding-system 'utf-8)
(modify-coding-system-alist 'process "*" 'utf-8)
(setq use-short-answers t)
;; Don't show prompt when call function
(fset 'yes-or-no-p 'y-or-n-p)
(put 'erase-buffer 'disabled nil)
(put 'narrow-to-page 'disabled nil)
(put 'narrow-to-defun 'disable nil)
(put 'narrow-to-defun 'disabled nil)
(put 'narrow-to-region 'disabled nil)
;; Always use space for indentation
+7 -7
View File
@@ -1,10 +1,14 @@
;; -*- coding: utf-8; lexical-binding: t; -*-
(require 'init-package)
(unless (locate-library "editorconfig")
(add-pkg-in-pkg-dir "editorconfig-emacs"))
(require 'init-package)
(autoload 'editorconfig-mode "editorconfig" "" t)
(creature/pkg-active 'editorconfig)
(autoload 'editorconfig-mode "editorconfig" "" t)
(autoload 'editorconfig-conf-mode "editorconfig-conf-mode" "" t)
(add-to-list 'auto-mode-alist
'("\\.editorconfig\\'" . editorconfig-conf-mode)))
(defun creature/editorconfig-setup ()
(editorconfig-mode 1)
@@ -26,10 +30,6 @@
(add-hook 'find-file-hook #'creature/editorconfig-setup)
(autoload 'editorconfig-conf-mode "editorconfig-conf-mode" "" t)
(add-to-list 'auto-mode-alist
'("\\.editorconfig\\'" . editorconfig-conf-mode))
(with-eval-after-load 'editorconfig
(add-to-list 'editorconfig-indentation-alist '(js-ts-mode js-indent-level))
(add-to-list 'editorconfig-indentation-alist '(plantuml-mode plantuml-indent-level))
+3 -1
View File
@@ -1,6 +1,8 @@
;; -*- coding: utf-8; lexical-binding: t; -*-
(require 'lazy-load)
(require 'init-package)
(creature/pkg-active 'lazy-load)
(defun creature/eglot-load-markdown-for-doc ()
(when (and (fboundp 'eglot-managed-p)
+2 -1
View File
@@ -1,7 +1,8 @@
;; -*- coding: utf-8; lexical-binding: t; -*-
(require 'init-package)
(add-pkg-in-pkg-dir "emmet-mode")
(creature/pkg-active 'emmet-mode)
(autoload 'emmet-mode "emmet-mode" "" t)
+11 -11
View File
@@ -1,16 +1,16 @@
;; -*- coding: utf-8; lexical-binding: t; -*-
(require 'init-package)
(add-pkg-in-pkg-dir "vimrc-mode")
(add-pkg-in-pkg-dir "yaml-mode")
(add-pkg-in-pkg-dir "lua-mode")
(add-pkg-in-pkg-dir "nginx-mode")
(add-pkg-in-pkg-dir "pdf-tools")
(add-pkg-in-pkg-dir "tablist")
(add-pkg-in-pkg-dir "saveplace-pdf-view")
(add-pkg-in-pkg-dir "graphviz-dot-mode")
(add-pkg-in-pkg-dir "meson-mode")
(add-pkg-in-pkg-dir "crontab-mode")
(creature/pkg-active 'vimrc-mode)
(creature/pkg-active 'yaml-mode)
(creature/pkg-active 'lua-mode)
(creature/pkg-active 'nginx-mode)
(creature/pkg-active 'pdf-tools)
(creature/pkg-active 'saveplace-pdf-view)
(creature/pkg-active 'graphviz-dot-mode)
(creature/pkg-active 'meson-mode)
(creature/pkg-active 'crontab-mode)
(autoload 'vimrc-mode "vimrc-mode" "" t)
@@ -24,7 +24,7 @@
(autoload 'lua-mode "lua-mode" "" t)
(add-to-list 'auto-mode-alist '("\\.lua$" . lua-mode))
(add-to-list 'auto-mode-alist '("\\.lua\\'" . lua-mode))
(add-to-list 'interpreter-mode-alist '("lua" . lua-mode))
+3 -2
View File
@@ -1,8 +1,9 @@
;; -*- coding: utf-8; lexical-binding: t; -*-
(require 'init-package)
(add-pkg-in-pkg-dir "eslint-disable-rule")
(add-pkg-in-pkg-dir "eslint")
(creature/pkg-active 'eslint-disable-rule)
(creature/pkg-active 'eslint)
(defun creature/flymake-show-diagnostics-buffer-and-jump ()
(interactive)
+25
View File
@@ -260,4 +260,29 @@ Directory entries are excluded from the returned list."
(kill-buffer (current-buffer)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; native-comp ;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(defun creature/native-compile-packages-async (lisp-file-dir)
"Compile .el file which in LISP-FILE-DIR to .eln recursively"
(interactive "D")
(if (bound-and-true-p creature/native-comp-enable)
(if (and (fboundp 'native-comp-available-p) (native-comp-available-p))
(native-compile-async
lisp-file-dir t nil
(lambda (file)
(let ((filename (file-name-nondirectory file))
(dir (file-name-directory file)))
(not (or (string= filename "wgrep-subtest.el")
(string= filename ".dir-locals.el")
(string= filename "test.el")
(string-suffix-p "-test.el" filename)
(string-suffix-p "-tests.el" filename)
(string-match-p "/test/" dir)
(string-match-p "/tests/" dir)))))
)
(error "native-comp unavailable"))
(error "native-comp disabled by `creature/native-comp-enable'")))
(provide 'init-func)
+6 -13
View File
@@ -1,14 +1,11 @@
;; -*- coding: utf-8; lexical-binding: t; -*-
(require 'init-package)
(add-pkg-in-pkg-dir "magit")
(add-pkg-in-pkg-dir "dash")
(add-pkg-in-pkg-dir "git-modes")
(add-pkg-in-pkg-dir "with-editor")
(add-pkg-in-pkg-dir "llama")
(add-pkg-in-pkg-dir "cond-let")
(require 'lazy-load)
(creature/pkg-active 'magit)
(creature/pkg-active 'git-modes)
(creature/pkg-active 'pinentry)
(creature/pkg-active 'lazy-load)
(lazy-load-global-keys
'(("C-x g" . magit-status))
@@ -41,11 +38,7 @@
;; (require 'forge)
;; pinentry for prompting password of gpg when sign git commit
(condition-case nil
(progn
(require 'pinentry)
(pinentry-start))
(error nil))
(condition-case nil (pinentry-start) (error nil))
(setq magit-revision-show-gravatars t))
@@ -54,7 +47,7 @@
(setq ediff-window-setup-function 'ediff-setup-windows-plain)
(with-eval-after-load 'project
(require 'magit))
(require 'magit-extras))
(provide 'init-git)
+4 -2
View File
@@ -1,6 +1,8 @@
;; -*- coding: utf-8; lexical-binding: t; -*-
(add-pkg-in-pkg-dir "gptel")
(require 'init-package)
(creature/pkg-active 'gptel)
(let ((gptel-autoload-file
(file-name-concat creature/cache-dir "gptel-autoloads.el")))
@@ -35,7 +37,7 @@
(setq gptel-default-mode #'org-mode
gptel-backend bigmodel-code
gptel-model 'gml-5.1
gptel-model 'glm-5.1
)))
(provide 'init-gptel)
+7 -8
View File
@@ -1,12 +1,13 @@
;; -*- coding: utf-8; lexical-binding: t; -*-
(require 'init-package)
(add-pkg-in-pkg-dir "expand-region")
(add-pkg-in-pkg-dir "rg")
(add-pkg-in-pkg-dir "Emacs-wgrep")
(add-pkg-in-pkg-dir "avy")
(add-pkg-in-pkg-dir "mwim")
(add-pkg-in-pkg-dir "symbol-overlay")
(creature/pkg-active 'expand-region)
(creature/pkg-active 'rg)
(creature/pkg-active 'avy)
(creature/pkg-active 'mwim)
(creature/pkg-active 'symbol-overlay)
(creature/pkg-active 'lazy-load)
(defconst creature/prefix-key "M-m"
@@ -19,8 +20,6 @@
(global-set-key (kbd "C-c '") (kbd "`"))
(require 'lazy-load)
;;; expand-region
(lazy-load-local-keys
'(("v" . er/expand-region))
+2 -2
View File
@@ -1,8 +1,8 @@
;; -*- coding: utf-8; lexical-binding: t; -*-
(require 'init-package)
(add-pkg-in-pkg-dir "markdown-mode")
(add-pkg-in-pkg-dir "edit-indirect")
(creature/pkg-active 'markdown-mode)
(autoload 'markdown-mode "markdown-mode"
"Major mode for editing Markdown files" t)
+1 -3
View File
@@ -1,10 +1,8 @@
;; -*- coding: utf-8; lexical-binding: t; -*-
(require 'init-package)
(add-pkg-in-pkg-dir "emms")
(autoload 'emms-all "emms-setup" "" t)
(autoload 'emms-default-players "" t)
(creature/pkg-active 'emms)
(with-eval-after-load 'emms-lyrics
(setq emms-lyrics-dir "/home/zedhugh/.lyrics"))
-13
View File
@@ -30,19 +30,6 @@
"Length of marked string.")
(put 'creature/mode-line-region-info 'risky-local-variable t)
(defvar creature/mode-line-region-info
'(:eval
(when (and (region-active-p) (eq creature/focus-window (selected-window)))
(let ((length (- (region-end) (region-beginning)))
(line (- (line-number-at-pos (region-end))
(line-number-at-pos (region-beginning))
-1)))
(propertize
(format " [%d|%d]" length line)
))))
"Length of marked string.")
(put 'creature/mode-line-region-info 'risky-local-variable t)
(defvar creature/mode-line-line-and-column
`(line-number-mode
(column-number-mode
+3 -4
View File
@@ -2,10 +2,9 @@
;; `nov' package need enable libxml2 for Emacs
(add-pkg-in-pkg-dir "nov")
(add-pkg-in-pkg-dir "esxml")
(add-pkg-in-pkg-dir "emacs-kv")
(add-pkg-in-pkg-dir "emacs-db")
(require 'init-package)
(creature/pkg-active 'nov)
(autoload 'nov-mode "nov" "" t)
(add-to-list 'auto-mode-alist '("\\.epub\\'" . nov-mode))
+2 -5
View File
@@ -1,12 +1,9 @@
;; -*- coding: utf-8; lexical-binding: t; -*-
(require 'init-package)
(add-pkg-in-pkg-dir "org-pomodoro")
(add-pkg-in-pkg-dir "alert")
(add-pkg-in-pkg-dir "gntp")
(add-pkg-in-pkg-dir "ox-hugo")
(add-pkg-in-pkg-dir "tomelr")
(creature/pkg-active 'org-pomodoro)
(creature/pkg-active 'ox-hugo)
;; customize mode for src lang
(defconst creature/org-src-lang-modes
+105 -45
View File
@@ -1,63 +1,123 @@
;; -*- coding: utf-8; lexical-binding: t; -*-
(require 'cl-lib)
(require 'subr-x)
(require 'info)
(defconst creature/pkg-dir
(expand-file-name
"../site-lisp"
(file-name-directory(or load-file-name buffer-file-name)))
"Package directory.")
(require 'cl-lib)
(require 'subr-x)
(defconst creature/pkgs
'((magit . ( :load "magit/lisp" :autoload "magit-autoloads" :info "magit/docs"
:deps (compat cond-let llama transient with-editor)))
(compat . (:load "compat" :info "compat"))
(cond-let . (:load "cond-let" :autoload "cond-let-autoloads"))
(llama . ( :load "llama" :autoload "llama-autoloads"
:deps (compat)))
(transient . ( :load "transient/lisp" :autoload "transient-autoloads"
:info "transient/docs" :deps (compat cond-let)))
(with-editor . ( :load "with-editor/lisp" :autoload "with-editor-autoloads"
:info "with-editor/docs" :deps (compat cond-let)))
(git-modes . ( :load "git-modes" :autoload "git-modes-autoloads"
:deps (compat)))
(pinentry . (:load "pinentry" :autoload "pinentry"))
(lazy-load . (:load "lazy-load" :autoload "lazy-load"))
(awesome-pair . (:load "awesome-pair"))
(editorconfig . (:load "editorconfig-emacs"))
(emmet-mode . (:load "emmet-mode"))
(eslint-disable-rule . (:load "eslint-disable-rule"))
(eslint . (:load "eslint/lisp"))
(gptel . (:load "gptel" :deps (compat transient)))
(expand-region . (:load "expand-region"))
(rg . (:load "rg" :info "rg" :deps (transient wgrep)))
(wgrep . (:load "Emacs-wgrep"))
(avy . (:load "avy"))
(mwim . (:load "mwim"))
(symbol-overlay . (:load "symbol-overlay"))
(markdown-mode . (:load "markdown-mode" :deps (edit-indirect)))
(edit-indirect . (:load "edit-indirect"))
(emms . (:load "emms" :autoload "emms-auto" :info "emms/doc"))
(nov . (:load "nov" :deps (esxml)))
(esxml . (:load "esxml"))
(org-pomodoro . (:load "org-pomodoro" :deps (alert)))
(alert . (:load "alert" :deps (gntp)))
(gntp . (:load "gntp"))
(ox-hugo . (:load "ox-hugo" :autoload "ox-hugo-autoloads" :deps (tomelr)))
(tomelr . (:load "tomelr"))
(plantuml-mode . (:load "plantuml-mode" :deps (dash deflate)))
(dash . (:load "dash"))
(deflate . (:load "deflate" :deps (dash)))
(prettier . (:load "prettier" :info "prettier" :deps (iter2 nvm)))
(iter2 . (:load "iter2"))
(nvm . (:load "nvm" :deps (s dash f)))
(s . (:load "s"))
(f . (:load "f" :deps (s dash)))
(prisma-ts-mode . (:load "prisma-ts-mode"))
(rime . (:load "emacs-rime" :deps (dash posframe)))
(posframe . (:load "posframe"))
(sdcv . (:load "sdcv" :deps (posframe)))
(which-key . (:load "emacs-which-key"))
(yasnippet . (:load "yasnippet"))
(yasnippet-snippets . (:load "yasnippet-snippets" :deps (yasnippet)))
(auto-yasnippet . (:load "auto-yasnippet" :deps (yasnippet)))
(vimrc-mode . (:load "vimrc-mode"))
(yaml-mode . (:load "yaml-mode"))
(lua-mode . (:load "lua-mode"))
(nginx-mode . (:load "nginx-mode"))
(pdf-tools . ( :load "pdf-tools/lisp" :autoload "pdf-tools-autoloads"
:deps (tablist)))
(tablist . (:load "tablist"))
(saveplace-pdf-view . (:load "saveplace-pdf-view"))
(graphviz-dot-mode . (:load "graphviz-dot-mode"))
(meson-mode . (:load "meson-mode"))
(crontab-mode . (:load "crontab-mode"))
(marginalia . (:load "marginalia" :deps (compat)))
(vertico . (:load ("vertico" "vertico/extensions") :deps (compat)))
(corfu . (:load ("corfu" "corfu/extensions") :deps (compat)))
(orderless . (:load "orderless" :deps (compat)))
(cape . (:load "cape" :deps (compat)))
(consult . (:load "consult" :deps (compat)))
(corfu-terminal . (:load "emacs-corfu-terminal" :deps (corfu popon)))
(popon . (:load "emacs-popon"))
(embark . (:load "embark"))
)
"Package name and config pair.")
(defun add-dir-and-subdirs-to-load-path (dir)
"Add directory and its subdirectoris to `load-path'.
Detect whether there are any loadable module in DIR, if so, add DIR to `load-path'.
Do this recursively for subdirectories of DIR."
(unless (file-directory-p dir)
(error "%s is not a directory" dir))
(defvar creature/pkgs-actived nil
"Actived packages.
This is temporary variable for function `creature/pkg-active'.")
(let ((subdirs nil)
(files nil)
(temp-filepath nil)
;; (loadable-suffixes (get-load-suffixes))
(load-extension (mapcar (lambda (str) (string-remove-prefix "." str)) load-suffixes))
(exclude-dirs '("." ".."
"dist" "node_modules" "__pycache__" "test"
"RCS" "CVS" "rcs" "cvs" ".git" ".github")))
(cl-defun creature/pkg-active (pkg)
"Setup package."
(when (member pkg creature/pkgs-actived)
(cl-return-from creature/pkg-active creature/pkgs-actived))
(dolist (filename (directory-files dir))
(setq temp-filepath (file-name-concat dir filename))
(if (file-directory-p temp-filepath)
(unless (member filename exclude-dirs)
(add-to-list 'subdirs temp-filepath t))
(when (file-regular-p temp-filepath)
(add-to-list 'files temp-filepath t))))
(let* ((pkg-config (alist-get pkg creature/pkgs))
(pkg-load-path (plist-get pkg-config :load))
(pkg-autoload (plist-get pkg-config :autoload))
(pkg-info-dir (plist-get pkg-config :info))
(pkg-deps (plist-get pkg-config :deps)))
(unless pkg-config (error "package(%s) not in `creature/pkgs'." pkg))
(when (cl-some (lambda (file)
(member (file-name-extension file) load-extension))
files)
(add-to-list 'load-path dir))
(mapc #'add-dir-and-subdirs-to-load-path subdirs)))
(dolist (dep pkg-deps) (creature/pkg-active dep))
(if (stringp pkg-load-path)
(add-to-list 'load-path (file-name-concat creature/pkg-dir pkg-load-path))
(dolist (path pkg-load-path)
(add-to-list 'load-path (file-name-concat creature/pkg-dir path))))
(when pkg-autoload (load pkg-autoload t t))
(when pkg-info-dir
(add-to-list 'Info-additional-directory-list
(file-name-concat creature/pkg-dir pkg-info-dir))))
(defun add-pkg-in-pkg-dir (pkg)
"Add PKG located in `creature/pkg-dir' to `load-path'."
(add-dir-and-subdirs-to-load-path (expand-file-name pkg creature/pkg-dir)))
(add-to-list 'creature/pkgs-actived pkg))
(add-to-list 'Info-additional-directory-list
(file-truename (file-name-concat creature/pkg-dir "../.cache")))
(add-to-list 'load-path creature/pkg-dir)
;; add basic packages
(add-pkg-in-pkg-dir "lazy-load")
;; "transient" and "compat" always use submodule package
;; and "cond-let" is dependency of "transient"
(dolist (pkg '("transient" "cond-let" "compat"))
(add-pkg-in-pkg-dir pkg))
(dolist (pkg '("transient" "compat"))
(let ((file (locate-library pkg))
(feature (intern-soft pkg)))
(when (and (featurep feature) (string-prefix-p "/usr/share/emacs" file))
(unload-feature feature t)
(require feature))))
(provide 'init-package)
+3 -3
View File
@@ -1,8 +1,8 @@
;; -*- coding: utf-8; lexical-binding: t; -*-
(require 'init-package)
(add-pkg-in-pkg-dir "plantuml-mode")
(add-pkg-in-pkg-dir "dash")
(creature/pkg-active 'plantuml-mode)
(autoload 'plantuml-mode "plantuml-mode" "" t)
(add-to-list 'auto-mode-alist '("\\.\\(plantuml\\|pum\\|plu\\)\\'" . plantuml-mode))
@@ -18,7 +18,7 @@ Copy from https://github.com/skuro/plantuml-mode/issues/98."
(cdr bounds)
keywords
:exclusive 'no
:company-docsig #'indentity))))
:company-docsig #'identity))))
(with-eval-after-load 'plantuml-mode
(setq plantuml-exec-mode 'executable
+3 -6
View File
@@ -1,12 +1,9 @@
;; -*- coding: utf-8; lexical-binding: t; -*-
(require 'init-package)
(add-pkg-in-pkg-dir "prettier")
(add-pkg-in-pkg-dir "iter2")
(add-pkg-in-pkg-dir "nvm")
(add-pkg-in-pkg-dir "s")
(add-pkg-in-pkg-dir "dash")
(add-pkg-in-pkg-dir "f")
(creature/pkg-active 'prettier)
(require 'init-editorconfig)
(autoload 'prettier-mode "prettier" "" t)
+3 -2
View File
@@ -2,7 +2,8 @@
(require 'init-package)
(add-pkg-in-pkg-dir "prisma-ts-mode")
(creature/pkg-active 'prisma-ts-mode)
(autoload 'prisma-ts-mode "prisma-ts-mode" "" t)
;; remember run `treesit-install-language-grammar' command to install `prisma'
(add-to-list
@@ -13,7 +14,7 @@
(file-name-concat
(file-name-directory (or load-file-name buffer-file-name))
"../tree-sitter-langs/tree-sitter-prisma"))))
(add-to-list 'auto-mode-alist '("\\.prisma$" . prisma-ts-mode))
(add-to-list 'auto-mode-alist '("\\.prisma\\'" . prisma-ts-mode))
;; language server is `@prisma/language-server', install it by npm/pnpm/yarn.
(with-eval-after-load 'eglot
+3 -4
View File
@@ -1,11 +1,10 @@
;; -*- coding: utf-8; lexical-binding: t; -*-
(require 'init-package)
(add-pkg-in-pkg-dir "emacs-rime")
(add-pkg-in-pkg-dir "dash")
(add-pkg-in-pkg-dir "posframe")
(require 'lazy-load)
(creature/pkg-active 'rime)
(creature/pkg-active 'lazy-load)
(require 'rime)
+2 -3
View File
@@ -1,10 +1,9 @@
;; -*- coding: utf-8; lexical-binding: t; -*-
(require 'init-package)
(add-pkg-in-pkg-dir "sdcv")
(add-pkg-in-pkg-dir "posframe")
(require 'lazy-load)
(creature/pkg-active 'sdcv)
(creature/pkg-active 'lazy-load)
(require 'init-keybindings)
+1 -1
View File
@@ -67,7 +67,7 @@ Each font conf looks like (FAMILY . SIZE).")
if FRAME is nil, setup for current frame."
;; single-byte code
(setq inhibit-compacting-font-caches
(if (eq system-type 'window-nt) t nil))
(if (eq system-type 'windows-nt) t nil))
(let ((single (car creature/font-config))
(multi (cdr creature/font-config)))
+3
View File
@@ -9,6 +9,9 @@
(when creature/treesit-available
(unless (featurep 'treesit) (require 'treesit))
(when (treesit-ready-p 'json)
(add-to-list 'auto-mode-alist '("\\.jsonc\\'" . json-ts-mode)))
(when (treesit-ready-p 'javascript)
(add-to-list 'major-mode-remap-alist '(js-mode . js-ts-mode))
(add-to-list 'major-mode-remap-alist '(javascript-mode . js-ts-mode)))
+9 -9
View File
@@ -1,15 +1,15 @@
;; -*- coding: utf-8; lexical-binding: t; -*-
(require 'init-package)
(add-pkg-in-pkg-dir "marginalia")
(add-pkg-in-pkg-dir "vertico")
(add-pkg-in-pkg-dir "corfu")
(add-pkg-in-pkg-dir "orderless")
(add-pkg-in-pkg-dir "cape")
(add-pkg-in-pkg-dir "consult")
(add-pkg-in-pkg-dir "emacs-corfu-terminal")
(add-pkg-in-pkg-dir "emacs-popon")
(add-pkg-in-pkg-dir "embark")
(creature/pkg-active 'marginalia)
(creature/pkg-active 'vertico)
(creature/pkg-active 'corfu)
(creature/pkg-active 'orderless)
(creature/pkg-active 'cape)
(creature/pkg-active 'consult)
(creature/pkg-active 'corfu-terminal)
(creature/pkg-active 'embark)
(require 'marginalia)
+2 -2
View File
@@ -1,8 +1,8 @@
;; -*- coding: utf-8; lexical-binding: t; -*-
(require 'init-package)
(unless (locate-library "which-key")
(add-pkg-in-pkg-dir "emacs-which-key"))
(require 'init-package)
(creature/pkg-active 'which-key))
(require 'init-keybindings)
+5 -4
View File
@@ -1,11 +1,12 @@
;; -*- coding: utf-8; lexical-binding: t; -*-
(require 'init-package)
(add-pkg-in-pkg-dir "yasnippet")
(add-pkg-in-pkg-dir "yasnippet-snippets")
(add-pkg-in-pkg-dir "auto-yasnippet")
(require 'lazy-load)
(creature/pkg-active 'yasnippet)
(creature/pkg-active 'yasnippet-snippets)
(creature/pkg-active 'auto-yasnippet)
(creature/pkg-active 'lazy-load)
(require 'yasnippet)
(require 'yasnippet-snippets)
+1
Submodule site-lisp/deflate added at d3863855d2.
Submodule site-lisp/pinentry added at 0079964a1d.
-458
View File
@@ -1,458 +0,0 @@
;;; pinentry.el --- GnuPG Pinentry server implementation -*- lexical-binding: t -*-
;; Copyright (C) 2015 Free Software Foundation, Inc.
;; Author: Daiki Ueno <ueno@gnu.org>
;; Version: 0.1
;; Keywords: GnuPG
;; This file is part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with GNU Emacs. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; This package allows GnuPG passphrase to be prompted through the
;; minibuffer instead of graphical dialog.
;;
;; To use, add "allow-emacs-pinentry" to "~/.gnupg/gpg-agent.conf",
;; reload the configuration with "gpgconf --reload gpg-agent", and
;; start the server with M-x pinentry-start.
;;
;; The actual communication path between the relevant components is
;; as follows:
;;
;; gpg --> gpg-agent --> pinentry --> Emacs
;;
;; where pinentry and Emacs communicate through a Unix domain socket
;; created at:
;;
;; ${TMPDIR-/tmp}/emacs$(id -u)/pinentry
;;
;; under the same directory which server.el uses. The protocol is a
;; subset of the Pinentry Assuan protocol described in (info
;; "(pinentry) Protocol").
;;
;; NOTE: As of August 2015, this feature requires newer versions of
;; GnuPG (2.1.5+) and Pinentry (0.9.5+).
;;; Code:
(defgroup pinentry nil
"The Pinentry server"
:version "25.1"
:group 'external)
(defcustom pinentry-popup-prompt-window t
"If non-nil, display multiline prompt in another window."
:type 'boolean
:group 'pinentry)
(defcustom pinentry-prompt-window-height 5
"Number of lines used to display multiline prompt."
:type 'integer
:group 'pinentry)
(defvar pinentry-debug nil)
(defvar pinentry-debug-buffer nil)
(defvar pinentry--server-process nil)
(defvar pinentry--connection-process-list nil)
(defvar pinentry--labels nil)
(put 'pinentry-read-point 'permanent-local t)
(defvar pinentry--read-point nil)
(put 'pinentry--read-point 'permanent-local t)
(defvar pinentry--prompt-buffer nil)
;; We use the same location as `server-socket-dir', when local sockets
;; are supported.
(defvar pinentry--socket-dir
(format "%s/emacs%d" (or (getenv "TMPDIR") "/tmp") (user-uid))
"The directory in which to place the server socket.
If local sockets are not supported, this is nil.")
(defconst pinentry--set-label-commands
'("SETPROMPT" "SETTITLE" "SETDESC"
"SETREPEAT" "SETREPEATERROR"
"SETOK" "SETCANCEL" "SETNOTOK"))
;; These error codes are defined in libgpg-error/src/err-codes.h.in.
(defmacro pinentry--error-code (code)
(logior (ash 5 24) code))
(defconst pinentry--error-not-implemented
(cons (pinentry--error-code 69) "not implemented"))
(defconst pinentry--error-cancelled
(cons (pinentry--error-code 99) "cancelled"))
(defconst pinentry--error-not-confirmed
(cons (pinentry--error-code 114) "not confirmed"))
(autoload 'server-ensure-safe-dir "server")
(defvar pinentry-prompt-mode-map
(let ((keymap (make-sparse-keymap)))
(define-key keymap "q" 'quit-window)
keymap))
(define-derived-mode pinentry-prompt-mode special-mode "Pinentry"
"Major mode for `pinentry--prompt-buffer'."
(buffer-disable-undo)
(setq truncate-lines t
buffer-read-only t))
(defun pinentry--prompt (labels query-function &rest query-args)
(let ((desc (cdr (assq 'desc labels)))
(error (cdr (assq 'error labels)))
(prompt (cdr (assq 'prompt labels))))
(when (string-match "[ \n]*\\'" prompt)
(setq prompt (concat
(substring
prompt 0 (match-beginning 0)) " ")))
(when error
(setq desc (concat "Error: " (propertize error 'face 'error)
"\n" desc)))
(if (and desc pinentry-popup-prompt-window)
(save-window-excursion
(delete-other-windows)
(unless (and pinentry--prompt-buffer
(buffer-live-p pinentry--prompt-buffer))
(setq pinentry--prompt-buffer (generate-new-buffer "*Pinentry*")))
(if (get-buffer-window pinentry--prompt-buffer)
(delete-window (get-buffer-window pinentry--prompt-buffer)))
(with-current-buffer pinentry--prompt-buffer
(let ((inhibit-read-only t)
buffer-read-only)
(erase-buffer)
(insert desc))
(pinentry-prompt-mode)
(goto-char (point-min)))
(if (> (window-height)
pinentry-prompt-window-height)
(set-window-buffer (split-window nil
(- (window-height)
pinentry-prompt-window-height))
pinentry--prompt-buffer)
(pop-to-buffer pinentry--prompt-buffer)
(if (> (window-height) pinentry-prompt-window-height)
(shrink-window (- (window-height)
pinentry-prompt-window-height))))
(prog1 (apply query-function prompt query-args)
(quit-window)))
(apply query-function (concat desc "\n" prompt) query-args))))
;;;###autoload
(defun pinentry-start (&optional quiet)
"Start a Pinentry service.
Once the environment is properly set, subsequent invocations of
the gpg command will interact with Emacs for passphrase input.
If the optional QUIET argument is non-nil, messages at startup
will not be shown."
(interactive)
(unless (featurep 'make-network-process '(:family local))
(error "local sockets are not supported"))
(if (process-live-p pinentry--server-process)
(unless quiet
(message "Pinentry service is already running"))
(let* ((server-file (expand-file-name "pinentry" pinentry--socket-dir)))
(server-ensure-safe-dir pinentry--socket-dir)
;; Delete the socket files made by previous server invocations.
(ignore-errors
(let (delete-by-moving-to-trash)
(delete-file server-file)))
(with-file-modes ?\700
(setq pinentry--server-process
(make-network-process
:name "pinentry"
:server t
:noquery t
:sentinel #'pinentry--process-sentinel
:filter #'pinentry--process-filter
:coding 'no-conversion
:family 'local
:service server-file))
(process-put pinentry--server-process :server-file server-file)))))
(defun pinentry-stop ()
"Stop a Pinentry service."
(interactive)
(when (process-live-p pinentry--server-process)
(delete-process pinentry--server-process))
(setq pinentry--server-process nil)
(dolist (process pinentry--connection-process-list)
(when (buffer-live-p (process-buffer process))
(kill-buffer (process-buffer process))))
(setq pinentry--connection-process-list nil))
(defun pinentry--labels-to-shortcuts (labels)
"Convert strings in LABEL by stripping mnemonics."
(mapcar (lambda (label)
(when label
(let (c)
(if (string-match "\\(?:\\`\\|[^_]\\)_\\([[:alnum:]]\\)" label)
(let ((key (match-string 1 label)))
(setq c (downcase (aref key 0)))
(setq label (replace-match
(propertize key 'face 'underline)
t t label)))
(setq c (if (= (length label) 0)
??
(downcase (aref label 0)))))
;; Double underscores mean a single underscore.
(when (string-match "__" label)
(setq label (replace-match "_" t t label)))
(cons c label))))
labels))
(defun pinentry--escape-string (string)
"Escape STRING in the Assuan percent escape."
(let ((length (length string))
(index 0)
(count 0))
(while (< index length)
(if (memq (aref string index) '(?\n ?\r ?%))
(setq count (1+ count)))
(setq index (1+ index)))
(setq index 0)
(let ((result (make-string (+ length (* count 2)) ?\0))
(result-index 0)
c)
(while (< index length)
(setq c (aref string index))
(if (memq c '(?\n ?\r ?%))
(let ((hex (format "%02X" c)))
(aset result result-index ?%)
(setq result-index (1+ result-index))
(aset result result-index (aref hex 0))
(setq result-index (1+ result-index))
(aset result result-index (aref hex 1))
(setq result-index (1+ result-index)))
(aset result result-index c)
(setq result-index (1+ result-index)))
(setq index (1+ index)))
result)))
(defun pinentry--unescape-string (string)
"Unescape STRING in the Assuan percent escape."
(let ((length (length string))
(index 0))
(let ((result (make-string length ?\0))
(result-index 0)
c)
(while (< index length)
(setq c (aref string index))
(if (and (eq c '?%) (< (+ index 2) length))
(progn
(aset result result-index
(string-to-number (substring string
(1+ index)
(+ index 3))
16))
(setq result-index (1+ result-index))
(setq index (+ index 2)))
(aset result result-index c)
(setq result-index (1+ result-index)))
(setq index (1+ index)))
(substring result 0 result-index))))
(defun pinentry--send-data (process escaped)
"Send a string ESCAPED to a process PROCESS.
ESCAPED will be split if it exceeds the line length limit of the
Assuan protocol."
(let ((length (length escaped))
(index 0))
(if (= length 0)
(process-send-string process "D \n")
(while (< index length)
;; 997 = ASSUAN_LINELENGTH (= 1000) - strlen ("D \n")
(let* ((sub-length (min (- length index) 997))
(sub (substring escaped index (+ index sub-length))))
(unwind-protect
(progn
(process-send-string process "D ")
(process-send-string process sub)
(process-send-string process "\n"))
(clear-string sub))
(setq index (+ index sub-length)))))))
(defun pinentry--send-error (process error)
(process-send-string process (format "ERR %d %s\n" (car error) (cdr error))))
(defun pinentry--process-filter (process input)
(unless (buffer-live-p (process-buffer process))
(let ((buffer (generate-new-buffer " *pinentry*")))
(set-process-buffer process buffer)
(with-current-buffer buffer
(if (fboundp 'set-buffer-multibyte)
(set-buffer-multibyte nil))
(make-local-variable 'pinentry--read-point)
(setq pinentry--read-point (point-min))
(make-local-variable 'pinentry--labels))))
(with-current-buffer (process-buffer process)
(when pinentry-debug
(with-current-buffer
(or pinentry-debug-buffer
(setq pinentry-debug-buffer (generate-new-buffer
" *pinentry-debug*")))
(goto-char (point-max))
(insert input)))
(save-excursion
(goto-char (point-max))
(insert input)
(goto-char pinentry--read-point)
(beginning-of-line)
(while (looking-at ".*\n") ;the input line finished
(if (looking-at "\\([A-Z_]+\\) ?\\(.*\\)")
(let ((command (match-string 1))
(string (pinentry--unescape-string (match-string 2))))
(pcase command
((and set (guard (member set pinentry--set-label-commands)))
(when (> (length string) 0)
(let* ((symbol (intern (downcase (substring set 3))))
(entry (assq symbol pinentry--labels))
(label (decode-coding-string string 'utf-8)))
(if entry
(setcdr entry label)
(push (cons symbol label) pinentry--labels))))
(ignore-errors
(process-send-string process "OK\n")))
("NOP"
(ignore-errors
(process-send-string process "OK\n")))
("GETPIN"
(let ((confirm (not (null (assq 'repeat pinentry--labels))))
passphrase escaped-passphrase encoded-passphrase)
(unwind-protect
(condition-case err
(progn
(setq passphrase
(pinentry--prompt
pinentry--labels
#'read-passwd confirm))
(setq escaped-passphrase
(pinentry--escape-string
passphrase))
(setq encoded-passphrase (encode-coding-string
escaped-passphrase
'utf-8))
(ignore-errors
(pinentry--send-data
process encoded-passphrase)
(process-send-string process "OK\n")))
(error
(message "GETPIN error %S" err)
(ignore-errors
(pinentry--send-error
process
pinentry--error-cancelled))))
(if passphrase
(clear-string passphrase))
(if escaped-passphrase
(clear-string escaped-passphrase))
(if encoded-passphrase
(clear-string encoded-passphrase))))
(setq pinentry--labels nil))
("CONFIRM"
(let ((prompt
(or (cdr (assq 'prompt pinentry--labels))
"Confirm? "))
(buttons
(delq nil
(pinentry--labels-to-shortcuts
(list (cdr (assq 'ok pinentry--labels))
(cdr (assq 'notok pinentry--labels))
(cdr (assq 'cancel pinentry--labels))))))
entry)
(if buttons
(progn
(setq prompt
(concat prompt " ("
(mapconcat #'cdr buttons
", ")
") "))
(if (setq entry (assq 'prompt pinentry--labels))
(setcdr entry prompt)
(setq pinentry--labels (cons (cons 'prompt prompt)
pinentry--labels)))
(condition-case nil
(let ((result (pinentry--prompt pinentry--labels
#'read-char)))
(if (eq result (caar buttons))
(ignore-errors
(process-send-string process "OK\n"))
(if (eq result (car (nth 1 buttons)))
(ignore-errors
(pinentry--send-error
process
pinentry--error-not-confirmed))
(ignore-errors
(pinentry--send-error
process
pinentry--error-cancelled)))))
(error
(ignore-errors
(pinentry--send-error
process
pinentry--error-cancelled)))))
(if (setq entry (assq 'prompt pinentry--labels))
(setcdr entry prompt)
(setq pinentry--labels (cons (cons 'prompt prompt)
pinentry--labels)))
(if (condition-case nil
(pinentry--prompt pinentry--labels #'y-or-n-p)
(quit))
(ignore-errors
(process-send-string process "OK\n"))
(ignore-errors
(pinentry--send-error
process
pinentry--error-not-confirmed))))
(setq pinentry--labels nil)))
(_ (ignore-errors
(pinentry--send-error
process
pinentry--error-not-implemented))))
(forward-line)
(setq pinentry--read-point (point))))))))
(defun pinentry--process-sentinel (process _status)
"The process sentinel for Emacs server connections."
;; If this is a new client process, set the query-on-exit flag to nil
;; for this process (it isn't inherited from the server process).
(when (and (eq (process-status process) 'open)
(process-query-on-exit-flag process))
(push process pinentry--connection-process-list)
(set-process-query-on-exit-flag process nil)
(ignore-errors
(process-send-string process "OK Your orders please\n")))
;; Kill the process buffer of the connection process.
(when (and (not (process-contact process :server))
(eq (process-status process) 'closed))
(when (buffer-live-p (process-buffer process))
(kill-buffer (process-buffer process)))
(setq pinentry--connection-process-list
(delq process pinentry--connection-process-list)))
;; Delete the associated connection file, if applicable.
;; Although there's no 100% guarantee that the file is owned by the
;; running Emacs instance, server-start uses server-running-p to check
;; for possible servers before doing anything, so it *should* be ours.
(and (process-contact process :server)
(eq (process-status process) 'closed)
(ignore-errors
(delete-file (process-get process :server-file)))))
(provide 'pinentry)
;;; pinentry.el ends here