jason
/
emacs.d
1
0
Fork 0
Code Issues 3 Pull Requests Packages Projects Releases Wiki Activity

Compare commits

base: jason:master
Branches Tags
jason:master
jason:fix-initial-prompt
..
compare: jason:fix-initial-prompt
Branches Tags
jason:master
jason:fix-initial-prompt

1 Commits
master ... fix-initia

Author SHA1 Message Date
Jason Tian aa4d999538 fix: the initial value in prompt of my/create-TAGS 2023-08-17 15:52:59 +08:00
29 changed files with 1100 additions and 2941 deletions
Show Stats Expand all files Collapse all files

12
README.org
View File

@ -1,11 +1,9 @@
* A Personal Emacs Configuration
[[https://github.com/jsntn/emacs.d/actions/workflows/myelpa.yml][https://github.com/jsntn/emacs.d/actions/workflows/myelpa.yml/badge.svg]]
[[https://github.com/jsntn/emacs.d/actions/workflows/test.yml][https://github.com/jsntn/emacs.d/actions/workflows/test.yml/badge.svg]]
Behold, dear visitor, my cherished Emacs configuration, meticulously crafted and
refined since the year of 2020. With unwavering dedication, I tirelessly
endeavor to harmonize its functioning across the Windows, Arch Linux and macOS
operating systems. 🙂
This is my personal Emacs configuration, continually used and tweaked since
2020, and I am always trying to make it same behaviour on my Windows and macOS.
* Table of Content :noexport:TOC_4:
- [[#a-personal-emacs-configuration][A Personal Emacs Configuration]]
@ -32,7 +30,6 @@ operating systems. 🙂
- [[#plantuml-1][PlantUML]]
- [[#winpython][WinPython]]
- [[#known-issue][Known Issue]]
- [[#read-more][Read more]]
* Usage
TODO
@ -164,6 +161,3 @@ I use [[https://github.com/jwiegley/use-package][use-package]] to manage package
However, it seems the hl-todo and org-bullets settings don't work if they are
configured in the init-packages.el, i.e., [[https://github.com/jsntn/emacs.d/commit/1e409e075024d72f2dc7520ada092b04b3012f48#diff-aeac2722d1b94adc236ce40df31d9cb7eb107e43b95c13c6c795e71044ec2c29L119-L138][link 1]] and [[https://github.com/jsntn/emacs.d/commit/1e409e075024d72f2dc7520ada092b04b3012f48#diff-aeac2722d1b94adc236ce40df31d9cb7eb107e43b95c13c6c795e71044ec2c29L150-L152][link 2]], but both of them
are effective if I move them to [[https://github.com/jsntn/emacs.d/commit/19e71501432f5b5ba36375ad711eb62a3fbe91d4#diff-54e03c0bf9c47228b3868e00ea21baade79013af33501ff53bbadbd26060a227R32-R35][init-display.el]] and my [[https://github.com/jsntn/emacs.d/blob/1e409e075024d72f2dc7520ada092b04b3012f48/init.el#L98][local-config.el]].
* Read more
- https://github.com/jsntn/emacs-vagrantfile

53
init.el
View File

@ -2,7 +2,7 @@
;; =============================================================================
;; hi@jsntn.com
;; 2020, 2021, 2022, 2023, 2024
;; 2020, 2021, 2022, 2023
;; =============================================================================
;;; Commentary:
@ -32,35 +32,13 @@
(add-to-list 'load-path (expand-file-name "lisp" user-emacs-directory))
(defconst *dependencies-installation-enabled* nil) ; enable with t if you prefer
;; =============================================================================
;; require settings
;; =============================================================================
(require 'init-portable) ; portable Emacs settings
(when (string-equal (getenv "ELPA") "local")
(message "The built-in Org version: %s" (org-version)))
(when (string-equal (getenv "ELPA") "online")
;; use the latest version of Org
(add-to-list 'load-path (concat (getenv "GITHUB_WORKSPACE") "/src/org-mode/lisp"))
(require 'org)
(message "The latest Org version: %s" (org-version)))
(require 'init-load-path) ; load-path settings
(require 'init-pre) ; pre-startup settings
(require 'init-messages) ; *Messages* buffer settings
(require 'init-utils) ; utils configuration
(require 'init-timer-utils) ; timer utils
(require 'local-var nil 'noerror) ; allow users to provide an optional
; "local-var" containing personal variables
@ -84,8 +62,6 @@
(setq package-archives '(("gnu" . "https://elpa.gnu.org/packages/")
("melpa" . "https://melpa.org/packages/")))
;; Official MELPA Mirror, in case necessary.
;;(add-to-list 'package-archives (cons "melpa-mirror" (concat proto "://www.mirrorservice.org/sites/melpa.org/packages/")) t)
(when (string-equal (getenv "ELPA") "local")
;; when running on GitHub w/ local elpa Actions config, overwrite above `package-archives'
@ -107,13 +83,6 @@
(eval-print-last-sexp)))
(load bootstrap-file nil 'nomessage))
(when (or (string-equal (getenv "ELPA") "local")
(string-equal (getenv "STRAIGHT") "freeze"))
(let ((source (expand-file-name "straight/versions/my.el" user-emacs-directory))
(destination (expand-file-name "straight/versions/default.el" user-emacs-directory)))
(when (file-exists-p source)
(copy-file source destination t))))
(package-initialize)
(unless package-archive-contents
@ -121,6 +90,10 @@
(when (string-equal (getenv "ELPA") "online")
;; use the latest version of Org
(add-to-list 'load-path (concat (getenv "GITHUB_WORKSPACE") "/src/org-mode/lisp"))
(message "Org version: %s" (org-version)))
@ -131,27 +104,17 @@
;; require settings
;; =============================================================================
(require 'init-company) ; company completion related settings
(require 'init-dict) ; dict settings
(require 'init-display) ; display settings
(require 'init-encryption) ; encryption settings
(require 'init-evil) ; evil related config
(require 'init-font) ; font settings
(require 'init-gpg) ; GPG settings
(require 'init-ibuffer) ; IBuffer mode settings
(require 'init-org) ; Org-mode settings
(require 'init-plantuml) ; PlantUML settings
(require 'init-python) ; Python settings
(require 'init-reformatter) ; reformatter settings
(require 'init-sessions) ; session settings
(require 'init-shell) ; Shell settings
(require 'init-spelling) ; spelling settings
(require 'init-tags) ; tags related config
(require 'init-uuid) ; UUID settings
(require 'init-veracrypt) ; VeraCrypt/TrueCrypt settings
(require 'init-utils) ; utils configuration
(require 'init-yaml) ; YAML settings
(require 'init-misc) ; miscellaneous settings
@ -165,10 +128,6 @@
;; move the keybindings to the end of the other settings
(require 'init-keybindings) ; keybindings with general.el
(when *dependencies-installation-enabled*
(require 'init-deps) ; dependencies installation
)
;; =============================================================================
;; footer

279
lisp/init-company.el
View File

@ -1,279 +0,0 @@
;;; init-company.el --- company completion related settings -*- lexical-binding: t -*-
;;; Commentary:
;;; Code:
;; {{ START: PComplete - Context-Sensitive Completion in Emacs
;; reference,
;; - https://web.archive.org/web/20231102054827/http://www.masteringemacs.org:80/article/pcomplete-context-sensitive-completion-emacs
;; - https://web.archive.org/web/20231102145724/https://timmydouglas.com/2020/12/18/eshell-complete.html
(defconst pcmpl-git-commands
'("add"
"bisect" "branch"
"checkout" "clone" "commit"
"diff"
"fetch"
"grep"
"init"
"log"
"merge" "mv"
"pull" "push"
"rebase" "remote" "reset" "restore" "rm"
"show"
"stash"
"status"
"submodule"
"tag")
"List of `git' commands.")
(defconst pcmpl-git-submodule-commands
'(
"foreach"
"init"
"status"
"sync"
"update"
))
(defconst pcmpl-git-diff-args
'(
"--cached"
"--staged"
))
(defconst pcmpl-git-log-args
'(
"--oneline"
))
(defconst pcmpl-git-stash-commands
'(
"clear"
"drop"
"list"
"pop"
"save"
))
(defvar pcmpl-git-ref-list-cmd "git for-each-ref refs/ --format='%(refname)'"
"The `git' command to run to get a list of refs.")
(defun pcmpl-git-get-refs (type)
"Return a list of `git' refs filtered by TYPE."
(with-temp-buffer
(insert (shell-command-to-string pcmpl-git-ref-list-cmd))
(goto-char (point-min))
(let ((ref-list))
(while (re-search-forward (concat "^refs/" type "/\\(.+\\)$") nil t)
(add-to-list 'ref-list (match-string 1)))
ref-list)))
(defun pcmpl-git-remotes ()
"Return a list of remote repositories."
(split-string (shell-command-to-string "git remote")))
(defun pcomplete/git ()
"Completion for `git'."
;; Completion for the command argument.
(pcomplete-here* pcmpl-git-commands)
;; complete files/dirs forever if the command is `add' or `rm'
(cond
((pcomplete-match "help" 1)
(pcomplete-here* pcmpl-git-commands))
((pcomplete-match (regexp-opt '("pull" "push")) 1)
(pcomplete-here (pcmpl-git-remotes)))
((pcomplete-match (regexp-opt '("add" "rm")) 1)
(while (pcomplete-here (pcomplete-entries))))
;; provide branch completion for the command `checkout'.
((pcomplete-match "checkout" 1)
(pcomplete-here* (append (pcmpl-git-get-refs "heads")
(pcmpl-git-get-refs "tags"))))
((pcomplete-match "submodule" 1)
(pcomplete-here* pcmpl-git-submodule-commands))
((pcomplete-match "diff" 1)
(pcomplete-here* pcmpl-git-diff-args))
((pcomplete-match "log" 1)
(pcomplete-here* pcmpl-git-log-args))
((pcomplete-match "stash" 1)
(pcomplete-here* pcmpl-git-stash-commands))
(t
(while (pcomplete-here (pcomplete-entries))))
))
;; END: PComplete - Context-Sensitive Completion in Emacs }}
;; {{ START: pcomplete company completion
;; via https://web.archive.org/web/20231102031110/https://xenodium.com/eshell-pcomplete-company-completion/
(defun company-pcomplete--overlap-tail (a b)
"When A is \"SomeDev\" and B is \"Developer\", return \"eloper\"."
(let ((prefix a)
(remaining nil))
(while (and (not remaining) (> (length prefix) 0))
(when (s-starts-with? prefix b)
(setq remaining (substring b (length prefix))))
(setq prefix (substring prefix 1)))
remaining))
(defun company-pcomplete--candidates (prefix)
"Get candidates for PREFIX company completion using `pcomplete'."
;; When prefix is: "~/Down" and completion is "Downloads", need
;; to find common string and join into "~/Downloads/".
(-map (lambda (item)
(if (s-starts-with? prefix item)
item
(concat prefix (company-pcomplete--overlap-tail prefix item))))
(all-completions prefix (pcomplete-completions))))
(defun company-pcomplete (command &optional arg &rest ignored)
"Complete using pcomplete. See `company''s COMMAND ARG and IGNORED for details."
(interactive (list 'interactive))
(cl-case command
(interactive (company-begin-backend 'company-pcomplete))
(prefix (company-grab-symbol))
(candidates
(company-pcomplete--candidates arg))))
;; END: pcomplete company completion }}
(use-package company-tabnine
:config
(setq company-tabnine-binaries-folder (expand-file-name ".TabNine/" user-emacs-directory))
;; (add-to-list 'company-backends #'company-tabnine)
)
(use-package company
:delight
:init
(global-company-mode)
:config
(setq company-idle-delay 0.2)
;; number the candidates (use M-1, M-2 etc to select completions).
(setq company-show-numbers t)
;; show suggestions after entering 3 character.
(setq company-minimum-prefix-length 3)
(setq company-dabbrev-downcase nil)
(setq company-dabbrev-ignore-case t)
(setq company-dabbrev-other-buffers nil)
(setq company-tooltip-align-annotations t)
;; when the list of suggestions is shown, and you go through the list of
;; suggestions and reach the end of the list, the end of the list of
;; suggestions does not wrap around to the top of the list again. This is a
;; minor inconvenience that can be solved:
(setq company-selection-wrap-around t)
;; use tab key to cycle through suggestions.
;; ('tng' means 'tab and go')
(company-tng-configure-default)
(setq company-transformers '(delete-dups
company-sort-by-occurrence))
(setq company-backends '(
(company-capf company-keywords company-dabbrev-code)
;; commented below to speed up the completion
;; (company-tabnine)
company-files)
)
;; add yasnippet support for all company backends.
(defvar company-mode/enable-yas t
"Enable yasnippet for all backends.")
(defun company-mode/backend-with-yas (backend)
(if (or (not company-mode/enable-yas) (and (listp backend) (member 'company-yasnippet backend)))
backend
(append (if (consp backend) backend (list backend))
'(:with company-yasnippet))))
(setq company-backends (mapcar #'company-mode/backend-with-yas company-backends))
;; set the backends for writing in text related mode
(defun my-company-backends-text-mode-hook ()
(setq-local company-backends '(
(company-dabbrev company-ispell)
;; commented below to speed up the completion
;; (company-tabnine)
company-files)
))
(dolist (hook '(
markdown-mode-hook
org-mode-hook
text-mode-hook
))
(add-hook hook 'my-company-backends-text-mode-hook))
;; set the backends for shell-mode
(defun my-company-backends-shell-mode-hook ()
(setq-local company-backends '(
(company-capf company-files company-pcomplete)
)))
(add-hook 'shell-mode-hook 'my-company-backends-shell-mode-hook)
;; add `company-elisp' backend for elisp.
;; (add-hook 'emacs-lisp-mode-hook
;; #'(lambda ()
;; (require 'company-elisp)
;; (push 'company-elisp company-backends)))
;; via https://github.com/manateelazycat/lazycat-emacs/blob/8f3dee8a6fe724ec52cd2b17155cfc2cefc8066b/site-lisp/config/init-company-mode.el
;; { START: company-candidates from abo-abo
;; if candidate list was ("var0" "var1" "var2"), then entering 1 means:
;; select the first candidate (i.e. "var0"), instead of:
;; insert "1", resulting in "var1", i.e. the second candidate
;; via,
;; - https://oremacs.com/2017/12/27/company-numbers/
(defun ora-company-number ()
"Forward to `company-complete-number'.
Unless the number is potentially part of the candidate.
In that case, insert the number."
;; via https://github.com/abo-abo/oremacs/blob/d217e22a3b8dc88d10f715b32a7d1facf1f7ae18/modes/ora-company.el#L22-L39
(interactive)
(let* ((k (this-command-keys))
(re (concat "^" company-prefix k)))
(if (or (cl-find-if (lambda (s) (string-match re s))
company-candidates)
(> (string-to-number k)
(length company-candidates))
(looking-back "[0-9]+\\.[0-9]*" (line-beginning-position)))
(self-insert-command 1)
(company-complete-number
(if (equal k "0")
10
(string-to-number k))))))
(let ((map company-active-map))
;; via https://github.com/abo-abo/oremacs/blob/d217e22a3b8dc88d10f715b32a7d1facf1f7ae18/modes/ora-company.el#L46-L53
(mapc (lambda (x) (define-key map (format "%d" x) 'ora-company-number))
(number-sequence 0 9))
(define-key map " " (lambda ()
(interactive)
(company-abort)
(self-insert-command 1)))
(define-key map (kbd "<return>") nil))
;; END: company-candidates from abo-abo }
)
;; use this package to fix tooltip alignment issue below,
;; https://github.com/company-mode/company-mode/issues/1388
(use-package company-posframe
:delight
:straight (:type git :host github :repo "tumashu/company-posframe")
:config
(company-posframe-mode 1)
)
(provide 'init-company)
;; Local Variables:
;; coding: utf-8
;; End:
;;; init-company.el ends here

263
lisp/init-deps.el
View File

@ -3,282 +3,69 @@
;;; Code:
;;; TODO:
;; - dep: shred
;; - dep: truecrypt/veracrypt
;;; NOTE: specific package manager is required,
;; - macOS: brew
;; - Linux: pacman
;; - Windows: scoop
;; (my-check-for-executable "Homebrew (macOS)" "brew")
;; (my-check-for-executable "npm (macOS/Linux)" "npm")
(defvar my-install-deps
'(
;; example,
;; (npm ; the executable binary name
;; :darwin-command "brew install node" ; the installation command for macOS
;; :linux-command "sudo pacman -S --noconfirm nodejs npm" ; the installation command for Linux
;; :windows-command "scoop install nodejs" ; the installation command for Windows
;; ...... ; if the darwin/linux/windows-command (above) is,
;; ...... ; - empty value (like - linux-command: ""), then a reminding message will raise for manual installation
;; ...... ; - not exist, then reminding message will show that xxx (executable binary name) is not considered to install on specific OS
;; :message nil ; manual set reminding message
;; :enabled t) ; to install or not
(npm ; install npm first
:darwin-command "brew install node"
:linux-command "sudo pacman -S --noconfirm nodejs npm"
:windows-command "scoop install nodejs"
:message nil
:enabled t)
(ansible-language-server
:darwin-command "npm install -g @ansible/ansible-language-server"
:linux-command "sudo npm install -g @ansible/ansible-language-server"
:windows-command "npm install -g @ansible/ansible-language-server"
:message nil
:enabled t)
(aspell
:darwin-command "brew install aspell" ; TODO: is the en dictionary installed automatically by brew?
:linux-command "sudo pacman -S --noconfirm aspell aspell-en"
:windows-command "scoop install aspell"
(defcustom my-install-deps
'((aspell
:darwin-command "brew install aspell"
:message "aspell is needed in this configuration file, check/install it manually."
:enabled t)
(bash-language-server
:darwin-command "npm install -g bash-language-server"
:linux-command "sudo npm install -g bash-language-server"
:windows-command "npm install -g bash-language-server"
:message nil
:enabled t)
(ctags
:darwin-command "brew install universal-ctags"
:linux-command "sudo pacman -S --noconfirm ctags"
:windows-command "scoop install universal-ctags"
:message "ctags is needed in this configuration file, check/install it manually."
:enabled t)
;; (dovecot
;; :linux-command "sudo pacman -S --noconfirm dovecot"
;; :message nil
;; :enabled t)
(fzf
:linux-command "sudo pacman -S --noconfirm fzf"
:message nil
:enabled t)
;; (global ; https://www.gnu.org/software/global/
;; :linux-command "sudo pacman -S --noconfirm global"
;; :message nil
;; :enabled t)
(grammarly-languageserver
:darwin-command "npm install -g @emacs-grammarly/grammarly-languageserver"
:linux-command "sudo npm install -g @emacs-grammarly/grammarly-languageserver"
:windows-command "npm install -g @emacs-grammarly/grammarly-languageserver"
:message nil
:enabled t)
(languagetool
:darwin-command "brew install languagetool"
:linux-command "sudo pacman -S --noconfirm languagetool"
;; :windows-command ""
:message nil
:enabled t)
(less
:darwin-command "brew install less"
:linux-command "sudo pacman -S --noconfirm less"
:windows-command "scoop install less"
:message nil
:enabled t)
(marksman ; https://github.com/artempyanykh/marksman
:darwin-command "brew install marksman"
:linux-command "sudo pacman -S --noconfirm marksman"
;; :windows-command ""
:message nil
:enabled t)
(mbsync ; https://isync.sourceforge.io
:linux-command "sudo pacman -S --noconfirm isync"
:message nil
:enabled t)
(notmuch
;; it is recommended to install the specific version that come the same as
;; Emacs `notmuch` package (in my `site-lisp`)
;; currently, the notmuch version on my Arch Linux is 0.38.3-1,
;; $ notmuch --version
;; notmuch 0.38.3
:linux-command "sudo pacman -S --noconfirm notmuch"
:message nil
:enabled t)
;; (offlineimap
;; :linux-command "sudo pacman -S --noconfirm offlineimap"
;; :message nil
;; :enabled t)
(rsync
:linux-command "sudo pacman -S --noconfirm rsync"
:message nil
:enabled t)
(sbcl
:darwin-command "brew install sbcl"
:linux-command "sudo pacman -S --noconfirm sbcl"
:windows-command "scoop install sbcl"
:message nil
:enabled t)
(shellcheck
:darwin-command "brew install shellcheck"
:linux-command "sudo pacman -S --noconfirm shellcheck"
:windows-command "scoop install shellcheck"
:message "shellcheck is needed in this configuration file, check/install it manually."
:enabled t)
(shfmt
:darwin-command "brew install shfmt"
;; :linux-command "sudo snap install shfmt"
:linux-command "sudo pacman -S --noconfirm shfmt"
:windows-command "scoop install shfmt"
:message "shfmt is needed in this configuration file, check/install it manually."
:enabled t)
(sqlite3
:darwin-command "brew install sqlite"
:linux-command "sudo pacman -S --noconfirm sqlite"
:windows-command "scoop install sqlite"
:message "sqlite3 is needed in this configuration file, check/install it manually."
:enabled t)
(stardict
:darwin-command "brew install stardict"
:linux-command "sudo pacman -S --noconfirm stardict"
;; :windows-command ""
:message nil
:enabled t)
(sdcv
:darwin-command "brew install sdcv"
:linux-command "sudo pacman -S --noconfirm sdcv"
;; :windows-command ""
:message nil
:enabled t)
(rg
(ripgrep
:darwin-command "brew install ripgrep"
:linux-command "sudo pacman -S --noconfirm ripgrep"
:windows-command "scoop install ripgrep"
:message "ripgrep (rg) is needed in this configuration file, check/install it manually."
:message "ripgrep is needed in this configuration file, check/install it manually."
:enabled t)
(js-yaml
:darwin-command "npm install -g js-yaml"
:linux-command "sudo npm install -g js-yaml"
:windows-command "npm install -g js-yaml"
:message nil ;; No message needed for js-yaml
:enabled t)
(pyright
:darwin-command "brew install pyright"
;; :linux-command "pipx install pyright"
:linux-command "sudo pacman -S --noconfirm pyright"
:windows-command "npm install -g pyright"
:linux-command "sudo npm install -g pyright"
:message nil ;; No message needed for pyright
:enabled t)
(prettier
:darwin-command "brew install prettier"
:linux-command "sudo pacman -S --noconfirm prettier"
:windows-command "npm install -g prettier"
:linux-command "sudo npm install -g prettier"
:message nil ;; No message needed for prettier
:enabled t)
(trash-list ;; check trash-list command as the trash-cli is not a valid command for trash-cli
:linux-command "sudo pacman -S --noconfirm trash-cli"
:message nil
:enabled t)
(tmux
:linux-command "sudo pacman -S --noconfirm tmux"
:message nil
:enabled t)
(unzip ; for nov.el package
:linux-command "sudo pacman -S --noconfirm unzip"
:message nil
:enabled t)
(vi ; recommended as it is needed by `git merge` by default
:linux-command "sudo pacman -S --noconfirm vi"
:message nil
:enabled t)
(vim
:linux-command "sudo pacman -S --noconfirm vim"
:message nil
:enabled t)
(yaml-language-server
:darwin-command "npm install -g yaml-language-server"
:linux-command "sudo npm install -g yaml-language-server"
:windows-command "npm install -g yaml-language-server"
:message nil
:enabled t)
))
:enabled t)))
(defun my-install-dependency (name command)
"Install a dependency NAME using COMMAND if it is not already installed.
Display the MESSAGE if installation is skipped."
(unless (executable-find name)
(if (y-or-n-p (format "Install %s? " name))
(progn
(message (format "Installing %s..." name))
(shell-command command))
(progn
(message (format "Installing %s..." name))
(shell-command command))
(message "Skipping %s installation." name))))
(defun my-install-all-deps ()
"Install enabled Emacs dependencies."
(interactive)
(dolist (dep my-install-deps)
(let* ((name (symbol-name (car dep)))
(value (cdr dep))
(command-darwin (plist-get value :darwin-command))
(command-linux (plist-get value :linux-command))
(command-windows (plist-get value :windows-command))
(msg (plist-get value :message))
(enabled (plist-get value :enabled)))
(let* ((name (car dep))
(command-darwin (plist-get dep :darwin-command))
(command-linux (plist-get dep :linux-command))
(command (plist-get dep :command))
(message (plist-get dep :message))
(enabled (plist-get dep :enabled)))
(when enabled
(unless (executable-find name)
(cond
;; macOS condition
((and (eq system-type 'darwin)
command-darwin
(not (string-empty-p command-darwin)))
(my-install-dependency name command-darwin))
((and (eq system-type 'darwin)
(eq command-darwin nil))
(message "%s is not considered to install on macOS." name))
;; Linux condition
((and (eq system-type 'gnu/linux)
command-linux
(not (string-empty-p command-linux)))
(my-install-dependency name command-linux))
((and (eq system-type 'gnu/linux)
(eq command-linux nil))
(message "%s is not considered to install on Linux." name))
;; Windows condition
((and (eq system-type 'windows-nt)
command-windows
(not (string-empty-p command-windows)))
(my-install-dependency name
(format
"powershell -Command \"%s\""
command-windows)))
((and (eq system-type 'windows-nt)
(eq command-windows nil))
(message "%s is not considered to install on Windows." name))
;; for any other condition
(t
(let* ((msg-content
(if msg
msg
(format "%s executable is needed in this configuration file,
check/install it manually." name)))
(prompt-msg (concat msg-content " Press ENTER to continue.")))
(when (string= (read-string prompt-msg) "")
(message "Continuing..."))
))))))))
(progn
(when *is-win*
(my-check-for-executable "Scoop (Windows)" "scoop"))
(when *is-mac*
(my-check-for-executable "Homebrew (macOS)" "brew"))
(when *is-linux*
(my-check-for-executable "npm (macOS/Linux)" "npm"))
(my-install-all-deps))
(cond
((and command-darwin (eq system-type 'darwin))
(my-install-dependency name command-darwin))
((and command-linux (eq system-type 'gnu/linux))
(my-install-dependency name command-linux))
(unless (and command-darwin command-linux)
(when message
(message message))))))))
(provide 'init-deps)

83
lisp/init-dict.el
View File

@ -1,83 +0,0 @@
;;; init-dict.el --- dict settings -*- lexical-binding: t -*-
;;; Commentary:
;;; Code:
;; {{ START: Look up text at-point/marked by GoldenDict in Emacs
;; https://github.com/jsntn/goldendict-emacs/tree/my
(defun my-look-up-dict (word)
(let ((goldendict-executable (executable-find "goldendict")))
(if goldendict-executable
(start-process "goldendict" nil goldendict-executable word)
(message "GoldenDict executable not found. Please make sure it is installed and in your PATH."))))
(defun my/look-up-dict ()
"Look up text at-point/marked by GoldenDict in Emacs.
Version 2023-08-03"
(interactive)
(let ((word ""))
(if (and (bound-and-true-p mark-active) (not (equal (point) (mark))))
(setq word (buffer-substring (region-beginning) (region-end)))
(setq word (thing-at-point 'word)))
(if (not (string-blank-p word))
(my-look-up-dict word)
(message "No word found at point or in the marked region."))))
(global-set-key (kbd "C-c g") 'my/look-up-dict)
;; END }}
(use-package company-english-helper
:straight (:host github :repo "jsntn/company-english-helper" :branch "my"))
(if *is-linux*
(use-package sdcv
:straight (:host github :repo "manateelazycat/sdcv")
:config
(setq sdcv-dictionary-data-dir "/usr/share/stardict/dic/")
(global-set-key (kbd "C-c d") 'sdcv-search-pointer)
;; extract my dictionaries of ~/misc/*.bz2 files to stardict dictionary folder
;; note: the extraction will not happen if ~/misc/extracted.txt exists
(defun my-extract-stardict-bz2-files-on-linux ()
(interactive)
(let* ((dir (expand-file-name "misc" (getenv "HOME")))
(extracted-file (concat dir "/extracted.txt"))
(files
(if (file-directory-p dir)
(directory-files dir nil "\\.bz2\\'")
nil)))
(if (and files (not (null files)))
(if (or (not (file-exists-p extracted-file))
(not (my-file-contains-p extracted-file files)))
(progn
(dolist (file files)
(let ((abs-file (concat dir "/" file)))
(shell-command
(format "sudo tar -xjvf %s -C /usr/share/stardict/dic" abs-file)))
(with-temp-buffer
(set-buffer-file-coding-system 'utf-8-unix)
(insert file)
(insert "\n")
(append-to-file (point-min) (point-max) extracted-file)
))
(my-merge-duplicated-lines-in-file extracted-file)
(message "StarDict dictionaries extraction completed."))
(message "All StarDict dictionaries have already been extracted."))
(message "The folder (misc) does not exist or does not contain any .bz2 files.")
)))
(my-extract-stardict-bz2-files-on-linux)
))
(provide 'init-dict)
;; Local Variables:
;; coding: utf-8
;; End:
;;; init-dict.el ends here

169
lisp/init-display.el
View File

@ -3,109 +3,12 @@
;;; Code:
(use-package delight)
(use-package diminish)
(use-package doom-themes
:config
;; global settings (defaults)
(setq doom-themes-enable-bold t) ; if nil, bold is universally disabled
;; corrects (and improves) org-mode's native fontification
;; update: disable this as it is not compatible with org-modern horizontal
;; line, see https://github.com/jsntn/emacs.d/issues/13
;; (doom-themes-org-config)
;; theme does not load correctly in daemon mode, see,
;; - https://stackoverflow.com/a/23668935/4274775
;; - https://github.com/cpaulik/emacs-material-theme/issues/45#issuecomment-385247309
;; - https://github.com/nordtheme/emacs/issues/59
;; customization on doom-monokai-classic
(defun my-load-theme ()
(load-theme 'doom-monokai-classic t)
(custom-set-faces
`(mode-line ((t (:background ,(doom-color 'dark-violet)))))
`(font-lock-comment-face ((t (:foreground ,(doom-color 'base6)))))
`(default ((t (:background "black"))))))
(if (daemonp)
(add-hook 'after-make-frame-functions
(lambda (frame)
(with-selected-frame frame
(my-load-theme))))
(my-load-theme))
)
;; { START: hide list of minor modes in mode-line
;; from https://emacs.stackexchange.com/a/3928/29715
(defvar my-hidden-minor-modes
'(abbrev-mode
auto-capitalize-mode
auto-fill-function
auto-revert-mode
dired-async-mode
flycheck-mode
flyspell-mode
;; haskell-indent-mode
;; haskell-doc-mode
;; inf-haskell-mode
org-roam-mode
pangu-spacing-mode
projectile-mode
pyim-isearch-mode
;; smooth-scroll-mode
undo-tree-mode
which-key-mode
evil-collection-unimpaired-mode
hs-minor-mode
org-remark-global-tracking-mode
yas-minor-mode
eldoc-mode
org-indent-mode
))
(defun my/purge-minor-modes ()
(interactive)
(dolist (x my-hidden-minor-modes nil)
(let ((trg (cdr (assoc x minor-mode-alist))))
(when trg
(setcar trg "")))))
(add-hook 'after-change-major-mode-hook 'my/purge-minor-modes)
;; END: hide list of minor modes in mode-line }
;; { -- START: display time in mode line --
;; reference:
;; ... https://www.reddit.com/r/emacs/comments/6ftm3x/share_your_modeline_customization/dil4x5z/?utm_source=reddit&utm_medium=web2x&context=3
;; ... http://emacs.1067599.n8.nabble.com/Week-number-td89988.html
(setq display-time-string-forms
'((propertize
;; %W and %V
;; http://emacs.1067599.n8.nabble.com/Week-number-tp89988p89991.html
(format-time-string "[%V] %H:%M:%S" now) ;; https://www.gnu.org/software/emacs/manual/html_node/elisp/Time-Parsing.html
;; 'face 'modeline-display-time
'help-echo (format-time-string "[%V] %H:%M:%S" now))))
(display-time-mode 1)
(defun my-update-time ()
"Update the time string in the mode line every second."
(display-time-mode 1))
(run-with-timer 0 1 'my-update-time)
;; -- END: display time in mode line -- }
(add-hook 'emacs-lisp-mode-hook 'show-paren-mode) ; highlight matching
; parenthesis
(global-hl-line-mode 1) ; highlight current line
(setq display-line-numbers-width-start t)
;; use below to fix slow scrolling issue
(global-display-line-numbers-mode 1)
;; via https://www.reddit.com/r/orgmode/comments/e7pq7k/linummode_very_slow_for_large_org_files/
;; there is display issue on citre-peek, see,
;; https://github.com/universal-ctags/citre/issues/161
(setq column-number-mode t) ; turn on column numbers
;; wrap lines at 80 characters
@ -128,9 +31,32 @@
;; https://stackoverflow.com/questions/50417/how-do-i-get-list-of-recent-files-in-gnu-emacs/50422#50422
(recentf-mode 1)
;; FIXME: to be fixed (GitHub Actions Pipeline). See error below,
;; Debugger entered--Lisp error: (void-function set-fontset-font)
;; (progn
;; ;; set font for emoji (if before emacs 28, should come after setting
;; ;; symbols. emacs 28 now has 'emoji . before, emoji is part of 'symbol)
;; ;; http://xahlee.info/emacs/emacs/emacs_set_font_emoji.html
;; (set-fontset-font
;; t
;; (if (version< emacs-version "28.1")
;; '(#x1f300 . #x1fad0)
;; 'emoji
;; )
;; (cond
;; ((member "Apple Color Emoji" (font-family-list)) "Apple Color Emoji")
;; ((member "Noto Color Emoji" (font-family-list)) "Noto Color Emoji")
;; ;;<2022-10-31 NotoColorEmoji uses the CBDT/CBLC color font format, which is
;; ;; supported by Android and Chrome/Chromium OS. Windows supports it starting
;; ;; with Windows 10 Anniversary Update in Chrome and Edge.
;; ;; Via https://github.com/googlefonts/noto-emoji/blob/f826707b28355f6cd1593f504427ca2b1f6c4c19/README.md#using-notocoloremoji
;; ((member "Noto Emoji" (font-family-list)) "Noto Emoji")
;; ((member "Segoe UI Emoji" (font-family-list)) "Segoe UI Emoji")
;; ((member "Symbola" (font-family-list)) "Symbola"))) ; http://xahlee.info/comp/unicode_font_download.html
;; )
(when (display-graphic-p)
(my-check-for-font "Symbola" "Symbola font is not installed, however, it is recommended to install for proper emoji display. Press ENTER to continue."))
;; the default split-screen direction
;; https://stackoverflow.com/a/7998271
@ -213,7 +139,8 @@ Version 2017-03-12"
(hs-hide-block)
(hs-show-block)))
;; { -- START: default inline image background in Org-mode
;; { -- START --
;; default inline image background in Org-mode
;; https://emacs.stackexchange.com/a/37927/29715
;; note: restart Emacs to make this change effective
(defcustom org-inline-image-background nil
@ -222,11 +149,7 @@ When nil, use the default face background."
:group 'org
:type '(choice color (const nil)))
(defvar my-bg-color-to-create-image 'transparent
"Variable to track the current advice for create-image.
Possible values: 'transparent or 'white.")
(defun my-create-image-with-white-background-color (args)
(defun create-image-with-background-color (args)
"Specify background color of Org-mode inline image through modify `ARGS'."
(let* ((file (car args))
(type (cadr args))
@ -237,39 +160,9 @@ When nil, use the default face background."
(list :background "white")
props)))
(defun my-create-image-with-transparent-background-color (args)
"Specify background color of Org-mode inline image through modify `ARGS'."
(let* ((file (car args))
(type (cadr args))
(data-p (caddr args))
(props (cdddr args)))
;; Get this return result style from `create-image'.
(append (list file type data-p)
(list :background "transparent")
props)))
(advice-add 'create-image :filter-args
#'my-create-image-with-transparent-background-color)
(defun my/toggle-bg-color-to-create-image ()
"Toggle between transparent and white background color advice for create-image."
(interactive)
(advice-remove 'create-image 'my-create-image-with-transparent-background-color)
(advice-remove 'create-image 'my-create-image-with-white-background-color)
(if (eq my-bg-color-to-create-image 'transparent)
(progn
(advice-add 'create-image :filter-args
#'my-create-image-with-white-background-color)
(setq my-bg-color-to-create-image 'white)
(message "Switched background color for create-image to white.")
)
(progn
(advice-add 'create-image :filter-args
#'my-create-image-with-transparent-background-color)
(setq my-bg-color-to-create-image 'transparent)
(message "Switched background color for create-image to transparent.")
)))
;; -- END: default inline image background in Org-mode }
#'create-image-with-background-color)
;; -- END -- }
(provide 'init-display)

58
lisp/init-evil.el
View File

@ -1,58 +0,0 @@
;;; init-evil.el --- evil related config -*- lexical-binding: t -*-
;;; Commentary:
;;; Code:
;; evil-collection assumes evil-want-keybinding is set to nil and
;; evil-want-integration is set to t before loading evil and evil-collection.
(setq evil-want-integration t)
(setq evil-want-keybinding nil)
(use-package evil
:init
(unless (display-graphic-p)
(setq evil-want-C-i-jump nil)
)
:after undo-tree
:config
(evil-set-undo-system 'undo-tree) ; https://github.com/emacs-evil/evil/issues/1372#issuecomment-712611291
(global-undo-tree-mode)
(evil-mode 1)
;; change the cursor color in terms of evil mode
(setq evil-emacs-state-cursor '("red" box))
(setq evil-normal-state-cursor '("green" box))
(setq evil-visual-state-cursor '("orange" box))
(setq evil-insert-state-cursor '("red" bar))
(setq evil-replace-state-cursor '("red" bar))
(setq evil-operator-state-cursor '("red" hollow))
)
(use-package evil-collection
:after evil
:config
(evil-collection-init)
)
(use-package evil-leader
:config
(global-evil-leader-mode)
)
(use-package evil-surround
:config
(global-evil-surround-mode 1)
)
(use-package evil-visualstar
:config
(global-evil-visualstar-mode)
)
(provide 'init-evil)
;; Local Variables:
;; coding: utf-8
;; End:
;;; init-evil.el ends here

93
lisp/init-font.el
View File

@ -5,99 +5,6 @@
(setq inhibit-compacting-font-caches t) ; don't compact font caches during GC.
(use-package cnfonts
:if window-system ; only load this package when in graphical Emacs
:config
(cnfonts-mode 1)
(setq cnfonts-profiles
'("program" "org-mode" "read-book"))
(setq cnfonts-use-system-type t) ; save profile config across different system-type
)
;; {{ START: display the emojis
;; reference,
;; https://github.com/doomemacs/doomemacs/issues/3298
;; https://www.reddit.com/r/emacs/comments/4v7tcj/does_emacs_have_a_hook_for_when_the_theme_changes/
;; (defvar after-load-theme-hook nil
;; "Hook run after a color theme is loaded using `load-theme'.")
;; (defadvice load-theme (after run-after-load-theme-hook activate)
;; "Run `after-load-theme-hook'."
;; (run-hooks 'after-load-theme-hook))
;; ...
;; (add-hook 'after-load-theme-hook #'my-set-emoji-font)
;; for debugging,
;; (set-fontset-font t 'emoji nil)
;; :smile:
;; 😄
(defun my-emoji-can-display ()
(if (char-displayable-p ?😄)
t
nil))
;; 2023/08/29 enable this and this needs further investigation...
;; FIXME: to be fixed (GitHub Actions Pipeline). See error below,
;; Debugger entered--Lisp error: (void-function set-fontset-font)
(defun my-set-emoji-font ()
(if (functionp 'set-fontset-font)
(progn
;; set font for emoji (if before emacs 28, should come after setting
;; symbols. emacs 28 now has 'emoji . before, emoji is part of 'symbol)
;; http://xahlee.info/emacs/emacs/emacs_set_font_emoji.html
(set-fontset-font
t
(if (version< emacs-version "28.1")
'(#x1f300 . #x1fad0)
'emoji
)
(cond
((member "Apple Color Emoji" (font-family-list)) "Apple Color Emoji")
((member "Noto Color Emoji" (font-family-list)) "Noto Color Emoji")
;; 2022-10-31 NotoColorEmoji uses the CBDT/CBLC color font format, which is
;; supported by Android and Chrome/Chromium OS. Windows supports it starting
;; with Windows 10 Anniversary Update in Chrome and Edge.
;; Via https://github.com/googlefonts/noto-emoji/blob/f826707b28355f6cd1593f504427ca2b1f6c4c19/README.md#using-notocoloremoji
((member "Noto Emoji" (font-family-list)) "Noto Emoji")
((member "Segoe UI Emoji" (font-family-list)) "Segoe UI Emoji")
((member "Symbola" (font-family-list)) "Symbola")
((message "No emoji font found."))
)) ; http://xahlee.info/comp/unicode_font_download.html
)
(message "set-fontset-font is not available in current %s" emacs-version))
;; (remove-hook 'focus-in-hook #'my-set-emoji-font)
)
;; (my-set-emoji-font)
;; https://www.reddit.com/r/emacs/comments/6lxf9b/question_emacsclient_and_connection_hooks/
;; (add-hook 'focus-in-hook #'my-set-emoji-font)
(defun my-advice-cnfonts-set-font (&rest _)
"Advice function to set emoji font when cnfonts-mode is activated."
(my-set-emoji-font))
;; Advising cnfonts-set-font to include setting emoji font
(advice-add 'cnfonts-set-font :after 'my-advice-cnfonts-set-font)
(when (display-graphic-p)
(unless (my-emoji-can-display)
(my-check-for-font "Symbola" "Symbola font is not installed, however, it is recommended to install for proper emoji display. Press ENTER to continue.")
))
(use-package emojify
:init
(global-emojify-mode)
:config
(setq emojify-company-tooltips-p t)
(setq emojify-display-style 'unicode)
)
;; END: display the emojis }}
(provide 'init-font)

37
lisp/init-gpg.el
View File

@ -1,37 +0,0 @@
;;; init-gpg.el --- GPG settings -*- lexical-binding: t -*-
;;; Commentary:
;;; Code:
;; {{ START: decrypt link at point
(require 'epa)
(require 'org-element)
(defun my/decrypt-gpg-link-at-point ()
"Decrypt GPG link at point.
Version 2023-08-04"
(interactive)
(let* ((link-info (org-element-context))
(path (org-element-property :path link-info))
(abs-path (if (string-prefix-p "file:" path)
(file-truename (replace-regexp-in-string "^file:" "" path))
(file-truename path)))
(default-decrypt-path (concat abs-path ".clear")))
(if (file-exists-p abs-path)
(let ((decrypt-path (read-file-name
(format "Enter target path (default %s): " default-decrypt-path)
nil nil nil default-decrypt-path)))
(epa-decrypt-file abs-path decrypt-path))
(message "File not found: %s" abs-path))))
;; END }}
(provide 'init-gpg)
;; Local Variables:
;; coding: utf-8
;; End:
;;; init-gpg.el ends here

3
lisp/init-hooks.el
View File

@ -3,9 +3,6 @@
;;; Code:
;; highlight current line for all programming major modes
(add-hook 'prog-mode-hook #'hl-line-mode)
(defun my/hs-hide-all ()
(hs-minor-mode 1)
(hs-hide-all)

13
lisp/init-ibuffer.el
View File

@ -9,19 +9,6 @@
(ibuffer-jump-to-buffer (buffer-name (cadr (buffer-list)))))
(add-hook 'ibuffer-hook #'ibuffer-jump-to-last-buffer)
(with-eval-after-load 'ibuffer
;; use human readable size column instead of original one
(define-ibuffer-column size-h
(:name "Size" :inline t)
(file-size-human-readable (buffer-size))))
(setq ibuffer-formats
'((mark modified read-only " "
(name 35 35 :left :nil) " "
(size-h 9 -1 :right) " "
(mode 12 12 :left :elide) " "
filename-and-process)))
(provide 'init-ibuffer)

26
lisp/init-keybindings.el
View File

@ -7,24 +7,9 @@
;; https://github.com/noctuid/general.el
;; C-x Keybindings:
;; Commands starting with C-x are often used for operations related to files,
;; buffers, windows, and frames.
;; For example, C-x C-f is used to open a file, C-x C-s is used to save a
;; buffer, and C-x 2 is used to split the current window into two vertical
;; windows.
;; C-c Keybindings:
;; Commands starting with C-c are typically user-defined or related to major and
;; minor modes specific to a particular programming language or context.
;; Users and mode developers can define their own keybindings under this prefix
;; to tailor Emacs to their specific needs.
;; For example, in a programming mode like Python mode, C-c C-r can be bound to
;; run a Python script.
;; global keybindings
(general-define-key
"M-x" 'helm-M-x
"C-s" 'swiper ; having own history variable allows to get more use of M-p, M-n
; and C-r.
"C-=" 'er/expand-region
@ -36,7 +21,6 @@
"C-M-<up>" 'enlarge-window
"M-i" 'pyim-convert-string-at-point ; <<pyim-csap>>
"C-;" 'pyim-delete-word-from-personal-buffer
"M-," 'citre-jump-back
;; ...
)
@ -74,9 +58,9 @@
:states '(normal visual)
"ff" 'evil-scroll-page-down ; <<page down>>
"bb" 'evil-scroll-page-up ; <<page-up>>
"br" 'ibuffer
"be" 'ibuffer
"SPC" 'my/toggle-hideshow-block
"C-]" 'citre-jump
"C-]" 'counsel-etags-find-tag-at-point ; <<ftap>>
;; ...
)
@ -121,10 +105,6 @@
"b" 'counsel-bookmark
"c" 'org-capture
"f" 'ace-jump-char-mode ;; <<ajm-1>>
"]" 'citre-peek
"[" 'citre-jump-back
"C-/" 'company-files
"C-b" 'company-tabnine
;; ...
)

39
lisp/init-messages.el
View File

@ -1,39 +0,0 @@
;;; init-messages.el --- *Messages* buffer settings -*- lexical-binding: t -*-
;;; Commentary:
;;; Code:
(setq messages-buffer-max-lines 10000)
;; {{ START: add a timestamp to each entry in Emacs' *Messages* buffer
;; via https://emacs.stackexchange.com/a/33523
(defun sh/current-time-microseconds ()
"Return the current time formatted to include microseconds."
(let* ((nowtime (current-time))
(now-ms (format "%.3s" (nth 2 nowtime)))) ; use "%.3s" to limit to 3 characters
(concat (format-time-string "[%Y-%m-%dT%T" nowtime) (format ".%s]" now-ms))))
(defun sh/ad-timestamp-message (FORMAT-STRING &rest args)
"Advice to run before `message' that prepends a timestamp to each message.
Activate this advice with:
(advice-add 'message :before 'sh/ad-timestamp-message)"
(unless (string-equal FORMAT-STRING "%s%s")
(let ((deactivate-mark nil)
(inhibit-read-only t))
(with-current-buffer "*Messages*"
(goto-char (point-max))
(if (not (bolp))
(newline))
(insert (sh/current-time-microseconds) " ")))))
(advice-add 'message :before 'sh/ad-timestamp-message)
;; END: add a timestamp to each entry in Emacs' *Messages* buffer }}
(provide 'init-messages)
;; Local Variables:
;; coding: utf-8
;; End:
;;; init-messages.el ends here

598
lisp/init-misc.el
View File

@ -14,6 +14,8 @@
(interactive)
(find-file (symbol-value 'user-init-file)))
(save-place-mode 1)
(fset 'yes-or-no-p 'y-or-n-p) ; use 'y/n' instead of 'yes/no'
(setq confirm-kill-emacs
@ -23,152 +25,344 @@
;; to prevent kill and yank commands from accessing the clipboard
(setq x-select-enable-clipboard nil)
(defun my/review-random-function ()
"Review a random function defined in my Emacs configuration."
(interactive)
(let* ((config-functions '())
(config-files (directory-files-recursively user-emacs-directory "\\.el$")))
(dolist (file config-files)
(with-temp-buffer
(insert-file-contents file)
(goto-char (point-min))
(while (re-search-forward "(defun \\([^ ]+\\)" nil t)
(push (match-string 1) config-functions))))
(let* ((command (nth (random (length config-functions)) config-functions)))
(describe-function (intern command)))))
(defun my/review-random-my-function ()
"Review a random function that starts with 'my/' in my Emacs configuration."
(interactive)
(let* ((config-functions '())
(config-files (directory-files-recursively user-emacs-directory "\\.el$")))
(dolist (file config-files)
(with-temp-buffer
(insert-file-contents file)
(goto-char (point-min))
(while (re-search-forward "(defun my/\\([^ ]+\\)" nil t)
(push (match-string 1) config-functions))))
(let* ((command (nth (random (length config-functions)) config-functions)))
(describe-function (intern (concat "my/" command))))))
;; {{ START: my/open-link-at-point-as-gpg
(defun my/securely-delete-file (&optional filename)
"Securely delete the specified file interactively or by providing FILENAME.
If secure deletion failed, then continue with the normal deletion."
(interactive (list (when current-prefix-arg
(read-file-name "Choose file to securely delete: "))))
(if filename
(progn
(message "Securely deleting %s..." (shell-quote-argument filename))
(cond
((eq system-type 'windows-nt)
;; https://learn.microsoft.com/en-us/sysinternals/downloads/sdelete
(my-check-for-executable "SDelete" "sdelete")
(shell-command (concat "sdelete -p 3 " (shell-quote-argument filename))))
((eq system-type 'gnu/linux)
(my-check-for-executable "shred" "shred")
(shell-command (concat "shred -v -z -u -n 10 " (shell-quote-argument filename))))
((eq system-type 'darwin)
(my-check-for-executable "shred" "gshred")
(shell-command (concat "gshred -v -z -u -n 10 " (shell-quote-argument filename)))))
(when (file-exists-p (shell-quote-argument filename))
(message "Securely deleting %s failed, and continue with the normal deletion." (shell-quote-argument filename))
(delete-file filename)))
(user-error "No file specified for secure deletion.")))
(defun my/open-link-at-point-as-gpg ()
"Open the link at point using Emacs epa in a temporary buffer,
and the decrypted file will be securely deleted after opening in buffer."
(interactive)
(require 'epa)
(let* ((link-info (org-element-context))
(path (org-element-property :path link-info))
(abs-path (if (string-prefix-p "file:" path)
(file-truename (replace-regexp-in-string ":" "" path))
(file-truename path)))
(decrypted-file (concat abs-path ".clear")))
(if (file-exists-p abs-path)
(progn
(epa-decrypt-file abs-path decrypted-file)
(find-file decrypted-file)
(when (file-exists-p decrypted-file)
(my/securely-delete-file decrypted-file)))
(message "File does not exist: %s" abs-path))))
;; END: my/open-link-at-point-as-gpg }}
;; {{ START: my/check-orphaned-org-ids-in-directory
(require 'org-element) ; this should be here before `org-add-link-type'
(require 'cl-lib)
(defun my-monitor-clipboard-and-write-to-file (output-file-path x-seconds)
"Monitor system clipboard and write new content to the specified file."
(defun my-clipboard-monitor-task ()
(let ((current-clipboard
(or (x-get-selection 'CLIPBOARD) "")))
(unless (equal current-clipboard my-clipboard-text)
(setq my-clipboard-text current-clipboard)
(with-temp-file output-file-path
(insert current-clipboard)))))
;; From ChatGPT,
;; The message "Created id link." is printed by the `org-add-link-type` function
;; each time it is called.
;; Since you have the line `(org-add-link-type "id" #'my-org-id-link-follow)` in
;; your code, this function is called every time you load or reload your Emacs
;; configuration. It registers a new link type called `"id"` that is handled by
;; the `my-org-id-link-follow` function.
(setq my-clipboard-text nil)
(my-schedule-task-every-x-secs x-seconds 'my-clipboard-monitor-task))
;; Call the function with the desired output file path
;; (my-monitor-clipboard-and-write-to-file "c:/x-clipboard.txt" 1)
;; register new link type called "id"
(org-add-link-type "id" #'my-org-id-link-follow)
(defun my-monitor-kill-and-write-to-file (register-name output-file-path x-seconds)
"Monitor the specified kill ring for changes and write its content to a specified file.
(defun my-org-id-link-follow (id)
"Follow an `id' link."
(message "Link ID: %s" id))
Example usage:
(my-monitor-kill-and-write-to-file ?0 \"c:/emacs-clipboard.txt\" 1)
(defun my-org-id-links-in-buffer ()
"Return a list of Org ID links in the current buffer."
(let (org-id-links) ; creates a local variable called `org-id-links` with an
; initial value of `nil` that is only visible within the
; `let` block
(org-element-map (org-element-parse-buffer) 'link
(lambda (link)
(when (string= (org-element-property :type link) "id")
(push (org-element-property :path link) org-id-links)
)))
org-id-links))
Version: 2023
Updated: 2024-04-24"
(defun my-kill-monitor-task ()
(condition-case nil
(let ((current-contents (get-register register-name)))
(unless (equal current-contents my-previous-kill-contents)
(setq my-previous-kill-contents current-contents)
(with-temp-file output-file-path
(insert current-contents))))
(error)))
(defun my-list-org-id-links-in-directory (directory)
"Search all .org files in DIRECTORY for Org ID links, and return a list of unique IDs found."
(interactive "DDirectory: ")
(let (org-ids)
(dolist (file (directory-files-recursively directory "\\.org$") org-ids)
(with-temp-buffer
(insert-file-contents file)
(setq org-ids (append org-ids (my-org-id-links-in-buffer)))
))
(delete-dups org-ids)
))
(setq my-previous-kill-contents "")
(let ((task-name (concat "my-kill-monitor-task_from-"
(string register-name)
"-to-"
(my-remove-file-suffix (file-name-nondirectory output-file-path)))))
(fset (intern task-name) #'my-kill-monitor-task)
(my-schedule-task-every-x-secs x-seconds (intern task-name))))
;; (current-kill 0)
;; (get-register ?0)
;; (my-monitor-kill-and-write-to-file ?0 "c:/emacs-clipboard.txt" 1)
(defun my-list-org-ids-in-directory (directory)
"List all org-ids in org-files in the given DIRECTORY and return them as a list."
(interactive "DDirectory: ")
(let ((org-files (directory-files-recursively directory "\\.org$"))
(org-ids '()))
(dolist (file org-files)
(with-temp-buffer
(insert-file-contents file)
(org-mode)
(org-element-map (org-element-parse-buffer) 'headline
(lambda (headline)
(when-let ((id (org-element-property :ID headline)))
(push id org-ids))))
(goto-char (point-min))
(while (re-search-forward "^:ID:\\s-+\\(\\S-+\\)" nil t)
(push (match-string 1) org-ids))))
org-ids))
(defun my/check-orphaned-org-ids-in-directory (dir)
"Find the difference between org-ids obtained by `my-list-org-ids-in-directory'
and org-ids obtained by `my-list-org-id-links-in-directory'.
DIRECTORY is the directory where the org files are located."
(interactive "DDirectory: ")
(let ((org-ids (my-list-org-ids-in-directory dir))
(id-links (my-list-org-id-links-in-directory dir)))
(let ((not-linked (cl-set-difference org-ids id-links :test #'string=))
(invalid-links (cl-set-difference id-links org-ids :test #'string=)))
(message "%d not-linked org-ids: %s"
(length not-linked)
(format "%s" not-linked))
(message "%d invalid org-id links: %s"
(length invalid-links)
(format "%s" invalid-links)))))
;; END: my/check-orphaned-org-ids-in-directory }}
(defun my-remove-file-suffix (filename)
"Remove the file suffix from FILENAME."
(if (string-match "\\(.*\\)\\..*" filename)
(match-string 1 filename)
filename))
;; (my-remove-file-suffix "abc.txt")
;; (file-name-nondirectory "/temp/abc.txt")
(defun my-monitor-file-and-copy-to-register (file-path register-name x-seconds)
"Monitor the specified file for changes and copy its content to a specified register.
Example usage:
(my-monitor-file-and-copy-to-register \"c:/x-clipboard.txt\" ?a 1)
Version: 2023
Updated: 2024-04-24"
(let ((previous-contents-alist ()))
(defun my-file-monitor-task ()
(let* ((base-filename
(my-remove-file-suffix (file-name-nondirectory file-path)))
(current-contents (when (file-readable-p file-path)
(with-temp-buffer
(insert-file-contents file-path)
(buffer-string))))
(previous-contents (assoc base-filename previous-contents-alist)))
(unless (equal current-contents (cdr previous-contents))
(set-register register-name current-contents)
(setq previous-contents-alist
(cons
(cons base-filename current-contents)
(delq
(assoc base-filename previous-contents-alist)
previous-contents-alist)
)))))
(let ((task-name (concat "my-file-monitor-task_from-"
(my-remove-file-suffix (file-name-nondirectory file-path))
"-to-"
(string register-name))))
(fset (intern task-name) #'my-file-monitor-task)
(my-schedule-task-every-x-secs x-seconds (intern task-name)))))
;; Example usage:
;; (my-monitor-file-and-copy-to-register "c:/x-clipboard.txt" ?a 1)
;; (my-monitor-file-and-copy-to-register "c:/emacs-clipboard.txt" ?b 1)
;; Testing:
;; (get-register ?a)
;; (get-register ?b)
;; (w32-set-clipboard-data "Your content goes here")
(defun my-monitor-file-and-copy-to-w32-clipboard (file-path x-seconds)
"Monitor the specified file for changes and copy its content to Windows clipboard.
Example usage:
(my-monitor-file-and-copy-to-w32-clipboard \"c:/emacs-clipboard.txt\" 1)
Version: 2023
Updated: 2024-04-24"
(if *is-win*
(let ((previous-contents-alist ()))
(defun my-w32-file-monitor-task ()
(let* ((base-filename
(my-remove-file-suffix (file-name-nondirectory file-path)))
(current-contents (when (file-readable-p file-path)
(with-temp-buffer
(insert-file-contents file-path)
(buffer-string))))
(previous-contents (assoc base-filename previous-contents-alist)))
(unless (equal current-contents (cdr previous-contents))
(w32-set-clipboard-data current-contents)
(setq previous-contents-alist
(cons
(cons base-filename current-contents)
(delq
(assoc base-filename previous-contents-alist)
previous-contents-alist)
)))))
(let ((task-name (concat "my-w32-file-monitor-task_from-"
(my-remove-file-suffix (file-name-nondirectory file-path))
"-to-w32-clipboard")))
(fset (intern task-name) #'my-w32-file-monitor-task)
(my-schedule-task-every-x-secs x-seconds (intern task-name))))
(message "Only Windows system is supported.")))
;; (my-monitor-file-and-copy-to-w32-clipboard "c:/emacs-clipboard.txt" 1)
(defun my/org-list-entries-without-id-property ()
"List all entries in the current buffer that don't have an ID property."
(interactive)
(with-output-to-temp-buffer "*Org Entries Without ID*"
(let ((results nil))
(org-map-entries
(lambda ()
(unless (org-id-get)
(push (format "** LINE #%d:\n%s"
(line-number-at-pos)
(buffer-substring-no-properties
(line-beginning-position)
(line-end-position)))
results)))
nil nil t)
(princ (concat "#+TITLE: Org Entries Without ID\n\n"))
(princ (concat "#+OPTIONS: toc:nil\n\n"))
(princ (concat "* Entries without ID\n\n"))
(dolist (result (nreverse results))
(princ (concat result "\n\n")))))
(with-current-buffer "*Org Entries Without ID*"
(org-mode)))
(defun my/list-packages-and-versions ()
(interactive)
(package-initialize)
(let ((pkgs (mapcar 'car package-alist)))
(dolist (pkg pkgs)
(message "%s - %s"
pkg (package-desc-version (cadr (assq pkg package-alist)))))))
(defun my/copy-org-id-at-point ()
"Copy the ID property of the heading at point to the kill-ring."
(interactive)
(let ((id (org-entry-get nil "ID")))
(when id
(kill-new id)
(message "Copied ID: %s" id))))
(defun my-get-heading-from-org-id-db (org-id)
"Retrieve the heading title associated with an Org ID from the
current buffer's Org mode database."
(org-with-point-at (org-id-find org-id 'marker)
(org-get-heading)))
(defun my/insert-org-id-from-kill-ring ()
"Insert a link to an Org ID from the kill-ring with a user-defined description.
The user is prompted to enter a description for the link.
If description is empty, retrieve the heading from the org-id
database using `my-get-heading-from-org-id-db` function."
(interactive)
(let ((id (current-kill 0)))
(when id
(let* ((org-id (replace-regexp-in-string "^id:" "" id))
(description (read-string "Description: " nil 'my-history)))
(if (string-empty-p description)
(setq description (my-get-heading-from-org-id-db org-id)))
(org-insert-link nil (concat "id:" org-id) description)))))
(defun my/link-selected-text-with-org-id-from-kill-ring ()
"Create an Org-mode link using the selected text and an Org ID from the kill ring.
Version 2023-04-28
The selected text is replaced with,
[[id:<Org ID unique identifier>][<selected text>]].
Usage: Select the text that you want to link to an Org ID, then
run `M-x my/link-selected-text-with-org-id-from-kill-ring`. The
function will take the Org ID from the kill ring, and create an
Org-mode link with the selected text and the Org ID. The link
will be inserted at the cursor position, replacing the selected
text."
(interactive)
(let* ((org-id (substring-no-properties (current-kill 0)))
(text (buffer-substring-no-properties (region-beginning) (region-end)))
(link (concat "[[id:" org-id "][" text "]]")))
(delete-region (region-beginning) (region-end))
(insert link)))
(defun my-parse-link-id (link)
"Parse the ID from an org-mode link of the form `id:xxxxxxxxxxxx'."
(when (string-match "id:\\(.+\\)" link)
(match-string 1 link)))
(defun my/org-link-goto-at-point ()
"Check if link at point is a file link or an ID link, and jump to
the appropriate location."
(interactive)
(if-let ((link (org-element-property :raw-link (org-element-context))))
(cond ((string-prefix-p "file:" link)
(org-open-at-point))
((string-prefix-p "id:" link)
(org-id-goto (my-parse-link-id link))))
(message "No link at point.")))
(defun my/switch-opened-org-files-to-org-mode ()
"Switch all open buffers that end with .org to org-mode,
skipping buffers that are already in org-mode.
Version 2023-05-06"
;; See, https://stackoverflow.com/a/76187210/4274775
(interactive)
(dolist (buffer (buffer-list))
(with-current-buffer buffer
(when (and (buffer-file-name)
(string= (file-name-extension (buffer-file-name)) "org")
(not (eq major-mode 'org-mode)))
(org-mode)
(message "Switched %s to org-mode." (buffer-name))))))
(defun my/strikethrough-current-line ()
"Strikethrough the current line using +<striked text>+"
(interactive)
(back-to-indentation)
(insert "+")
(move-end-of-line nil)
;; skips over any consecutive space or tab characters immediately before the
;; end of the line, effectively moving the cursor to the last non-blank
;; character on the line, rather than after any trailing whitespace. see,
(skip-chars-backward " \t")
(insert "+"))
(defun my/readonly-files ()
"Check for a '.readonly' file in the directory of the current
buffer, and set the read-only status of any listed buffers. The
'.readonly' file should contain a list of buffer names, one per
line, that should be set to read-only. Any buffers not listed in
the file will remain unaffected.
Version 2023-05-04
This function is intended to be used as a hook to automatically
set the read-only status of buffers when they are opened or
saved, based on the contents of the '.readonly' file. To use this
function as a hook, add it to the appropriate hook list, such as
'find-file-hook', 'after-save-hook' or 'switch-buffer-hook'."
;; (add-hook 'find-file-hook 'my/readonly-files)
;; (add-hook 'after-save-hook 'my/readonly-files)
;; (add-hook 'switch-buffer-hook 'my/readonly-files)
(interactive)
(let ((readonly-file (concat (file-name-directory (buffer-file-name)) ".readonly")))
(when (file-exists-p readonly-file)
(let ((readonly-bufs (split-string (with-temp-buffer
(insert-file-contents readonly-file)
(buffer-string))
"\n" t)))
(message "read-only files list: %s" readonly-bufs)
(dolist (buf readonly-bufs)
(message "%s is read-only now" buf)
(let ((buf (find-buffer-visiting buf)))
(when buf
(with-current-buffer buf
(toggle-read-only t)))))))))
(defun my/revert-all-file-buffers ()
"Refresh all open file buffers without confirmation.
Buffers in modified (not yet saved) state in emacs will not be reverted. They
will be reverted though if they were modified outside emacs.
Buffers visiting files which do not exist any more or are no longer readable
will be killed."
;; via https://emacs.stackexchange.com/a/24461/29715
(interactive)
(dolist (buf (buffer-list))
(let ((filename (buffer-file-name buf)))
;; Revert only buffers containing files, which are not modified;
;; do not try to revert non-file buffers like *Messages*.
(when (and filename
(not (buffer-modified-p buf)))
(if (file-readable-p filename)
;; If the file exists and is readable, revert the buffer.
(with-current-buffer buf
(revert-buffer :ignore-auto :noconfirm :preserve-modes))
;; Otherwise, kill the buffer.
(let (kill-buffer-query-functions) ; No query done when killing buffer
(kill-buffer buf)
(message "Killed non-existing/unreadable file buffer: %s" filename))))))
(message "Finished reverting buffers containing unmodified files."))
;; via https://emacs.stackexchange.com/questions/13080/reloading-directory-local-variables
(defun my/reload-dir-locals-for-current-buffer ()
"Reload dir locals for the current buffer"
"reload dir locals for the current buffer"
(interactive)
(let ((enable-local-variables :all))
(hack-dir-local-variables-non-file-buffer)))
@ -193,7 +387,7 @@ current buffer's, reload dir-locals."
nil t))))
(defun eh-org-clean-space (text backend info)
"Remove the space between chinese characters during exporting
"remove the space between chinese characters during exporting
to HTML files."
;; https://github.com/hick/emacs-chinese#%E4%B8%AD%E6%96%87%E6%96%AD%E8%A1%8C
(when (org-export-derived-backend-p backend 'html)
@ -221,15 +415,163 @@ to HTML files."
(add-to-list 'org-export-filter-paragraph-functions 'eh-org-clean-space)
)
(defun my/create-TAGS (&optional sudo dir-name tag-relative)
"Create a TAGS file with absolute or relative paths recorded inside. With a
prefix argument SUDO, run the command with sudo privilege. With a prefix
argument TAG-RELATIVE, create the TAGS file with relative paths recorded inside.
When called interactively, prompt the user for the directory name to create the
TAGS file. If no input is given, use the current working directory.
The `ctags` command is executed with the `--tag-relative` option set to `yes` if
the `tag-relative` prefix argument is set to 'y', or 'never' otherwise. The `*`
wildcard is included in the `ctags` command to create TAGS for all files in the
directory.
Example usage:
- To create a TAGS file for the current directory:
M-x my/create-TAGS RET RET
- To create a TAGS file for a specific directory with relative paths recorded:
M-x my/create-TAGS RET /path/to/directory RET y RET
- To create a TAGS file for a specific directory with absolute paths recorded,
using sudo privilege:
C-u M-x my/create-TAGS RET /path/to/directory RET RET"
;; This function is improved by ChatGPT and Claude :)
(interactive "P\nDEnter the directory to create TAGS file: \nMCreate TAGS file with relative paths (y/n): ")
(let* ((target-dir (if (string= "" dir-name)
default-directory
(expand-file-name dir-name)))
;; if the tags file has relative path then make tags-path nil
;; if absolute path, then prompt for entering the path
(default-tags-with-abs-path (expand-file-name "TAGS_ABS-PATH" target-dir))
(tags-path (if (string= tag-relative 'y)
nil
(read-file-name
"Enter the path to the tags file (with absolute path:) "
nil nil nil default-tags-with-abs-path)))
(ctags-cmd (format "cd %s && ctags --options=%s -e -R --tag-relative=%s -f %s *"
target-dir
(expand-file-name ".ctags" user-emacs-directory)
(if (string-equal tag-relative 'y) "yes" "never")
;; if tags-path is non-nil, it will use that value
;; as the result. if tags-path is nil, it will
;; evaluate the expression (expand-file-name "tags"
;; target-dir) and use the result of that evaluation
;; as the final result.
(or tags-path (expand-file-name "TAGS" target-dir)))))
(let ((command (if sudo
(concat "sudo sh -c '"
ctags-cmd
"'")
ctags-cmd)))
(start-process-shell-command "create TAGS" nil command))))
(defun my/find-tags-file ()
"recursively searches each parent directory for a file named
'TAGS' and returns the path to that file or nil if a tags file is
not found. Returns nil if the buffer is not visiting a file"
(progn
(defun find-tags-file-r (path)
"find the tags file from the parent directories"
(let* ((parent (file-name-directory path))
(possible-tags-file (concat parent "TAGS")))
(cond
((file-exists-p possible-tags-file)
(throw 'found-it possible-tags-file))
((string= "/TAGS" possible-tags-file)
(error "no tags file found"))
(t (find-tags-file-r (directory-file-name parent))))))
(if (buffer-file-name)
(catch 'found-it
(find-tags-file-r (buffer-file-name)))
(error "buffer is not visiting a file"))))
(defun my/file ()
"prompt user to enter a file name, with completion and history
support."
;; http://xahlee.info/emacs/emacs/elisp_idioms_prompting_input.html
(interactive)
(setq my-file-value (read-file-name "Input file name: "))
(message "my-file-value is %s" my-file-value)
)
;; { START: config for counsel-etags and company-ctags
;; <<config-ce-cc>>
(defun my-tags-file (&optional select)
"If SELECT is non-nil, set the value of `my-tags-file` to the user-selected file path
after prompting for it through `my/file`.
Otherwise, set `my-tags-file` to the value returned by `my/find-tags-file`.
-- generated by ChatGPT :)"
(if select
(progn (my/file)
(setq my-tags-file my-file-value))
(setq my-tags-file (my/find-tags-file)))
)
(defun my-set-extra-tags-files (my-tags-table-list)
(setq counsel-etags-extra-tags-files my-tags-table-list)
(setq company-ctags-extra-tags-files my-tags-table-list)
(message "tags-table list for counsel-etags/company-ctags:\n%s\n\nNote:
files in counsel-etags-extra-tags-files should have symbols with
absolute path only." my-tags-table-list)
)
(defun my/insert-into-my-tags-table-list(&optional select)
"automatically insert the TAGS file or select TAGS file to
insert(C-u), into `my-tags-table-list',
`counsel-etags-extra-tags-files' and
`company-ctags-extra-tags-files'."
(interactive "P")
(unless (boundp 'my-tags-table-list)
;; if `my-tags-table-list' is void, then set it to empty list
(setq my-tags-table-list '()))
(setq existing-my-tags-table-list my-tags-table-list)
(setq my-tags-table-list '()) ; initiate empty list
(my-tags-file select)
(setq my-tags-table-list
(delq nil (delete-dups ; delete nil and duplicates
(cons (symbol-value 'my-tags-file)
(symbol-value 'existing-my-tags-table-list)))))
(my-set-extra-tags-files my-tags-table-list)
)
(defun my/delete-from-my-tags-table-list (&optional select)
"automatically delete the TAGS file or select TAGS file to
delete(C-u), from `my-tags-table-list',
`counsel-etags-extra-tags-files' and
`company-ctags-extra-tags-files'."
(interactive "P")
(my-tags-file select)
(setq my-tags-table-list
(delete (symbol-value 'my-tags-file) my-tags-table-list))
(my-set-extra-tags-files my-tags-table-list)
)
;; keybinding -> [[./init-keybindings.el::m-ftf]]
(defun my/set-tags-table-list (&optional del)
"calls `my/find-tags-file' to recursively search up the directory
tree to find a file named 'TAGS'. If found, add/delete(C-u) it
to/from 'counsel-etags-extra-tags-files' and
'company-ctags-extra-tags-files'."
(interactive "P")
(if del (my/delete-from-my-tags-table-list)
(my/insert-into-my-tags-table-list))
)
(defun my/tags-table-list ()
"check and display my tags-table list through message."
(interactive)
(message "tags-table list for counsel-etags/company-ctags:\n%s\n\nNote:
files in counsel-etags-extra-tags-files should have symbols with
absolute path only." my-tags-table-list)
)
;; END: config for counsel-etags and company-ctags }
(provide 'init-misc)

86
lisp/init-org.el
View File

@ -3,6 +3,22 @@
;;; Code:
(when (not (file-directory-p org-directory))
(if noninteractive
(message "The org-directory is not defined, will set it to .emacs.d folder to avoid 'No such file org directory' warning.")
(read-string "The org-directory is not defined, will set it to .emacs.d folder to avoid 'No such file org directory' warning. Press ENTER to continue."))
;; [[./init-org.el::od-1]]
;; [[./init-org.el::od-2]]
(setq org-directory (symbol-value 'user-emacs-directory))
)
(when (not (boundp 'org-mobile-directory))
(if noninteractive
(message "The org-mobile-directory is not defined, will set it to .emacs.d folder to avoid void-variable error.")
(read-string "The org-mobile-directory is not defined, will set it to .emacs.d folder to avoid void-variable error. Press ENTER to continue."))
;; [[./init-org.el::omd]]
(setq org-mobile-directory (symbol-value 'user-emacs-directory))
)
(setq org-startup-indented t) ; enable org-indent mode
(setq org-log-done 'time) ; keep track of when a certain TODO item was marked as
@ -10,8 +26,6 @@
(setq org-log-done 'note) ; record a note along with the timestamp
(setq org-log-into-drawer t) ; log into LOGBOOK drawer
(setq org-src-fontify-natively t) ; highlight the code in Org-mode
;; { START: temp WA to fix bug #52587
@ -57,24 +71,23 @@
(setq org-todo-keywords
;; '((sequence "☛ TODO(t)" "➼ IN-PROGRESS" "⚑ WAIT(w@/!)" "|" "✔ DONE(d!)" "✘ CANCELED(c@)")
'((sequence "TODO(t)" "IN-PROGRESS" "WAIT(w@/!)" "|" "DONE(d!)" "CANCELED(c@)" "CLOSED")
'((sequence "TODO(t)" "IN-PROGRESS" "WAIT(w@/!)" "|" "DONE(d!)" "CANCELED(c@)")
(sequence "REPORT(r)" "BUG(b)" "KNOWNCAUSE(k)" "IMPROVEMENT(m)" "ENHANCEMENT(e)" "FEATURE(a)" "|" "FIXED(f)")
))
(setf org-todo-keyword-faces '(
("CANCELED" . (:foreground "white" :background "#95A5A6"))
("DONE" . (:foreground "white" :background "#2E8B57"))
("CLOSED" . (:foreground "white" :background "#2E8B57"))
("WAIT" . (:foreground "white" :background "#F9BC41"))
("IN-PROGRESS" . (:foreground "white" :background "#3498DB"))
("TODO" . (:foreground "white" :background "#5F87FF"))
("REPORT" (:foreground "#C0C0C0" :background "#308014" :box (:line-width (-1 . -1))))
("BUG" (:foreground "#E6DB74" :background "black" :box (:line-width (-1 . -1))))
("KNOWNCAUSE" (:foreground "#9C91E4" :background "black" :box (:line-width (-1 . -1))))
("IMPROVEMENT" (:foreground "#FF9900" :background "black" :box (:line-width (-1 . -1))))
("ENHANCEMENT" (:foreground "#9900ff" :background "black" :box (:line-width (-1 . -1))))
("FEATURE" (:foreground "#38761d" :background "black" :box (:line-width (-1 . -1))))
("FIXED" (:foreground "#4B5556" :strike-through t :box (:line-width (-1 . -1))))
("REPORT" (:foreground "#C0C0C0" :background "#308014" :box t))
("BUG" (:foreground "#E6DB74" :background "black" :box t))
("KNOWNCAUSE" (:foreground "#9C91E4" :background "black" :box t))
("IMPROVEMENT" (:foreground "#FF9900" :background "black" :box t))
("ENHANCEMENT" (:foreground "#9900ff" :background "black" :box t))
("FEATURE" (:foreground "#38761d" :background "black" :box t))
("FIXED" (:foreground "#4B5556" :strike-through t :box t))
))
(defun my/modify-org-done-face (&optional disable)
@ -152,27 +165,26 @@
org-agenda-time-grid
'((daily today require-timed)
(800 1000 1200 1400 1600 1800 2000)
" ..... "
"---------------")
" ┄┄┄┄┄ " "┄┄┄┄┄┄┄┄┄┄┄┄┄┄┄")
org-agenda-current-time-string
"<- now -------------------------------------------------"
"⭠ now ─────────────────────────────────────────────────"
)
(add-hook 'org-agenda-finalize-hook 'place-agenda-tags)
(defun place-agenda-tags ()
"Put the agenda tags by the right border of the agenda window."
;; http://lists.gnu.org/archive/html/emacs-orgmode//2010-12/msg00410.html
(setq org-agenda-tags-column (- 10 (window-width)))
(org-agenda-align-tags)
)
(add-hook 'org-agenda-finalize-hook 'place-agenda-tags)
;; { -- BEGIN -- org-agenda custom commands
;; https://www.reddit.com/r/orgmode/comments/6ybjjw/aligned_agenda_view_anyway_to_make_this_more/
(setq org-agenda-prefix-format ; the display format
;; http://doc.endlessparentheses.com/Var/org-agenda-prefix-format.html
(quote
((agenda . "%5e %27s %12t")
;; (timeline . " % s")
((agenda . "%5e %12s %12t")
(timeline . " % s")
(todo . " %12t")
(tags . " %12t")
(search . " %12t"))
@ -191,15 +203,10 @@
;; teach Org where to look for all of the files you wish to include in your agenda
;; https://stackoverflow.com/a/41969519/4274775
(when (and (file-directory-p org-directory) (not (string= org-directory "")))
(setq org-agenda-files
(directory-files-recursively org-directory "\\.org$")))
(setq org-agenda-files
(directory-files-recursively org-directory "\\.org$")) ; <<od-1>>
;; (length org-agenda-files)
;; fix issue like below,
;; Non-existent agenda file /path/to/.#xxx.org. [R]emove from list or [A]bort?
(setq org-agenda-skip-unavailable-files t)
;; how to truncate the long task name in the agenda custom view?
;; https://stackoverflow.com/a/16285673/4274775
(defun my-org-agenda-mode-hook ()
@ -208,37 +215,17 @@
(add-hook 'org-agenda-mode-hook
'my-org-agenda-mode-hook)
(defun my-normalized-paths-list (file-paths-list)
"Normalize a list of file paths and remove duplicates.
Version: 2023/09/27"
(let ((normalized-paths (mapcar (lambda (path) (expand-file-name path)) file-paths-list)))
(delete-duplicates normalized-paths :test 'string=)))
;; Example usage:
;; (setq org-agenda-files-list '("~/abc.org" "/Users/jason/abc.org" "~/xyz.org"))
;; (setq normalized-list (my-normalized-paths-list org-agenda-files-list))
(add-hook 'org-agenda-mode-hook (lambda ()
;; https://orgmode.org/list/loom.20111014T204701-149@post.gmane.org/
(setq org-agenda-files
(delete-dups (append org-agenda-files
(when (and org-directory (not (string= org-directory "")))
(directory-files-recursively org-directory "\\.org$")))))
;; <<od-2>>
(directory-files-recursively org-directory "\\.org$"))))
(setq org-agenda-files
(delete-dups
(append org-agenda-files
(when (and org-mobile-directory (not (string= org-mobile-directory "")))
(directory-files-recursively org-mobile-directory "\\.org$")))))
;; remove the duplicates like below,
;; ("~/abc.org" "/Users/jason/abc.org")
(setq org-agenda-files (my-normalized-paths-list org-agenda-files))
(directory-files-recursively org-mobile-directory "\\.org$")))) ; <<omd>>
;; { -- START --
;; <<4osa-start>> | the link anchor to the end: [[./init-org.el::4osa-end]]
@ -340,11 +327,6 @@ Version: 2023/09/27"
))
(use-package org-task-scheduler
:straight (:host github :repo "jsntn/org-task-scheduler.el"))
(provide 'init-org)
;; Local Variables:

418
lisp/init-packages.el
View File

@ -11,6 +11,12 @@
;; reference
;; https://github.com/domtronn/all-the-icons.el/issues/120
(when (display-graphic-p) ; if not in terminal Emacs
;; if on Windows and all-the-icons is not installed
(when (equal system-type 'windows-nt)
(unless (member "all-the-icons" (font-family-list))
(yes-or-no-p "The 'all-the-icons' fonts are recommended for this configuration with lsp-mode package. Continue and install it later?")
)
)
;; if not on Windows and all-the-icons is not installed
(unless (equal system-type 'windows-nt)
(unless (member "all-the-icons" (font-family-list))
@ -30,15 +36,62 @@
;; jump to Chinese character by pinyin with `avy' or `ace-jump-mode'
(use-package ace-pinyin
:delight
:config
(setq ace-pinyin-use-avy nil) ; use `ace-jump-mode'
(ace-pinyin-global-mode +1)
)
(use-package annotate)
(use-package annotate
:config
(custom-set-faces
'(annotate-annotation ((t (:background "#ff7f4f" :foreground "white"))))
'(annotate-annotation-secondary ((t (:background "#ff7f4f" :foreground "white"))))
'(annotate-highlight ((t (:underline "white"))))
'(annotate-highlight-secondary ((t (:underline "white"))))
)
;; { START: my-annotate-mode-hook
(defun my-set-default-annotation-file (annotate-mode-status)
"set my default annotation-file, which is used in case the
`.annotations' in the directory of the current buffer does not
exist."
(interactive)
(setq annotate-file
(expand-file-name ".annotations" user-emacs-directory))
(when (eq annotate-mode-status 'on)
(annotate-load-annotations))
(message "annotate-mode is %s, and the annotate-file is set to %s.annotations"
annotate-mode-status user-emacs-directory)
)
(defun my-annotate-mode-hook ()
"my annotate-mode hook to check if `.annotations' exists in the
directory of the current buffer then use it as the
`annotate-file', otherwise call the
`my-set-default-annotate-file'."
(interactive)
(if (bound-and-true-p annotate-mode); if annotate-mode is on
(if (file-exists-p ".annotations") ; if .annotations file exists
(progn (setq-local annotate-file ".annotations")
(annotate-load-annotations)
(message "annotate-mode is on, and the annotate-file is %s.annotations"
(file-name-directory (buffer-file-name))))
(my-set-default-annotation-file 'on) ; if .annotations file does not exist
)
(my-set-default-annotation-file 'off) ; if annotate-mode is off
))
(add-hook 'annotate-mode-hook 'my-annotate-mode-hook)
;; END: my-annotate-mode-hook }
)
(use-package auto-capitalize
:straight (:host github :repo "yuutayamada/auto-capitalize-el")
:config
(setq auto-capitalize-words `("I" "English"))
;; this configuration adds capitalized words of .aspell.en.pws
(setq auto-capitalize-aspell-file (expand-file-name "misc/aspell.en.pws" user-emacs-directory))
(auto-capitalize-setup)
;; (add-hook 'after-change-major-mode-hook 'auto-capitalize-mode)
:hook (org-mode . auto-capitalize-mode)
)
(use-package benchmark-init
:config
@ -59,17 +112,151 @@
)
)
(use-package cnfonts
:if window-system ; only load this package when in graphical Emacs
:config
(cnfonts-mode 1)
(setq cnfonts-profiles
'("program" "org-mode" "read-book"))
(setq cnfonts-use-system-type t) ; save profile config across different system-type
)
(use-package company
:init
(global-company-mode)
:config
(setq company-idle-delay 0.2)
;; number the candidates (use M-1, M-2 etc to select completions).
(setq company-show-numbers t)
;; show suggestions after entering 3 character.
(setq company-minimum-prefix-length 3)
;; when the list of suggestions is shown, and you go through the list of
;; suggestions and reach the end of the list, the end of the list of
;; suggestions does not wrap around to the top of the list again. This is a
;; minor inconvenience that can be solved:
(setq company-selection-wrap-around t)
;; use tab key to cycle through suggestions.
;; ('tng' means 'tab and go')
(company-tng-configure-default)
;; { START: company-candidates from abo-abo
;; if candidate list was ("var0" "var1" "var2"), then entering 1 means:
;; select the first candidate (i.e. "var0"), instead of:
;; insert "1", resulting in "var1", i.e. the second candidate
;; via,
;; - https://oremacs.com/2017/12/27/company-numbers/
(defun ora-company-number ()
"Forward to `company-complete-number'.
Unless the number is potentially part of the candidate.
In that case, insert the number."
;; via https://github.com/abo-abo/oremacs/blob/d217e22a3b8dc88d10f715b32a7d1facf1f7ae18/modes/ora-company.el#L22-L39
(interactive)
(let* ((k (this-command-keys))
(re (concat "^" company-prefix k)))
(if (or (cl-find-if (lambda (s) (string-match re s))
company-candidates)
(> (string-to-number k)
(length company-candidates))
(looking-back "[0-9]+\\.[0-9]*" (line-beginning-position)))
(self-insert-command 1)
(company-complete-number
(if (equal k "0")
10
(string-to-number k))))))
(let ((map company-active-map))
;; via https://github.com/abo-abo/oremacs/blob/d217e22a3b8dc88d10f715b32a7d1facf1f7ae18/modes/ora-company.el#L46-L53
(mapc (lambda (x) (define-key map (format "%d" x) 'ora-company-number))
(number-sequence 0 9))
(define-key map " " (lambda ()
(interactive)
(company-abort)
(self-insert-command 1)))
(define-key map (kbd "<return>") nil))
;; END: company-candidates from abo-abo }
)
(use-package company-ctags
:config
(with-eval-after-load 'company
(company-ctags-auto-setup))
;; my config -> [[./init-misc.el::config-ce-cc]]
)
(use-package company-english-helper
:straight (:host github :repo "manateelazycat/company-english-helper")
)
(use-package counsel)
;; { START: counsel-etags
(unless (executable-find "ctags")
(when (eq system-type 'darwin)
(shell-command "brew install universal-ctags"))
(when (string= (which-linux-release-info "distributor") "Ubuntu")
(call-process "/bin/bash"
(expand-file-name "scripts/ctags.sh" user-emacs-directory)))
(yes-or-no-p "Please be informed the ctags is started to install in the background...
The installation result can be checked later manually with ctags command. Continue?")
)
(use-package counsel-etags
;; ctags should be installed first, the Universal Ctags is recommended,
;; https://github.com/universal-ctags/ctags
;; with Exuberant Ctags or Universal Ctags, this package works out of box.
;; instructions,
;; `counsel-etags-scan-code' to create tags file
;; `counsel-etags-find-tag-at-point' to navigate. This command will also
;; run `counsel-etags-scan-code' AUTOMATICALLY if tags file does not exist.
;; it also calls `counsel-etags-fallback-grep-function' if no tag is found.
;; keybinding -> [[./init-keybindings.el::ftap]]
(use-package eglot)
;; update the TAGS file automatically on file saves
:init
(add-hook 'prog-mode-hook
(lambda ()
(add-hook 'after-save-hook
'counsel-etags-virtual-update-tags 'append 'local)))
:config
(setq counsel-etags-update-interval 60)
(push "build" counsel-etags-ignore-directories)
;; create TAGS with the absolute recorded file paths
(setq counsel-etags-update-tags-backend
(lambda (src-dir)
(shell-command
;; relative path is used by default by ctags
;; relative path is more portable and uses less memory (this package
;; reads the tags file's content into memory)
;; https://github.com/redguardtoo/counsel-etags/pull/88
(format "ctags --options=%s -e -R"
(expand-file-name ".ctags" user-emacs-directory)))))
;; my config -> [[./init-misc.el::config-ce-cc]]
)
(when (or (eq system-type 'darwin) (eq system-type 'windows-nt))
(unless (executable-find "ctags")
(yes-or-no-p "Please be informed the ctags is used in this configuration file, but the executable file is not found.
You need to install it manually. Continue?")
))
;; END: counsel-etags }
(use-package doom-themes
:config
;; global settings (defaults)
(setq doom-themes-enable-bold t) ; if nil, bold is universally disabled
;; corrects (and improves) org-mode's native fontification
;; (doom-themes-org-config) ; disable this as it is not compatible with
; org-modern horizontal line, see,
; https://github.com/jsntn/emacs.d/issues/13
;; personal modified version of doom-monokai-classic
(add-to-list 'custom-theme-load-path (expand-file-name "themes/" user-emacs-directory))
(load-theme 'doom-monokai-classic t)
(set-background-color "black")
(custom-set-faces
`(mode-line ((t (:background ,(doom-color 'dark-violet)))))
`(font-lock-comment-face ((t (:foreground ,(doom-color 'base6))))))
)
;; M-x elgrep: search a single directory
;; C-u M-x elgrep: search the directory recursively
@ -89,7 +276,50 @@
;; (add-hook 'elpy-mode-hook 'flycheck-mode))
;; )
;; evil-collection assumes evil-want-keybinding is set to nil and
;; evil-want-integration is set to t before loading evil and evil-collection.
(setq evil-want-integration t)
(setq evil-want-keybinding nil)
(use-package evil
:init
(unless (display-graphic-p)
(setq evil-want-C-i-jump nil)
)
:after undo-tree
:config
(evil-set-undo-system 'undo-tree) ; https://github.com/emacs-evil/evil/issues/1372#issuecomment-712611291
(global-undo-tree-mode)
(evil-mode 1)
;; change the cursor color in terms of evil mode
(setq evil-emacs-state-cursor '("red" box))
(setq evil-normal-state-cursor '("green" box))
(setq evil-visual-state-cursor '("orange" box))
(setq evil-insert-state-cursor '("red" bar))
(setq evil-replace-state-cursor '("red" bar))
(setq evil-operator-state-cursor '("red" hollow))
)
(use-package evil-collection
:after evil
:config
(evil-collection-init)
)
(use-package evil-leader
:init
(global-evil-leader-mode)
)
(use-package evil-surround
:config
(global-evil-surround-mode 1)
)
(use-package evil-visualstar
:config
(global-evil-visualstar-mode)
)
(when (memq window-system '(mac ns))
(use-package exec-path-from-shell
@ -106,8 +336,7 @@
(use-package git-messenger)
(use-package git-timemachine)
(use-package helm)
;; { -- START --
;; use helm-dash and language-detection
@ -211,7 +440,6 @@
)
(use-package highlight-parentheses
:delight
:config
(add-hook 'prog-mode-hook 'highlight-parentheses-mode)
(setq highlight-parentheses-colors
@ -221,7 +449,6 @@
;; automatic and manual symbol highlighting
;; cycle through the locations of any symbol at point
(use-package highlight-symbol
:delight
:config
(add-hook 'prog-mode-hook 'highlight-symbol-mode)
(add-hook 'prog-mode-hook 'highlight-symbol-nav-mode)
@ -235,39 +462,26 @@
(setq hl-todo-highlight-punctuation ":"
hl-todo-keyword-faces
`(
;; align with the org-todo-keyword-faces
("TODO" :foreground "white" :background "#5F87FF")
("DONE" :foreground "white" :background "#2E8B57")
("CLOSED" :foreground "white" :background "#2E8B57")
("CANCELED" :foreground "white" :background "#95A5A6")
("WAIT" :foreground "white" :background "#F9BC41")
("IN-PROGRESS" :foreground "white" :background "#3498DB")
("REPORT" :foreground "#C0C0C0" :background "#308014" :box (:line-width (-1 . -1)))
("BUG" :foreground "#E6DB74" :background "black" :box (:line-width (-1 . -1)))
("KNOWNCAUSE" :foreground "#9C91E4" :background "black" :box (:line-width (-1 . -1)))
("IMPROVEMENT" :foreground "#FF9900" :background "black" :box (:line-width (-1 . -1)))
("ENHANCEMENT" :foreground "#9900ff" :background "black" :box (:line-width (-1 . -1)))
("FEATURE" :foreground "#38761d" :background "black" :box (:line-width (-1 . -1)))
("FIXED" :foreground "#4B5556" :strike-through t :box (:line-width (-1 . -1)))
;; my own highlight keywords
("FIXME" :foreground "white" :background "red")
("DEBUG" :foreground "#E6DB74" :background "black" :box (:line-width (-1 . -1)))
("HACK" :foreground "#9C91E4" :background "black" :box (:line-width (-1 . -1)))
("REVIEW" :foreground "#F02660" :background "black" :box (:line-width (-1 . -1)))
("NOTE" :foreground "#C0C0C0" :background "#308014" :box (:line-width (-1 . -1)))
("DEPRECATED" font-lock-doc-face :strike-through t :box (:line-width (-1 . -1)))
("FOLLOWUP" :foreground "white" :background "#808A87" :box (:line-width (-1 . -1)))
("ANSWER" :foreground "white" :background "#808A87" :box (:line-width (-1 . -1)))
("MARK" :foreground "black" :background "#FFFFFF" :box (:line-width (-1 . -1)))
("IMPROVEMENT" :foreground "white" :background "#FF9900" :box (:line-width (-1 . -1)))
("ENHANCEMENT" :foreground "white" :background "#9900FF" :box (:line-width (-1 . -1)))
("FEATURE" :foreground "white" :background "#38761d" :box (:line-width (-1 . -1)))
("DEBUG" :foreground "#E6DB74" :background "black" :box t)
("HACK" :foreground "#9C91E4" :background "black" :box t)
("REVIEW" :foreground "#F02660" :background "black" :box t)
("NOTE" :foreground "#C0C0C0" :background "#308014" :box t)
("DEPRECATED" font-lock-doc-face :strike-through t :box t)
("FOLLOWUP" :foreground "white" :background "#808A87" :box t)
("ANSWER" :foreground "white" :background "#808A87" :box t)
("MARK" :foreground "black" :background "#FFFFFF" :box t)
("IMPROVEMENT" :foreground "white" :background "#FF9900" :box t)
("ENHANCEMENT" :foreground "white" :background "#9900FF" :box t)
("FEATURE" :foreground "white" :background "#38761d" :box t)
("Linode" :foreground "white" :background "#999DF7")
("GitHub" :foreground "black" :background "#FFFFFF")
("via" :foreground "#5F87FF" :background "black" :box (:line-width (-1 . -1)))
("Via" :foreground "#5F87FF" :background "black" :box (:line-width (-1 . -1)))
("VIA" :foreground "#5F87FF" :background "black" :box (:line-width (-1 . -1)))
("Jason" :foreground "white" :background "#38761d" :box (:line-width (-1 . -1)))
("via" :foreground "#5F87FF" :background "black" :box t)
("Via" :foreground "#5F87FF" :background "black" :box t)
("VIA" :foreground "#5F87FF" :background "black" :box t)
("Jason" :foreground "white" :background "#38761d" :box t)
("ChatGPT" :foreground "white" :background "#19C37D")
)
)
@ -291,15 +505,24 @@
(setq keyfreq-file-lock (expand-file-name ".emacs.keyfreq.lock" user-emacs-directory))
)
(use-package marginalia
:init
(marginalia-mode)
(use-package lsp-mode
:config
(setq marginalia-field-width 9999999) ; maximize the width of marginalia field
(setq lsp-headerline-breadcrumb-enable nil)
:hook
(lsp-mode . lsp-enable-which-key-integration) ; which-key integration
)
(straight-use-package
'(mr-poker :type git :host github :repo "jsntn/mr-poker.el"))
(use-package lsp-pyright
:config
(my-check-for-executable "pyright" "pyright")
:hook (python-mode . (lambda ()
(require 'lsp-pyright)
(lsp)))) ; or lsp-deferred
(use-package lsp-ui
:config
(setq lsp-ui-doc-position 'top)
)
(use-package neotree
:config
@ -307,11 +530,6 @@
(setq neo-window-fixed-size nil)
)
(use-package orderless
:custom
(completion-styles '(orderless basic))
)
(use-package org-bullets
:config
(add-hook 'org-mode-hook (lambda () (org-bullets-mode 1)))
@ -323,7 +541,6 @@
;; make all agenda files with any archive files associated with them as the
;; source of items for drill sessions(scope)
(setq org-drill-scope 'agenda-with-archives)
(setq org-drill-leech-method "warn")
)
(use-package org-modern
@ -405,11 +622,13 @@
)
(use-package orglink
:delight
:config
(global-orglink-mode))
(use-package org-drill
:config
(setq org-drill-leech-method "warn")
)
(use-package ox-hugo
:after ox
@ -435,29 +654,23 @@
)
(use-package org-roam
;; :if window-system ; for graphical Emacs
:if window-system ; for graphical Emacs
:after emacsql-sqlite3
:config
(add-hook 'emacs-startup-hook #'my-activate-org-roam-db-autosync)
(org-roam-db-autosync-mode)
(setq org-roam-database-connector 'sqlite3)
(setq org-roam-mode-sections
(list #'org-roam-backlinks-section
#'org-roam-reflinks-section
;; ripgrep (rg) is used for unlinked references below - (executable-find "rg")
;; #'org-roam-unlinked-references-section
#'org-roam-unlinked-references-section
))
)
(defun my-activate-org-roam-db-autosync ()
"Activate `org-roam-db-autosync-mode` after a delay"
(run-with-idle-timer 7 nil 'org-roam-db-autosync-mode))
(my-check-for-executable "ripgrep (rg)" "rg")
;; END: Org-roam }
(use-package org-roam-ui
:delight
:if window-system ; for graphical Emacs
:after org-roam
:config
@ -619,28 +832,62 @@
(set-cursor-color "red"))))
)
(use-package smooth-scroll
:delight
:straight (:type git :host github :repo "k-talo/smooth-scroll.el")
(use-package pyvenv
:config
(smooth-scroll-mode t)
(global-set-key [next] #'smooth-scroll/scroll-up)
(global-set-key [prior] #'smooth-scroll/scroll-down)
;; (pyvenv-mode t)
;; set correct Python interpreter
(setq pyvenv-post-activate-hooks
(list (lambda ()
(if (equal system-type 'windows-nt)
(setq python-shell-interpreter (concat pyvenv-virtual-env "Scripts/python"))
(setq python-shell-interpreter (concat pyvenv-virtual-env "bin/python"))
)
)))
(setq pyvenv-post-deactivate-hooks
(list (lambda ()
(setq python-shell-interpreter "python")
)))
)
(use-package smooth-scrolling
;; START: reformatter config
(unless (executable-find "shfmt")
(when (eq system-type 'gnu/linux)
(shell-command "sudo snap install shfmt")
)
)
(use-package reformatter
:config
(smooth-scrolling-mode 1))
(reformatter-define css-yaml-format
:program "prettier"
:args (list "--write" buffer-file-name)
;; https://emacs.stackexchange.com/questions/24298/can-i-eval-a-value-in-quote
)
(reformatter-define sh-format
:program "shfmt"
:args (list "-l" "-w" "-i" "4" buffer-file-name)
;; 4 spaces as indent, read more https://github.com/mvdan/sh/blob/master/cmd/shfmt/shfmt.1.scd
;; https://emacs.stackexchange.com/questions/24298/can-i-eval-a-value-in-quote
)
)
(my-check-for-executable "Prettier" "prettier")
(my-check-for-executable "shfmt" "shfmt")
;; END: reformatter config
(use-package savehist
;; from https://emacs-china.org/t/emacs/17606/9
:hook (after-init . savehist-mode)
:init (setq enable-recursive-minibuffers t ; allow commands in minibuffers
history-length 1000
savehist-additional-variables '(mark-ring
global-mark-ring
search-ring
regexp-search-ring
extended-command-history)
savehist-autosave-interval 300)
)
(use-package super-save
:delight
:config
(super-save-mode +1)
(setq super-save-auto-save-when-idle t)
@ -652,8 +899,11 @@
;; { -- start: if emacs is running in a terminal
(unless (display-graphic-p)
(add-to-list 'package-archives
'("cselpa" . "https://elpa.thecybershadow.net/packages/"))
(use-package term-keys
:straight (:type git :host github :repo "CyberShadow/term-keys")
:config
(term-keys-mode t)
;; to configure alacritty for term-keys, use term-keys/alacritty-config to generate a alacritty.yml fragment:
@ -664,6 +914,20 @@
;; then, add the output to your main alacritty.yml file.
;; via https://github.com/CyberShadow/term-keys#alacritty
)
(setq package-archives (delete '("cselpa" . "https://elpa.thecybershadow.net/packages/") package-archives))
(defun term-keys-reminder-messages ()
(yes-or-no-p "term-keys is used to handle keyboard input involving any combination of keys and modifiers in emacs through supported terminal emulator(Alacritty is recommended on Windows), refer to term-keys README for configuration. Continue?")
)
(unless noninteractive
(if (boundp 'term-keys-reminder)
(when (symbol-value 'term-keys-reminder) (term-keys-reminder-messages))
(term-keys-reminder-messages)
)
)
)
;; -- end: if emacs is running in a terminal }
@ -674,10 +938,6 @@
(global-undo-tree-mode)
)
(use-package vertico
:init
(vertico-mode))
(use-package vlf
:config
(require 'vlf-setup)

167
lisp/init-pre.el
View File

@ -3,29 +3,6 @@
;;; Code:
;; pre settings: needed by other configurations
(defconst *is-mac* (eq system-type 'darwin))
(defconst *is-win* (eq system-type 'windows-nt))
(defconst *is-linux* (or (eq system-type 'gnu/linux) (eq system-type 'linux)) )
(defun my-require (feature)
"Custom require function to prevent recursive loading."
(unless (featurep feature)
(require feature)))
(defun my-require-maybe (feature &optional file)
"Try to require FEATURE, but don't signal an error if `require' fails."
(require feature file 'noerror))
(defun my-when-available (func foo)
"Do something if FUNCTION is available."
(when (fboundp func) (funcall foo)))
;; { -- START --
;; check Linux distribution
@ -57,67 +34,6 @@
(defun my/set-windows-paths (custom-paths-list)
"Set the PATH and exec-path in sync for Windows-NT system type
based on the given list of paths.
Version: 2023-09-27"
(when (eq system-type 'windows-nt)
(let ((xPaths custom-paths-list))
(setenv "PATH" (mapconcat 'identity xPaths ";"))
(setq exec-path (append xPaths (list "." exec-directory))))))
;; Example usage,
;; (setq my-windows-paths
;; `(
;; ,(format "%s%s%s" "C:/Users/" (symbol-value 'user-login-name) "/scoop/apps/nodejs/current/bin")
;; ,(format "%s%s%s" "C:/Users/" (symbol-value 'user-login-name) "/scoop/apps/nodejs/current")
;; ,(format "%s%s%s" "C:/Users/" (symbol-value 'user-login-name) "/scoop/shims")
;; "C:/Windows/System32/"
;; "C:/Windows/system32/WindowsPowerShell/v1.0/"
;; "C:/msys64/mingw64/bin/"
;; ,(symbol-value 'windows-portable-bin-directory)
;; ))
;; (my/set-windows-paths my-windows-paths)
;; (getenv "PATH")
;; Difference between exec-path and PATH
;; The value of environment variable "PATH" is used by emacs when you are trying
;; to call a linux command from a shell in emacs.
;; The exec-path is used by emacs itself to find programs it needs for its
;; features, such as spell checking, file compression, compiling, grep, diff,
;; etc.
;; The value of (getenv "PATH") and exec-path do not need to be the same.
;; http://xahlee.info/emacs/emacs/emacs_env_var_paths.html
(defun my/set-var (var &rest values)
"Set VAR based on the operating system using a list of
VALUES. VALUES should be a list of pairs where the car is the
operating system identifier ('win', 'mac', 'linux') and the cdr
is the value associated with that operating system.
Version: 2023-09-24
Updated: 2023-09-26"
(require 'cl-lib) ; to avoid the cl-loop void definition
(let* ((os (cond ((eq system-type 'windows-nt) 'win)
((eq system-type 'gnu/linux) 'linux)
((eq system-type 'darwin) 'mac)
(t (error "Unsupported operating system")))))
(cl-loop for (os-id . value) in values
when (eq os os-id)
do (set var (if (stringp value)
value
(eval value))))))
;; Example usage to set org-directory based on OS with my/set-var
;; (my/set-var 'org-directory
;; '(win . "c:/org-directory")
;; '(mac . "~/org-directory")
;; '(linux . "~/org-directory"))
;; (symbol-value 'org-directory)
(defun my-check-for-executable (executable-name executable-file &optional message)
"Check if the given EXECUTABLE-FILE is available. If it's not found,
prompt the user with the optional MESSAGE (or a default message) to install it."
@ -131,7 +47,7 @@ but the %s executable file is not found. You need to install it manually."
(unless (executable-find executable-file)
(if noninteractive
(message noninteractive-msg)
(when (string= (read-string prompt-msg) "")
(unless (string= (read-string prompt-msg) "")
(message "Continuing..."))))))
@ -144,90 +60,11 @@ but the %s executable file is not found. You need to install it manually."
Press ENTER to continue." font-name))
(prompt-msg (or message default-message)))
(unless (member font-name (font-family-list))
(when (string= (read-string prompt-msg) "")
(unless (string= (read-string prompt-msg) "")
(message "Continuing...")))))
(defun my-async-shell-command-with-unique-buffer-name (command)
"Execute an asynchronous shell command and display its output in a unique buffer.
This function prompts the user for a shell command and then executes it
asynchronously. The output of the command is displayed in a buffer with a
unique name, incorporating the provided command and a timestamp. The buffer
name is of the form '*Async Command - COMMAND - TIMESTAMP*', where COMMAND is
the entered shell command and TIMESTAMP is the current date and time in the
format 'YYYY-MM-DD HH:MM:SS:NNN'.
Version: 2023-08-16"
(interactive "sShell command: ")
(let ((buffer-name
(concat "*Async Command - " command " - "
(format-time-string "%Y-%m-%d %H:%M:%S:%3N") "*")))
(async-shell-command command buffer-name)))
(defun my-file-contains-p (file content)
"Check if FILE contains all items in CONTENT list."
(when (file-exists-p file)
(with-temp-buffer
(set-buffer-file-coding-system 'utf-8-unix)
(insert-file-contents file)
(seq-every-p (lambda (item) (string-match-p (regexp-quote item) (buffer-string))) content))))
(defun my-insert-newline-at-end-of-file (file-path)
"Inserts a new line at the end of the file specified by FILE-PATH."
(with-current-buffer (find-file-noselect file-path)
(goto-char (point-max))
(newline)
(save-buffer)
(kill-buffer)))
(defun my-write-to-file (content file &optional append sudo)
"Write CONTENT to FILE. If APPEND is true, append the content to the file; otherwise, overwrite the file.
If SUDO is provided and non-nil, execute the write operation with sudo."
(let* ((tee-command (if append "tee -a" "tee"))
(sudo-command (if sudo (concat "sudo " tee-command) tee-command))
(cmd (concat "echo " (shell-quote-argument content) " | " sudo-command " " (shell-quote-argument file))))
(if sudo
(if (executable-find "tee")
(shell-command cmd)
(message "Not executed due to tee executable not found.
The tee executable is required for the sudo execution."))
(with-temp-buffer
(insert content)
(write-region (point-min) (point-max) file append)))
))
(defun my-merge-duplicated-lines-in-file (file &optional sudo)
"Merge duplicated lines in FILE.
If SUDO is provided and non-nil, execute the merge operation with sudo."
(interactive "f")
(with-temp-buffer
;; fix "\r\n" and "\n" on different systems
;; "\n" will be used as utf-8-unix for Unix-like systems
(set-buffer-file-coding-system 'utf-8-unix)
(insert-file-contents file)
(let* ((newline-str "\n")
(lines (split-string (buffer-string) newline-str t))
;; reverse the list so that the first one will be kept after delete-dups
(lines (delete-dups (reverse lines)))
;; (lines (sort lines 'string>)) ;; sort the lines
)
(erase-buffer)
(insert (mapconcat 'identity (reverse lines) newline-str)))
(if sudo
(let* ((sudo-command (concat "sudo tee " (shell-quote-argument file)))
(cmd (concat "echo " (shell-quote-argument (buffer-string)) " | " sudo-command)))
(if (executable-find "tee")
(shell-command cmd)
(message "Not executed due to tee executable not found.
The tee executable is required for the sudo execution.")))
(write-region (point-min) (point-max) file))))
(provide 'init-pre)

21
lisp/init-python.el
View File

@ -3,27 +3,6 @@
;;; Code:
(use-package pyvenv
:config
;; (pyvenv-mode t)
;; set correct Python interpreter
(setq pyvenv-post-activate-hooks
(list (lambda ()
(if (equal system-type 'windows-nt)
(setq python-shell-interpreter (concat pyvenv-virtual-env "Scripts/python"))
(setq python-shell-interpreter (concat pyvenv-virtual-env "bin/python"))
)
)))
(setq pyvenv-post-deactivate-hooks
(list (lambda ()
(setq python-shell-interpreter "python")
)))
)
(defun my/python-mode-config ()
(setq python-indent-offset 4
python-indent 4

31
lisp/init-reformatter.el
View File

@ -1,31 +0,0 @@
;;; init-reformatter.el --- reformatter settings -*- lexical-binding: t -*-
;;; Commentary:
;;; Code:
;; START: reformatter config
(use-package reformatter
:config
(reformatter-define css-yaml-format
:program "prettier"
:args (list "--write" buffer-file-name)
;; https://emacs.stackexchange.com/questions/24298/can-i-eval-a-value-in-quote
)
(reformatter-define sh-format
:program "shfmt"
:args (list "-l" "-w" "-i" "4" buffer-file-name)
;; 4 spaces as indent, read more https://github.com/mvdan/sh/blob/master/cmd/shfmt/shfmt.1.scd
;; https://emacs.stackexchange.com/questions/24298/can-i-eval-a-value-in-quote
)
)
(my-check-for-executable "Prettier" "prettier")
(my-check-for-executable "shfmt" "shfmt")
;; END: reformatter config
(provide 'init-reformatter)
;; Local Variables:
;; coding: utf-8
;; End:
;;; init-reformatter.el ends here

27
lisp/init-sessions.el
View File

@ -3,14 +3,10 @@
;;; Code:
;; https://web.archive.org/web/20240509043743/http://xahlee.info/emacs/emacs/emacs_save_restore_opened_files.html
;; save a list of open files in ~/.emacs.d/.emacs.desktop
(setq desktop-path (list user-emacs-directory)
desktop-auto-save-timeout 6
desktop-auto-save-timeout 600
desktop-save t
desktop-load-locked-desktop t ; no ask if crashed
desktop-restore-frames t
desktop-restore-eager 10 ; the maximum number of 10 buffers to restore
; immediately, and the remaining buffers are
; restored lazily, when Emacs is idle.
@ -48,27 +44,6 @@
tags-table-list))
;; make Emacs remember cursor position,
;; by default, the position records are saved to ~/.emacs.d/places
;; via https://web.archive.org/web/20240509044026/http://xahlee.info/emacs/emacs/emacs_save_cursor_position.html
(save-place-mode 1)
;; https://web.archive.org/web/20240509044606/http://xahlee.info/emacs/emacs/emacs_save_command_history.html
(use-package savehist
;; from https://web.archive.org/web/20240509044708/https://emacs-china.org/t/emacs/17606/9
:init (setq enable-recursive-minibuffers t ; allow commands in minibuffers
history-length 1000
savehist-additional-variables '(mark-ring
global-mark-ring
search-ring
regexp-search-ring
extended-command-history)
savehist-autosave-interval 6)
:config
;; by default, the command histories are saved to ~/.emacs.d/history
(savehist-mode 1))
(provide 'init-sessions)
;; Local Variables:

32
lisp/init-speed-up.el
View File

@ -8,16 +8,16 @@
;; https://github.com/doomemacs/doomemacs/issues/3108#issuecomment-627537230
;; (setq garbage-collection-messages t)
;; https://web.archive.org/web/20231109122321/http://bling.github.io/blog/2016/01/18/why-are-you-changing-gc-cons-threshold/
;; http://bling.github.io/blog/2016/01/18/why-are-you-changing-gc-cons-threshold
(defun my/minibuffer-setup-hook ()
;; https://web.archive.org/web/20231109123003/http://clhs.lisp.se/Body/v_most_p.htm
;; http://clhs.lisp.se/Body/v_most_p.htm
(setq gc-cons-threshold most-positive-fixnum)
)
(defun my/minibuffer-exit-hook ()
;; defer it (1sec) so that commands launched immediately after will enjoy the
;; benefits.
;; https://github.com/doomemacs/doomemacs/blob/35865ef5e89442e3809b8095199977053dd4210f/docs/faq.org#how-does-doom-start-up-so-quickly
;; https://github.com/doomemacs/doomemacs/blob/develop/docs/faq.org#how-does-doom-start-up-so-quickly
(run-at-time 1 nil
(lambda () (setq gc-cons-threshold 16777216)) ; 16mb
)
@ -27,32 +27,6 @@
(add-hook 'minibuffer-exit-hook #'my/minibuffer-exit-hook)
;; { START: 优化 Emacs 的垃圾搜集行为
;; https://web.archive.org/web/20231109123542/https://raw.githubusercontent.com/lujun9972/lujun9972.github.com/81a7933b05495155a601b9b57991ca32d12c95a5/Emacs%E4%B9%8B%E6%80%92/%E4%BC%98%E5%8C%96Emacs%E7%9A%84%E5%9E%83%E5%9C%BE%E6%90%9C%E9%9B%86%E8%A1%8C%E4%B8%BA.org
;; original link https://web.archive.org/web/20231109123354/https://akrl.sdf.org/
;; (setq garbage-collection-messages t)
;; (setq garbage-collection-messages nil)
;; This macro measures the time it takes to evaluate a body of code.
(defmacro measure-time (&rest body)
"Measure and return the time it takes evaluating BODY."
`(let ((start-time (current-time)))
,@body
(float-time (time-since start-time))))
;; This variable sets a timer to run the garbage collector after 15 seconds
;; of idling.
(defvar gc-timer
(run-with-idle-timer 15 t
(lambda ()
(message "Garbage collector has run for %.06f seconds"
(measure-time (garbage-collect))))))
;; END: 优化 Emacs 的垃圾搜集行为 }
(provide 'init-speed-up)
;; Local Variables:

23
lisp/init-spelling.el
View File

@ -14,29 +14,6 @@
)
(use-package auto-capitalize
:straight (:host github :repo "yuutayamada/auto-capitalize-el")
:config
(setq auto-capitalize-words `("I" "English"))
;; this configuration adds capitalized words of .aspell.en.pws
(setq auto-capitalize-aspell-file (expand-file-name "misc/aspell.en.pws" user-emacs-directory))
(auto-capitalize-setup)
;; (add-hook 'after-change-major-mode-hook 'auto-capitalize-mode)
:hook (org-mode . auto-capitalize-mode)
)
(use-package ta
:delight
;; :config
;; (mapc (lambda (mode-hook) (add-hook mode-hook 'ta-mode))
;; '(org-mode-hook
;; markdown-mode-hook
;; rst-mode-hook))
;; (define-key ta-mode-map (kbd "M-o") 'ta-next-homophony)
)
(provide 'init-spelling)
;; Local Variables:

345
lisp/init-tags.el
View File

@ -1,345 +0,0 @@
;;; init-tags.el --- tags related config -*- lexical-binding: t -*-
;;; Commentary:
;;; Code:
;; a tags file is an index to source-code definitions of functions, variables, and any other interesting syntactic feature.
;; { START: citre
(unless (executable-find "ctags")
(when (string= (which-linux-release-info "distributor") "Ubuntu")
(call-process "/bin/bash"
(expand-file-name "scripts/ctags.sh" user-emacs-directory)))
(yes-or-no-p "Please be informed the ctags is started to install in the background...
The installation result can be checked later manually with ctags command. Continue?")
)
(use-package citre
:delight
;; ctags should be installed first, the Universal Ctags is recommended,
;; https://github.com/universal-ctags/ctags
:defer t
:init
;; This is needed in `:init' block for lazy load to work.
(require 'citre-config)
:config
;; see https://github.com/universal-ctags/citre/issues/161
(setq citre-peek-fill-fringe nil)
(setq citre-peek-use-dashes-as-horizontal-border t))
(when (or (eq system-type 'darwin) (eq system-type 'windows-nt))
(my-check-for-executable "ctags" "ctags"))
;; END: citre }
(defun my/create-tags
(dir-name tags-format tag-relative tags-filename
&optional tags-path append sudo process-name)
"Create a tags file with absolute or relative symbols recorded inside. With a
prefix argument SUDO, run the command with sudo privilege.
When called interactively, prompt the user for the directory name to create the
tags file. If no input is given, use the current working directory.
The `ctags` command is executed with the `--tag-relative` option
set to `yes` if the `tag-relative` is set to 'y', or 'n'
indicates 'never'. The `*` wildcard is included in the `ctags`
command to create tags for all files in the directory.
Version: 2023-03-17
Updated: 2023-10-20"
;; This function is improved by ChatGPT and Claude :)
(interactive
(let* ((tags-format (completing-read "ctags or etags format? (ctags/etags)\n(Note: omit input indicates etags format) "
'("ctags" "etags")
nil t nil nil "etags"))
(tag-relative (completing-read "Create tags index file with relative symbols? (y/n)\n(Note: omit input indicates absolute symbols) "
'("y" "n")
nil t nil nil "n"))
(tags-filename (if (string-equal tags-format "etags")
(if (string-equal tag-relative "y") "TAGS" "TAGS_ABS")
(if (string-equal tag-relative "y") "tags" "tags_abs"))))
(list (read-directory-name "Enter the directory for creating tags file: ")
tags-format
tag-relative
(read-string "Enter the desired tags filename: " tags-filename)
(if (boundp 'tags-path) tags-path nil)
(completing-read "Append the tags to existing tags index file? (y/n)\n(Note: omit input indicates creating) "
'("y" "n")
nil t nil nil "n")
(if (boundp 'sudo)
sudo
(if current-prefix-arg t nil) ; if universal argument (sudo)
)
(if (boundp 'process-name) process-name "create tags"))))
(let* ((target-dir-value (if (string= "" dir-name)
default-directory
(if (eq system-type 'windows-nt)
;; if the dir-name already start with "/d", just use it
(if (string-prefix-p "/d" dir-name)
dir-name
;; fix changing dir across different drives issue on Windows
(concat "/d " dir-name))
(expand-file-name dir-name))))
(tags-format-value (if (string-equal tags-format 'ctags) "" "-e"))
(tag-relative-value (if (string-equal tag-relative 'y) "yes" "never"))
;; yes - relative symbols
;; never - absolute symbols
(append-t-or-not (if (string-equal append 'y) t nil))
(append-or-create (if (string-equal append 'y) "- APPEND: " "- CREATE: "))
(append-or-not (if (string-equal append 'y) "--append=yes" ""))
(tags-path-value
(if (string= tag-relative 'y)
(expand-file-name tags-filename target-dir-value)
(or tags-path
(expand-file-name tags-filename
(read-directory-name
"Enter the path to store the tags file: "
nil default-directory)))))
(command-process-name process-name)
(ctags-cmd (format "cd %s && ctags --options=%s %s -R --tag-relative=%s %s -f %s *"
target-dir-value
(expand-file-name ".ctags" user-emacs-directory)
tags-format-value
tag-relative-value
append-or-not
tags-path-value))
(command (if sudo
(concat "sudo sh -c '"
ctags-cmd
"'")
ctags-cmd)))
(if (get-process command-process-name)
(message "Process (%s) already running..." command-process-name)
(progn
(start-process-shell-command command-process-name
(format "*%s*" command-process-name)
command)
(message "Creating tags...")
(when append-t-or-not
(my-insert-newline-at-end-of-file
(concat tags-path-value ".commands")))
(my-write-to-file
(format-time-string "%Y-%m-%d %H:%M:%S")
(concat tags-path-value ".commands")
append-t-or-not
sudo)
(my-insert-newline-at-end-of-file
(concat tags-path-value ".commands"))
(my-write-to-file
(concat append-or-create command)
(concat tags-path-value ".commands")
t
sudo)
(my-insert-newline-at-end-of-file
(concat tags-path-value ".commands"))
(my-write-to-file
(concat append-or-create
(format "(my/create-tags \"%s\" \"%s\" \"%s\" \"%s\" \"%s\" \"%s\" %s \"%s\")"
target-dir-value
tags-format
tag-relative
tags-filename
tags-path-value
append
sudo
process-name
))
(concat tags-path-value ".commands")
t
sudo)
(my-insert-newline-at-end-of-file
(concat tags-path-value ".commands"))
(my-merge-duplicated-lines-in-file
(concat tags-path-value ".commands")
sudo)
))
))
(defvar my/default-tags-file-name "TAGS"
"The default name of the tags file to search for.")
(defun my/find-tags-file (&optional ask tags-file-name)
"Recursively search for a 'TAGS' file in parent directories and return its path.
Optional arguments:
ASK (default nil): If t, prompt for entering a custom tags file
name.
TAGS-FILE-NAME (default 'TAGS'): The name of the tags file to
search for.
This function searches for a 'TAGS' file by recursively examining
parent directories starting from the directory of the currently
visited file (if any). If a 'TAGS' file is found, its full path
is returned. If no 'TAGS' file is found, or if the current buffer
is not visiting a file, it returns nil.
Usage examples:
(my/find-tags-file) ; Search for default 'TAGS' file in parent
directories
(my/find-tags-file t) ; Prompt for a custom tags file name
(my/find-tags-file nil \"TAGS_ABS\") ; Search for a 'TAGS_ABS' file
(my/find-tags-file nil \"TAGS\") ; Search for the default 'TAGS' file
Version: 2023-08-23"
(progn
(unless tags-file-name
(setq tags-file-name my/default-tags-file-name))
(defun find-tags-file-r (path tags-file prev-parent)
"Find the tags file from the parent directories"
(let* ((parent (file-name-directory path))
(possible-tags-file (concat parent tags-file)))
(message "Found tags file: %s" possible-tags-file)
(cond
((file-exists-p possible-tags-file)
(throw 'found-it possible-tags-file)
(message "Found tags file: %s" possible-tags-file))
((equal parent prev-parent)
(error "No tags file found")) ; stop if no progress is made
(t (message "Checking %s" possible-tags-file)
(find-tags-file-r (directory-file-name parent) tags-file parent)))))
(if (buffer-file-name)
(catch 'found-it
(if ask
(let ((tags-file-name-input
(read-from-minibuffer
"Enter tags file name: " tags-file-name)))
(find-tags-file-r (buffer-file-name) tags-file-name-input nil))
(find-tags-file-r (buffer-file-name) tags-file-name nil)))
(error "Buffer is not visiting a file"))))
(defun my/file ()
"prompt user to enter a file name, with completion and history
support."
;; http://xahlee.info/emacs/emacs/elisp_idioms_prompting_input.html
(interactive)
(setq my-file-value (read-file-name "Input file name: "))
(message "my-file-value is %s" my-file-value)
)
;; { START: config for counsel-etags and company-ctags
;; <<config-ce-cc>>
(defun my-tags-file (&optional select tags-file)
"If SELECT is non-nil, set the value of `my-tags-file` to
TAG-FILE. If TAGS-FILE is nil, use the user-selected file path
after prompting for it through `my/file`.
Otherwise, set `my-tags-file` to the value returned by
`my/find-tags-file`. -- generated by ChatGPT :)
Updated: 2023-08-20"
(if select
(if tags-file
(setq my-tags-file tags-file)
(progn (my/file)
(setq my-tags-file my-file-value)))
(setq my-tags-file (my/find-tags-file t)))
)
(defun my-set-extra-tags-files (my-tags-table-list)
(setq counsel-etags-extra-tags-files my-tags-table-list)
(setq company-ctags-extra-tags-files my-tags-table-list)
(message "tags-table list for counsel-etags/company-ctags:\n%s\n\nNote:
files in counsel-etags-extra-tags-files should have symbols with
absolute path only." my-tags-table-list)
)
(defun my/insert-into-my-tags-table-list(&optional select tags-file)
"automatically insert the TAGS file or select TAGS file to
insert(C-u), into `my-tags-table-list',
`counsel-etags-extra-tags-files' and
`company-ctags-extra-tags-files'.
Updated: 2023-08-20"
(interactive "P")
(unless (boundp 'my-tags-table-list)
;; if `my-tags-table-list' is void, then set it to empty list
(setq my-tags-table-list '()))
(setq existing-my-tags-table-list my-tags-table-list)
(setq my-tags-table-list '()) ; initiate empty list
(my-tags-file select tags-file)
(setq my-tags-table-list
(delq nil (delete-dups ; delete nil and duplicates
(cons (symbol-value 'my-tags-file)
(symbol-value 'existing-my-tags-table-list)))))
(my-set-extra-tags-files my-tags-table-list)
)
(defun my/delete-from-my-tags-table-list (&optional select tags-file)
"automatically delete the TAGS file or select TAGS file to
delete(C-u), from `my-tags-table-list',
`counsel-etags-extra-tags-files' and
`company-ctags-extra-tags-files'.
Updated: 2023-08-20"
(interactive "P")
(my-tags-file select tags-file)
(setq my-tags-table-list
(delete (symbol-value 'my-tags-file) my-tags-table-list))
(my-set-extra-tags-files my-tags-table-list)
)
;; keybinding -> [[./init-keybindings.el::m-ftf]]
(defun my/set-tags-table-list (&optional del)
"calls `my/find-tags-file' to recursively search up the directory
tree to find a file named 'TAGS'. If found, add/delete(C-u) it
to/from 'counsel-etags-extra-tags-files' and
'company-ctags-extra-tags-files'."
(interactive "P")
(if del (my/delete-from-my-tags-table-list)
(my/insert-into-my-tags-table-list))
)
(defun my/tags-table-list ()
"check and display my tags-table list through message."
(interactive)
(message "tags-table list for counsel-etags/company-ctags:\n%s\n\nNote:
files in counsel-etags-extra-tags-files should have symbols with
absolute path only." my-tags-table-list)
)
;; END: config for counsel-etags and company-ctags }
(defun my/sync-tags-table-list ()
"sync `tags-table-list' with `my-tags-table-list'.
Read more,
https://www.gnu.org/software/emacs/manual/html_node/emacs/Select-Tags-Table.html
Some commands for checking the values:
(symbol-value 'tags-table-list)
(symbol-value 'tags-file-name)
Version: 2023-08-30"
(interactive)
(setq tags-table-list my-tags-table-list)
(message "tags-table-list is set to %s" tags-table-list))
(provide 'init-tags)
;; Local Variables:
;; coding: utf-8
;; End:
;;; init-tags.el ends here

271
lisp/init-timer-utils.el
View File

@ -1,271 +0,0 @@
;;; init-timer-utils.el --- timer utils -*- lexical-binding: t -*-
;;; Commentary:
;;; Code:
(defun my-cancel-existing-timer (timer-function)
"Cancel an existing active timer with the given TIMER-FUNCTION.
Version: 2023-08-15"
(dolist (timer timer-list)
(when (equal (timer--function timer) timer-function)
(cancel-timer timer)
(setq timer-list (delq timer timer-list)))))
(defun my-calculate-tomorrow-date ()
"Calculate tomorrow's date and return it as a list of (day month year).
Version: 2023-09-05"
(interactive)
(let* ((current-time (decode-time (current-time)))
(current-day (nth 3 current-time))
(current-month (nth 4 current-time))
(current-year (nth 5 current-time))
(tomorrow-day (1+ current-day))
(tomorrow-month (if (> tomorrow-day
(calendar-last-day-of-month current-month current-year))
(1+ current-month)
current-month))
(tomorrow-year (if (> tomorrow-month 12)
(1+ current-year)
current-year)))
(setq tomorrow-day (if (> tomorrow-day
(calendar-last-day-of-month current-month current-year))
1
tomorrow-day))
;; (message "Tomorrow's date is: %d-%02d-%02d" tomorrow-year tomorrow-month tomorrow-day)
(list tomorrow-day tomorrow-month tomorrow-year)))
(defun my-current-time-in-minutes ()
"Return the current time in minutes since midnight.
Version: 2023-09-05"
(let* ((current-time (decode-time (current-time)))
(current-hour (nth 2 current-time))
(current-minute (nth 1 current-time))
(current-time-in-minutes (+ (* current-hour 60) current-minute)))
current-time-in-minutes))
(defun my-schedule-task-every-day (hour minute task-function)
"Schedule a task to run every day at a specific time.
This function schedules the given task function to run at the specified hour
and minute every day.
Args:
hour (integer): The hour of the day (0 to 23) at which the task should run.
minute (integer): The minute of the hour (0 to 59) at which the task should run.
task-function (function): The function to be executed when the scheduled time is reached.
Returns:
None: The task is scheduled to run using the 'run-at-time' function.
Note:
The 'run-at-time' function is used to schedule the task, and it may not guarantee
exact timing due to various factors such as system load and other scheduled tasks.
Example:
(my-schedule-task-every-day 15 30 'my-task-function)
This will schedule 'my-task-function' to run every day at 3:30 PM.
Version: 2023-08-15"
(my-cancel-existing-timer task-function)
(let* ((current-time-in-minutes (my-current-time-in-minutes))
(scheduled-time-in-minutes (+ (* hour 60) minute)))
(if (<= scheduled-time-in-minutes current-time-in-minutes)
;; If the scheduled time is before or equal to the current time, set schedule for tomorrow
(let* ((tomorrow-date (my-calculate-tomorrow-date))
(tomorrow-time
(encode-time 0 minute hour
(car tomorrow-date)
(cadr tomorrow-date)
(caddr tomorrow-date))))
(run-at-time tomorrow-time
(* 60 60 24)
task-function))
(setq task-function-timer
(run-at-time (format "%02d:%02d" hour minute)
(* 60 60 24)
task-function)))))
(defun my-schedule-task-every-x-secs (seconds task-function)
"Schedule a task to run every x seconds.
(my-cancel-existing-timer task-function)
Version: 2023-08-28"
(my-cancel-existing-timer task-function)
(setq task-function-timer
(run-at-time 0 ; the task should start immediately
seconds
task-function)))
(defun my-schedule-task-every-x-mins (minutes task-function)
"Schedule a task to run every x mins.
Version: 2023-08-19"
(my-cancel-existing-timer task-function)
(setq task-function-timer
(run-at-time 0 ; the task should start immediately
(* minutes 60)
task-function)))
(defun my-schedule-task-on-day-of-week (day-of-week hour minute task-function)
"Schedule a task to run at a specific time on a particular day of the week.
This function calculates the next occurrence of the specified day of the week
and schedules the given task function to run at the specified hour and minute
of that day.
Args:
day-of-week (integer): The desired day of the week (0 = Sunday, 1 = Monday, ..., 6 = Saturday).
hour (integer): The hour of the day (0 to 23) at which the task should run.
minute (integer): The minute of the hour (0 to 59) at which the task should run.
task-function (function): The function to be executed when the scheduled time is reached.
Returns:
None: The task is scheduled to run using the 'run-at-time' function.
Note:
This function calculates the next occurrence of the specified day of the week
based on the current date and time and then schedules the task to run on that
calculated date and time.
It is important to note that the 'run-at-time' function is used to schedule the task,
and it may not guarantee exact timing due to various factors such as system load
and other scheduled tasks.
Example:
(my-schedule-task-on-day-of-week 3 15 30 'my-task-function)
This will schedule 'my-task-function' to run every Wednesday at 3:30 PM.
Version 2023-08-15"
(let* ((current-time (current-time))
(decoded-time (decode-time current-time))
(current-day-of-week (nth 6 decoded-time))
(days-until-desired-day (mod (+ day-of-week (- current-day-of-week)) 7))
(desired-date (decode-time
(time-add current-time (seconds-to-time
(* days-until-desired-day 24 60 60)))))
(desired-day (nth 3 desired-date))
(desired-month (nth 4 desired-date))
(desired-year (nth 5 desired-date)))
(my-cancel-existing-timer task-function)
(run-at-time
(encode-time 0 minute hour desired-day desired-month desired-year)
(* 7 24 60 60)
task-function)))
(defun my-schedule-task-in-x-mins (minutes task-function)
"Schedule a task to run in x mins.
Version: 2023-08-19"
(my-cancel-existing-timer task-function)
(setq task-function-timer
(run-at-time (format "%s min" minutes)
nil
task-function)))
(defun my-schedule-task-at-specific-min-between-hour
(start-hour end-hour specific-minutes base-task-function)
"Schedule tasks to run at specific minutes between two hours.
This function schedules tasks with different specific minutes between the given
start and end hours. The task names will have the format 'base-task-function_hour-min'.
Args:
start-hour (integer): The starting hour (0 to 23) of the time range.
end-hour (integer): The ending hour (0 to 23) of the time range.
specific-minutes (list): A list of specific minutes (0 to 59) at which the tasks should run.
base-task-function (function): The base function to be executed when the tasks are scheduled.
Returns:
None: The tasks are scheduled to run using the 'run-at-time' function.
Note:
The 'run-at-time' function is used to schedule the tasks, and it may not guarantee
exact timing due to various factors such as system load and other scheduled tasks.
Example:
(my-schedule-task-at-specific-min-between-hour 10 17 '(0 15 30 45) 'my-task-function)
This will schedule tasks to execute 'my-task-function' at minutes 0, 15, 30, and 45
between 10:00 AM and 5:00 PM.
Version: 2023-09-04
Updated: 2023-09-05"
;; Define the task name format
(let ((task-name-format
(format "%s_%%02d-%%02d" (symbol-name base-task-function))))
;; Get the current time in minutes since midnight
(let* ((current-time-in-minutes (my-current-time-in-minutes)))
;; Loop through hours and minutes to schedule tasks
(dotimes (hour-counter (- end-hour start-hour))
(let ((current-hour (+ start-hour hour-counter)))
(dolist (minute specific-minutes)
;; Calculate the scheduled task time in minutes since midnight
(let ((scheduled-time-in-minutes (+ (* current-hour 60) minute)))
;; Construct the full task name with hour and minute
(let ((task-name (format task-name-format current-hour minute)))
;; Cancel existing timer with the same task name
(my-cancel-existing-timer (intern task-name))
;; Check if the scheduled time is ahead of the current time
;; Define the new task function using defalias
(defalias (intern task-name)
`(lambda ()
,(format "Scheduled task: %s" (symbol-name base-task-function))
(funcall ',base-task-function)))
(if (<= scheduled-time-in-minutes current-time-in-minutes)
;; If the scheduled time is before or equal to the current time, set schedule for tomorrow
(let* ((tomorrow-date (my-calculate-tomorrow-date))
(tomorrow-time
(encode-time 0 minute current-hour
(car tomorrow-date)
(cadr tomorrow-date)
(caddr tomorrow-date))))
(run-at-time tomorrow-time
(* 60 60 24)
(intern task-name)))
;; Schedule the new task
(run-at-time (format "%02d:%02d" current-hour minute)
(* 60 60 24)
(intern task-name)))))))))))
(provide 'init-timer-utils)
;; Local Variables:
;; coding: utf-8
;; End:
;;; init-timer-utils.el ends here

424
lisp/init-utils.el
View File

@ -3,25 +3,6 @@
;;; Code:
;; the my/xxx utils config - yet to be placed in dedicated init-xxx.el files
(defun my/highlight-selected-text (start end &optional color)
"Highlight the selected region temporarily with the specified color.
If color is not provided, the default color is #5F87FF.
Version 2023-10-18"
(interactive "r\nsEnter color (e.g., 'red', press ENTER for default #5F87FF): ")
(let* ((overlay (make-overlay start end))
(color (if (string= color "") "#5F87FF" color))
(text-color (if (or (string= color "black") (string= color "#5F87FF"))
"white"
"black")))
(overlay-put overlay 'face `((:background ,color :foreground ,text-color)))
(add-hook 'before-revert-hook (lambda () (delete-overlay overlay)))))
(defun my/random-org-item ()
"Go to a random org heading from all org files in `org-directory`."
(interactive)
@ -121,7 +102,7 @@ Version 2023-10-18"
"insert a `SRC-CODE-TYPE' type source code block in org-mode."
(interactive
(let ((src-code-types
'("emacs-lisp" "python" "C" "shell" "java" "js" "clojure" "C++" "css"
'("emacs-lisp" "python" "C" "sh" "java" "js" "clojure" "C++" "css"
"calc" "asymptote" "dot" "gnuplot" "ledger" "lilypond" "mscgen"
"octave" "oz" "plantuml" "R" "sass" "screen" "sql" "awk" "ditaa"
"haskell" "latex" "lisp" "matlab" "ocaml" "org" "perl" "ruby"
@ -150,409 +131,6 @@ Version 2023-10-18"
(while (search-forward "\r" nil t) (replace-match "")))
(defun my/generate-current-time-string (&optional universal-arg silent)
"Generate a string representing the current date and time in specific format.
(e.g., 230725192607 for July 25th, 2023 at 19:26:07).
When UNIVERSAL-ARG (C-u) is provided, copy the time string to the kill ring.
Usage:
M-x my/generate-current-time-string
C-u M-x my/generate-current-time-string
Version 2023-07-25"
(interactive "P")
(let* ((now (current-time))
(time-string (concat (substring (format-time-string "%Y" now) -2)
(format-time-string "%m%d%H%M%S" now))))
(unless silent
(insert time-string))
(when universal-arg
(kill-new time-string)
(message "%s is copied." time-string))
(message "Current time string generated: %s" time-string)
time-string))
(defun my/review-random-function ()
"Review a random function defined in my Emacs configuration."
(interactive)
(let* ((config-functions '())
(config-files (directory-files-recursively user-emacs-directory "\\.el$")))
(dolist (file config-files)
(with-temp-buffer
(insert-file-contents file)
(goto-char (point-min))
(while (re-search-forward "(defun \\([^ ]+\\)" nil t)
(push (match-string 1) config-functions))))
(let* ((command (nth (random (length config-functions)) config-functions)))
(describe-function (intern command)))))
(defun my/review-random-my-function ()
"Review a random function that starts with 'my/' in my Emacs configuration."
(interactive)
(let* ((config-functions '())
(config-files (directory-files-recursively user-emacs-directory "\\.el$")))
(dolist (file config-files)
(with-temp-buffer
(insert-file-contents file)
(goto-char (point-min))
(while (re-search-forward "(defun my/\\([^ ]+\\)" nil t)
(push (match-string 1) config-functions))))
(let* ((command (nth (random (length config-functions)) config-functions)))
(describe-function (intern (concat "my/" command))))))
;; {{ START: my/open-link-at-point-as-gpg
(defun my/securely-delete-file (&optional filename)
"Securely delete the specified file interactively or by providing FILENAME.
If secure deletion failed, then continue with the normal deletion."
(interactive (list (when current-prefix-arg
(read-file-name "Choose file to securely delete: "))))
(if filename
(progn
(message "Securely deleting %s..." (shell-quote-argument filename))
(cond
((eq system-type 'windows-nt)
;; https://learn.microsoft.com/en-us/sysinternals/downloads/sdelete
(my-check-for-executable "SDelete" "sdelete")
(shell-command (concat "sdelete -p 3 " (shell-quote-argument filename))))
((eq system-type 'gnu/linux)
(my-check-for-executable "shred" "shred")
(shell-command (concat "shred -v -z -u -n 10 " (shell-quote-argument filename))))
((eq system-type 'darwin)
(my-check-for-executable "shred" "gshred")
(shell-command (concat "gshred -v -z -u -n 10 " (shell-quote-argument filename)))))
(when (file-exists-p (shell-quote-argument filename))
(message "Securely deleting %s failed, and continue with the normal deletion." (shell-quote-argument filename))
(delete-file filename)))
(user-error "No file specified for secure deletion.")))
(defun my/open-link-at-point-as-gpg ()
"Open the link at point using Emacs epa in a temporary buffer,
and the decrypted file will be securely deleted after opening in buffer."
(interactive)
(require 'epa)
(let* ((link-info (org-element-context))
(path (org-element-property :path link-info))
(abs-path (if (string-prefix-p "file:" path)
(file-truename (replace-regexp-in-string ":" "" path))
(file-truename path)))
(decrypted-file (concat abs-path ".clear")))
(if (file-exists-p abs-path)
(progn
(epa-decrypt-file abs-path decrypted-file)
(find-file decrypted-file)
(when (file-exists-p decrypted-file)
(my/securely-delete-file decrypted-file)))
(message "File does not exist: %s" abs-path))))
;; END: my/open-link-at-point-as-gpg }}
;; {{ START: my/check-orphaned-org-ids-in-directory
(defun my-org-id-link-pre ()
"The precondition config to my org id link settings"
(my-require 'org-element) ; this should be here before `org-add-link-type'
(my-require 'cl-lib)
;; From ChatGPT,
;; The message "Created id link." is printed by the `org-add-link-type` function
;; each time it is called.
;; Since you have the line `(org-add-link-type "id" #'my-org-id-link-follow)` in
;; your code, this function is called every time you load or reload your Emacs
;; configuration. It registers a new link type called `"id"` that is handled by
;; the `my-org-id-link-follow` function.
;; register new link type called "id"
(org-add-link-type "id" #'my-org-id-link-follow))
(defun my-org-id-link-follow (id)
"Follow an `id' link."
(message "Link ID: %s" id))
(defun my-org-id-links-in-buffer ()
"Return a list of Org ID links in the current buffer."
(my-org-id-link-pre)
(let (org-id-links) ; creates a local variable called `org-id-links` with an
; initial value of `nil` that is only visible within the
; `let` block
(org-element-map (org-element-parse-buffer) 'link
(lambda (link)
(when (string= (org-element-property :type link) "id")
(push (org-element-property :path link) org-id-links)
)))
org-id-links))
(defun my-list-org-id-links-in-directory (directory)
"Search all .org files in DIRECTORY for Org ID links, and return a list of unique IDs found."
(interactive "DDirectory: ")
(let (org-ids)
(dolist (file (directory-files-recursively directory "\\.org$") org-ids)
(with-temp-buffer
(insert-file-contents file)
(setq org-ids (append org-ids (my-org-id-links-in-buffer)))
))
(delete-dups org-ids)
))
(defun my-list-org-ids-in-directory (directory)
"List all org-ids in org-files in the given DIRECTORY and return them as a list."
(interactive "DDirectory: ")
(my-org-id-link-pre)
(let ((org-files (directory-files-recursively directory "\\.org$"))
(org-ids '()))
(dolist (file org-files)
(with-temp-buffer
(insert-file-contents file)
(org-mode)
(org-element-map (org-element-parse-buffer) 'headline
(lambda (headline)
(when-let ((id (org-element-property :ID headline)))
(push id org-ids))))
(goto-char (point-min))
(while (re-search-forward "^:ID:\\s-+\\(\\S-+\\)" nil t)
(push (match-string 1) org-ids))))
org-ids))
(defun my/check-orphaned-org-ids-in-directory (dir)
"Find the difference between org-ids obtained by `my-list-org-ids-in-directory'
and org-ids obtained by `my-list-org-id-links-in-directory'.
DIRECTORY is the directory where the org files are located."
(interactive "DDirectory: ")
(let ((org-ids (my-list-org-ids-in-directory dir))
(id-links (my-list-org-id-links-in-directory dir)))
(let ((not-linked (cl-set-difference org-ids id-links :test #'string=))
(invalid-links (cl-set-difference id-links org-ids :test #'string=)))
(message "%d not-linked org-ids: %s"
(length not-linked)
(format "%s" not-linked))
(message "%d invalid org-id links: %s"
(length invalid-links)
(format "%s" invalid-links)))))
;; END: my/check-orphaned-org-ids-in-directory }}
(defun my/org-list-entries-without-id-property ()
"List all entries in the current buffer that don't have an ID property."
(interactive)
(with-output-to-temp-buffer "*Org Entries Without ID*"
(let ((results nil))
(org-map-entries
(lambda ()
(unless (org-id-get)
(push (format "** LINE #%d:\n%s"
(line-number-at-pos)
(buffer-substring-no-properties
(line-beginning-position)
(line-end-position)))
results)))
nil nil t)
(princ (concat "#+TITLE: Org Entries Without ID\n\n"))
(princ (concat "#+OPTIONS: toc:nil\n\n"))
(princ (concat "* Entries without ID\n\n"))
(dolist (result (nreverse results))
(princ (concat result "\n\n")))))
(with-current-buffer "*Org Entries Without ID*"
(org-mode)))
(defun my/list-packages-and-versions ()
(interactive)
(package-initialize)
(let ((pkgs (mapcar 'car package-alist)))
(dolist (pkg pkgs)
(message "%s - %s"
pkg (package-desc-version (cadr (assq pkg package-alist)))))))
(defun my/copy-org-id-at-point ()
"Copy the ID property of the heading at point to the kill-ring."
(interactive)
(let ((id (org-entry-get nil "ID")))
(when id
(kill-new id)
(message "Copied ID: %s" id))))
(defun my-get-heading-from-org-id-db (org-id)
"Retrieve the heading title associated with an Org ID from the
current buffer's Org mode database."
(org-with-point-at (org-id-find org-id 'marker)
(org-get-heading)))
(defun my/insert-org-id-from-kill-ring ()
"Insert a link to an Org ID from the kill-ring with a user-defined description.
The user is prompted to enter a description for the link.
If description is empty, retrieve the heading from the org-id
database using `my-get-heading-from-org-id-db` function."
(interactive)
(let ((id (current-kill 0)))
(when id
(let* ((org-id (replace-regexp-in-string "^id:" "" id))
(description (read-string "Description: " nil 'my-history)))
(if (string-empty-p description)
(setq description (my-get-heading-from-org-id-db org-id)))
(org-insert-link nil (concat "id:" org-id) description)))))
(defun my/link-selected-text-with-org-id-from-kill-ring ()
"Create an Org-mode link using the selected text and an Org ID from the kill ring.
Version 2023-04-28
The selected text is replaced with,
[[id:<Org ID unique identifier>][<selected text>]].
Usage: Select the text that you want to link to an Org ID, then
run `M-x my/link-selected-text-with-org-id-from-kill-ring`. The
function will take the Org ID from the kill ring, and create an
Org-mode link with the selected text and the Org ID. The link
will be inserted at the cursor position, replacing the selected
text."
(interactive)
(let* ((org-id (substring-no-properties (current-kill 0)))
(text (buffer-substring-no-properties (region-beginning) (region-end)))
(link (concat "[[id:" org-id "][" text "]]")))
(delete-region (region-beginning) (region-end))
(insert link)))
(defun my-parse-link-id (link)
"Parse the ID from an org-mode link of the form `id:xxxxxxxxxxxx'."
(when (string-match "id:\\(.+\\)" link)
(match-string 1 link)))
(defun my/org-link-goto-at-point ()
"Check if link at point is a file link or an ID link, and jump to
the appropriate location."
(interactive)
(if-let ((link (org-element-property :raw-link (org-element-context))))
(cond ((string-prefix-p "file:" link)
(org-open-at-point))
((string-prefix-p "id:" link)
(org-id-goto (my-parse-link-id link))))
(message "No link at point.")))
(defun my/switch-opened-org-files-to-org-mode ()
"Switch all open buffers that end with .org to org-mode,
skipping buffers that are already in org-mode.
Version 2023-05-06"
;; See, https://stackoverflow.com/a/76187210/4274775
(interactive)
(dolist (buffer (buffer-list))
(with-current-buffer buffer
(when (and (buffer-file-name)
(string= (file-name-extension (buffer-file-name)) "org")
(not (eq major-mode 'org-mode)))
(org-mode)
(message "Switched %s to org-mode." (buffer-name))))))
(defun my/strikethrough-current-line ()
"Strikethrough the current line using +<striked text>+"
(interactive)
(back-to-indentation)
(insert "+")
(move-end-of-line nil)
;; skips over any consecutive space or tab characters immediately before the
;; end of the line, effectively moving the cursor to the last non-blank
;; character on the line, rather than after any trailing whitespace. see,
(skip-chars-backward " \t")
(insert "+"))
(defun my/readonly-files ()
"Check for a '.readonly' file in the directory of the current
buffer, and set the read-only status of any listed buffers. The
'.readonly' file should contain a list of buffer names, one per
line, that should be set to read-only. Any buffers not listed in
the file will remain unaffected.
Version 2023-05-04
This function is intended to be used as a hook to automatically
set the read-only status of buffers when they are opened or
saved, based on the contents of the '.readonly' file. To use this
function as a hook, add it to the appropriate hook list, such as
'find-file-hook', 'after-save-hook' or 'switch-buffer-hook'."
;; (add-hook 'find-file-hook 'my/readonly-files)
;; (add-hook 'after-save-hook 'my/readonly-files)
;; (add-hook 'switch-buffer-hook 'my/readonly-files)
(interactive)
(let ((readonly-file (concat (file-name-directory (buffer-file-name)) ".readonly")))
(when (file-exists-p readonly-file)
(let ((readonly-bufs (split-string (with-temp-buffer
(insert-file-contents readonly-file)
(buffer-string))
"\n" t)))
(message "read-only files list: %s" readonly-bufs)
(dolist (buf readonly-bufs)
(message "%s is read-only now" buf)
(let ((buf (find-buffer-visiting buf)))
(when buf
(with-current-buffer buf
(toggle-read-only t)))))))))
(defun my/revert-all-file-buffers ()
"Refresh all open file buffers without confirmation.
Buffers in modified (not yet saved) state in emacs will not be reverted. They
will be reverted though if they were modified outside emacs.
Buffers visiting files which do not exist any more or are no longer readable
will be killed."
;; via https://emacs.stackexchange.com/a/24461/29715
(interactive)
(dolist (buf (buffer-list))
(let ((filename (buffer-file-name buf)))
;; Revert only buffers containing files, which are not modified;
;; do not try to revert non-file buffers like *Messages*.
(when (and filename
(not (buffer-modified-p buf)))
(if (file-readable-p filename)
;; If the file exists and is readable, revert the buffer.
(with-current-buffer buf
(revert-buffer :ignore-auto :noconfirm :preserve-modes))
;; Otherwise, kill the buffer.
(let (kill-buffer-query-functions) ; No query done when killing buffer
(kill-buffer buf)
(message "Killed non-existing/unreadable file buffer: %s" filename))))))
(message "Finished reverting buffers containing unmodified files."))
(defun my/copy-current-buffer-to-another-buffer (target-buffer)
"Copy the content of the current buffer to another buffer.
If the target buffer does not exist, it will be created.
If the target buffer exists, the content will be appended.
Version: 2023-08-31"
(interactive "BTarget Buffer: ")
(let ((source-buffer (current-buffer))
(existing-buffer (get-buffer-create target-buffer)))
(with-current-buffer existing-buffer
(goto-char (point-max)) ; move to the end of the existing buffer
(insert-buffer-substring source-buffer)
(pop-to-buffer existing-buffer))))
(defun my/kill-buffers-by-pattern (pattern)
"Kill buffers whose names match the specified pattern.
This function interactively prompts the user for a pattern and then searches
through the list of all buffers. Buffers whose names match the given pattern
are killed, effectively closing them. The pattern is a regular expression that
is compared against buffer names using 'string-match-p'.
Version: 2023-08-16"
(interactive "sEnter a pattern: ")
(dolist (buffer (buffer-list))
(let ((buffer-name (buffer-name buffer)))
(message "Processing buffer: %s" buffer-name)
(when (string-match-p pattern buffer-name)
(kill-buffer buffer)
(message "Killed buffer '%s'" buffer-name)))))
(provide 'init-utils)
;; Local Variables:

84
lisp/init-uuid.el
View File

@ -1,84 +0,0 @@
;;; init-uuid.el --- UUID settings -*- lexical-binding: t -*-
;;; Commentary:
;;; Code:
;; <2023-04-18 Tue 17:55> now below functions are verified to work, but the
;; arbitrary position to other file is not working...
(defun my/quick-generate-uuid (&optional universal-arg)
"Generate a UUID, insert at point, and copy to kill ring when UNIVERSAL-ARG (C-u) is provided.
Usage:
M-x my/quick-generate-uuid
C-u M-x my/quick-generate-uuid
Version 2023-04-18
Updated 2023-07-25"
(interactive "P")
(let* ((time (current-time))
(random-bytes (make-vector 16 0))
(hash (secure-hash 'sha256 (concat (format "%s" time)
(format "%s" random-bytes))))
(uuid (format "%08x-%04x-%04x-%04x-%012x"
(string-to-number (substring hash 0 8) 16)
(string-to-number (substring hash 8 12) 16)
(string-to-number (substring hash 12 16) 16)
(logior (string-to-number (substring hash 16 20) 16) #b01000000)
(string-to-number (substring hash 20 32) 16))))
(insert uuid)
(when universal-arg
(kill-new uuid)
(message "%s is copied." uuid))
(message "UUID generated: %s" uuid)))
;; { -- START: for my/quick-insert-uuid-link
;; From ChatGPT,
;; The concat function in (let ((uuid (concat "id:" (current-kill 0)))) adds the
;; "id:" prefix only once, so there will be no situation where the link is
;; duplicated.
;; In addition, the org-insert-link function also checks for existing "id:"
;; prefixes, so it will not add another one if the UUID already starts with
;; "id:".
;; Here's the relevant code from the org-insert-link function:
;; (cond ((string-match-p (rx bos "id:") link)
;; (concat "[" desc "]" link))
;; ((string-match-p (rx bos "attachment:") link)
;; (concat "[" desc "]" link))
;; (t
;; (concat "[" desc "]" (org-make-link-string link type link))))
;; As you can see, if the link already starts with "id:", it simply concatenates
;; the description and the link and returns it. Otherwise, it constructs a link
;; string using org-make-link-string.
(defun my/quick-insert-uuid-link (&optional universal-arg)
"Insert a link to the UUID on the kill ring.
Prompt for a link name if UNIVERSAL-ARG is non-nil.
Usage:
M-x my/quick-insert-uuid-link Insert anonymous link
C-u M-x my/quick-insert-uuid-link Prompt for link name
Version 2023-04-18"
(interactive "P")
(let ((uuid (concat "id:" (current-kill 0))))
(if universal-arg
(org-insert-link "id" uuid (read-string "Link name: "))
(org-insert-link "id" uuid nil))))
;; -- END: for my/quick-insert-uuid-link }
(provide 'init-uuid)
;; Local Variables:
;; coding: utf-8
;; End:
;;; init-uuid.el ends here

203
lisp/init-veracrypt.el
View File

@ -1,203 +0,0 @@
;;; init-veracrypt.el --- VeraCrypt/TrueCrypt settings -*- lexical-binding: t -*-
;;; Commentary:
;;; Code:
;; {{ START: VeraCrypt Volume mounting
(require 'org-element)
(defun my-drive-letter-in-use-p (drive-letter)
"Check if a Drive Letter is in use on Windows."
(let ((result (shell-command-to-string
(concat
"powershell -command \"Test-Path '" drive-letter":' -IsValid\""))))
(if (string-match-p "True" result)
t
nil)))
(defun my-find-available-drive-letter ()
"Find an available Drive Letter on Windows."
(catch 'drive-letter-found
(mapc (lambda (code)
(let ((drive-letter (format "%c" code)))
(message "Checking Drive %s -> %s"
drive-letter (my-drive-letter-in-use-p drive-letter))
(unless (my-drive-letter-in-use-p drive-letter)
(throw 'drive-letter-found drive-letter))))
(number-sequence ?D ?Z)))) ; A, B, C are not available on TrueCrypt
; and also they are reserved for floppy,
; primary, secondary
(defun my/mount-veracrypt-volume (mode drive-option
&optional volume-path drive-letter use-point-link truecrypt
passphrase keyfiles)
"Mount a VeraCrypt or TrueCrypt volume in the selected MODE and assign DRIVE-LETTER automatically.
If USE-POINT-LINK is non-nil, use the volume link at point instead of prompting.
MODE can be 'read-only' or 'write'.
DRIVE-OPTION can be 'auto' or 'specify'.
VOLUME-PATH is the path to the VeraCrypt/TrueCrypt volume.
DRIVE-LETTER is the desired drive letter (e.g., 'D').
USE-POINT-LINK is non-nil to use the volume link at point.
TRUECRYPT is non-nil to use TrueCrypt instead of VeraCrypt.
PASSPHRASE is the passphrase for the volume.
KEYFILES is a list of keyfiles for the volume.
Version 2023-08-07
Updated 2023-08-15"
;; Usage:
;; (my/mount-veracrypt-volume "read-only" "auto" "/path/to/volume")
;; (my/mount-veracrypt-volume "read-only" "specify" "/path/to/volume" "D")
;; (my/mount-veracrypt-volume "read-only" "auto" "/path/to/volume" nil nil t)
;; (my/mount-veracrypt-volume "read-only" "auto" "/path/to/volume" nil nil t "test" '("/path/to/keyfile"))
;; (my/mount-veracrypt-volume "read-only" "auto" "/path/to/volume" nil nil t "test" '("/path/to/keyfile1" "/path/to/keyfile2"))
(interactive
(let ((universal-arg current-prefix-arg)
(mode (completing-read "Select mode: " '("read-only" "write")))
(drive-option
(completing-read "Select Drive Letter assignment option: "
'("auto" "specify"))))
(if (equal '(4) universal-arg) ; Check for universal argument
(list mode drive-option
nil ; volume-path
;; drive-letter
(if (equal drive-option "specify")
(read-string "Specify the Drive Letter: ")
nil)
t ; pass t for use-point-link
)
(list mode drive-option
;; volume-path
(read-file-name "Enter the path to the VeraCrypt/TrueCrypt volume: ")
;; drive-letter
(if (equal drive-option "specify")
(read-string "Specify the Drive Letter: ")
nil)
nil ; use-point-link
))))
(if (or (executable-find "veracrypt") (executable-find "truecrypt"))
(let* ((is-windows (eq system-type 'windows-nt))
(is-macos (eq system-type 'darwin))
(is-linux (eq system-type 'gnu/linux))
(mode-abbrev (if (equal mode "read-only") "ro"
(if (equal mode "write") "ts"
(error "Invalid mode"))))
(abs-volume-path (if use-point-link
(let* ((link-info (org-element-context))
(path (org-element-property :path link-info))
(abs-path (if (string-prefix-p "file:" path)
(file-truename
(replace-regexp-in-string "^file:" "" path))
(file-truename path))))
(if (and abs-path (file-exists-p abs-path))
abs-path
(user-error "Invalid or non-existent link at point")))
volume-path))
(final-drive-letter (if (equal drive-option "specify")
(when is-windows
(if (string-match-p "[D-Z]" drive-letter)
drive-letter
(user-error "Invalid Drive Letter format")))
(if (equal drive-option "auto")
(my-find-available-drive-letter)
"auto")))
(vera-or-true (if truecrypt "truecrypt" "veracrypt")))
(if (and abs-volume-path (file-exists-p abs-volume-path))
(let ((command (if is-windows
(format "%s /q /m %s /v \"%s\" %s %s %s"
vera-or-true
mode-abbrev
;; fix the path for Windows
(subst-char-in-string ?/ ?\\ abs-volume-path)
(if (not (equal final-drive-letter "auto"))
(format "/a /l %s" final-drive-letter)
(format "/a /l %s" (my-find-available-drive-letter)))
(if passphrase (format "/p %s" passphrase) "")
(if keyfiles
(mapconcat (lambda (file)
(format "/k \"%s\""
;; fix the path for Windows
(subst-char-in-string ?/ ?\\ file)))
keyfiles
" ")
""))
(if (or is-macos is-linux)
(format "%s -q -m %s -v \"%s\" %s %s %s"
vera-or-true
mode-abbrev
abs-volume-path
(if (not (equal final-drive-letter "auto"))
(format "-a -l %s" final-drive-letter)
"-a")
(if passphrase (format "-p %s" passphrase) "")
(if keyfiles
(mapconcat (lambda (file)
(format "-k \"%s\"" keyfiles))
keyfiles
" ")
""))
(user-error "Unknown platform")))))
(message command)
(my-async-shell-command-with-unique-buffer-name command))
(user-error "Volume does not exist")))
(user-error "Neither VeraCrypt nor TrueCrypt is installed")))
;; END: VeraCrypt Volume mounting }}
(defun my/dismount-tc-vc-volume (volume-path &optional use-truecrypt)
"Dismount a TrueCrypt or VeraCrypt volume at the given Drive Letter.
If called with a universal argument (C-u), TrueCrypt will be used; otherwise, VeraCrypt will be used.
Version 2023-08-10"
;; Usage:
;; (my/dismount-tc-vc-volume "A")
;; (my/dismount-tc-vc-volume "K" t)
(interactive
(let* ((use-truecrypt (if current-prefix-arg t nil))
(prompt (if use-truecrypt "TrueCrypt" "VeraCrypt"))
(volume-prompt (format "Enter the Drive Letter to the %s Volume to dismount: " prompt)))
(list
(read-string volume-prompt)
use-truecrypt)))
(let* ((crypt-command (if use-truecrypt "truecrypt" "veracrypt"))
(command ""))
(cond
((eq system-type 'windows-nt)
(setq command (format "%s /q /d %s" crypt-command volume-path)))
((or (eq system-type 'darwin)
(eq system-type 'gnu/linux))
(setq command (format "%s -q -d %s" crypt-command volume-path)))
(t
(message "Unsupported system type")))
(my-async-shell-command-with-unique-buffer-name command)))
(provide 'init-veracrypt)
;; Local Variables:
;; coding: utf-8
;; End:
;;; init-veracrypt.el ends here

2
site-lisp/use-package

@ -1 +1 @@
Subproject commit a6e856418d2ebd053b34e0ab2fda328abeba731c
Subproject commit 77945e002f11440eae72d8730d3de218163d551e

181
themes/doom-monokai-classic-theme.el Normal file
View File

@ -0,0 +1,181 @@
;; doom-monokai-classic-theme.el --- inspired by Textmate's Monokai -*- lexical-binding: t; no-byte-compile: t; -*-
(require 'doom-themes)
;;
(defgroup doom-monokai-classic-theme nil
"Options for doom-molokai."
:group 'doom-themes)
(defcustom doom-monokai-classic-brighter-comments nil
"If non-nil, comments will be highlighted in more vivid colors."
:group 'doom-monokai-classic-theme
:type 'boolean)
(defcustom doom-monokai-classic-comment-bg doom-monokai-classic-brighter-comments
"If non-nil, comments will have a subtle, darker background. Enhancing their
legibility."
:group 'doom-monokai-classic-theme
:type 'boolean)
(defcustom doom-monokai-classic-padded-modeline doom-themes-padded-modeline
"If non-nil, adds a 4px padding to the mode-line. Can be an integer to
determine the exact padding."
:group 'doom-monokai-classic-theme
:type '(choice integer boolean))
;;
(def-doom-theme doom-monokai-classic
"A dark, vibrant theme inspired by Textmate's Monokai."
;; name gui 256 16
;; ((bg '("#272822" nil nil ))
;; (bg-alt '("#1D1E19" nil nil ))
((bg '("#1B1D1F" nil nil ))
(bg-alt '("#283639" nil nil ))
(base0 '("#1B2229" "black" "black" ))
(base1 '("#161613" "#101010" "brightblack"))
(base2 '("#1D1F20" "#191919" "brightblack"))
(base3 '("#2D2E2E" "#252525" "brightblack"))
(base4 '("#4E4E4E" "#454545" "brightblack"))
(base5 '("#555556" "#6B6B6B" "brightblack"))
(base6 '("#767679" "#7B7B7B" "brightblack"))
(base7 '("#CFC0C5" "#C1C1C1" "brightblack"))
(base8 '("#FFFFFF" "#FFFFFF" "brightwhite"))
(fg '("#F8F8F2" "#DFDFDF" "brightwhite"))
(fg-alt '("#556172" "#4D4D4D" "white"))
(grey '("#525254" "#525254" "brightblack"))
(red '("#E74C3C" "#E74C3C" "red"))
(orange '("#FD971F" "#FD971F" "brightred"))
(green '("#A6E22E" "#A6E22E" "green"))
(teal green)
(yellow '("#E6DB74" "#E6DB74" "yellow"))
(blue '("#268bd2" "#268bd2" "brightblue"))
(dark-blue '("#727280" "#727280" "blue"))
(magenta '("#F92660" "#F92660" "magenta"))
(violet '("#9C91E4" "#9C91E4" "brightmagenta"))
(cyan '("#66D9EF" "#66D9EF" "brightcyan"))
(dark-cyan '("#8FA1B3" "#8FA1B3" "cyan"))
;; face categories
(highlight orange)
(vertical-bar (doom-lighten bg 0.1))
(selection base5)
(builtin orange)
(comments (if doom-monokai-classic-brighter-comments violet base5))
(doc-comments (if doom-monokai-classic-brighter-comments (doom-lighten violet 0.1) (doom-lighten base5 0.25)))
(constants violet)
(functions green)
(keywords magenta)
(methods green)
(operators magenta)
(type cyan)
(strings yellow)
(variables fg)
(numbers violet)
(region base4)
(error red)
(warning yellow)
(success green)
(vc-modified cyan)
(vc-added (doom-darken green 0.15))
(vc-deleted red)
;; custom categories
(hidden `(,(car bg) "black" "black"))
(-modeline-pad
(when doom-monokai-classic-padded-modeline
(if (integerp doom-monokai-classic-padded-modeline) doom-monokai-classic-padded-modeline 4)))
(modeline-fg nil)
(modeline-fg-alt base4)
(modeline-bg base1)
(modeline-bg-inactive (doom-darken base2 0.2))
(org-quote `(,(doom-lighten (car bg) 0.05) "#1f1f1f")))
;;;; Base theme face overrides
((cursor :background magenta)
((font-lock-comment-face &override) :slant 'italic)
((font-lock-type-face &override) :slant 'italic)
(lazy-highlight :background violet :foreground base0 :distant-foreground base0 :bold bold)
((line-number &override) :foreground base5 :distant-foreground nil)
((line-number-current-line &override) :foreground base7 :distant-foreground nil)
(mode-line
:background modeline-bg :foreground modeline-fg
:box (if -modeline-pad `(:line-width ,-modeline-pad :color modeline-bg)))
(mode-line-inactive
:background modeline-bg-inactive :foreground modeline-fg-alt
:box (if -modeline-pad `(:line-width ,-modeline-pad :color modeline-bg-inactive)))
;;;; centaur-tabs
(centaur-tabs-selected-modified :inherit 'centaur-tabs-selected
:background bg
:foreground yellow)
(centaur-tabs-unselected-modified :inherit 'centaur-tabs-unselected
:background bg-alt
:foreground yellow)
(centaur-tabs-active-bar-face :background yellow)
(centaur-tabs-modified-marker-selected :inherit 'centaur-tabs-selected :foreground fg)
(centaur-tabs-modified-marker-unselected :inherit 'centaur-tabs-unselected :foreground fg)
;;;; css-mode <built-in> / scss-mode
(css-proprietary-property :foreground keywords)
;;;; doom-modeline
(doom-modeline-bar :background yellow)
(doom-modeline-buffer-file :inherit 'mode-line-buffer-id :weight 'bold)
(doom-modeline-buffer-path :inherit 'bold :foreground green)
(doom-modeline-buffer-project-root :foreground green :weight 'bold)
(doom-modeline-buffer-modified :inherit 'bold :foreground orange)
(isearch :foreground base0 :background green)
;;;; ediff <built-in>
(ediff-fine-diff-A :background (doom-blend magenta bg 0.3) :weight 'bold)
;;;; evil
(evil-search-highlight-persist-highlight-face :background violet)
;;;; evil-snipe
(evil-snipe-first-match-face :foreground base0 :background green)
(evil-snipe-matches-face :foreground green :underline t)
;;;; flycheck
(flycheck-error :underline `(:style wave :color ,red) :background base3)
(flycheck-warning :underline `(:style wave :color ,yellow) :background base3)
(flycheck-info :underline `(:style wave :color ,green) :background base3)
;;;; helm
(helm-swoop-target-line-face :foreground magenta :inverse-video t)
;;;; ivy
(ivy-current-match :background base3)
(ivy-minibuffer-match-face-1 :background base1 :foreground base4)
;;;; markdown-mode
(markdown-blockquote-face :inherit 'italic :foreground dark-blue)
(markdown-list-face :foreground magenta)
(markdown-pre-face :foreground cyan)
(markdown-link-face :inherit 'bold :foreground blue)
((markdown-code-face &override) :background (doom-lighten base2 0.045))
;;;; neotree
(neo-dir-link-face :foreground cyan)
(neo-expand-btn-face :foreground magenta)
;;;; outline <built-in>
((outline-1 &override) :foreground magenta)
((outline-2 &override) :foreground orange)
;;;; org <built-in>
(org-ellipsis :foreground orange)
(org-tag :foreground yellow :bold nil)
((org-quote &override) :inherit 'italic :foreground base7 :background org-quote)
(org-todo :foreground yellow :bold 'inherit)
(org-list-dt :foreground yellow)
;;;; rainbow-delimiters
(rainbow-delimiters-depth-1-face :foreground magenta)
(rainbow-delimiters-depth-2-face :foreground orange)
(rainbow-delimiters-depth-3-face :foreground green)
(rainbow-delimiters-depth-4-face :foreground cyan)
(rainbow-delimiters-depth-5-face :foreground magenta)
(rainbow-delimiters-depth-6-face :foreground orange)
(rainbow-delimiters-depth-7-face :foreground green))
;;;; Base theme variable overrides
;; ()
)
;;; doom-monokai-classic-theme.el ends here