From 092304d9e0ccc37cc0ddaa9b136457e56a1cac20 Mon Sep 17 00:00:00 2001 From: Craig Jennings Date: Sun, 12 Oct 2025 11:47:26 -0500 Subject: changing repositories --- modules/ai-config.el | 419 +++++++++++++ modules/ai-conversations.el | 277 ++++++++ modules/auth-config.el | 45 ++ modules/calibredb-epub-config.el | 223 +++++++ modules/chrono-tools.el | 118 ++++ modules/config-utilities.el | 291 +++++++++ modules/custom-functions.el | 1012 ++++++++++++++++++++++++++++++ modules/dashboard-config.el | 144 +++++ modules/diff-config.el | 53 ++ modules/dirvish-config.el | 403 ++++++++++++ modules/dwim-shell-config.el | 732 +++++++++++++++++++++ modules/elfeed-config.el | 290 +++++++++ modules/eradio-config.el | 36 ++ modules/erc-config.el | 317 ++++++++++ modules/eshell-vterm-config.el | 229 +++++++ modules/eww-config.el | 153 +++++ modules/external-open.el | 129 ++++ modules/flycheck-config.el | 99 +++ modules/flyspell-and-abbrev.el | 211 +++++++ modules/font-config.el | 283 +++++++++ modules/games-config.el | 60 ++ modules/help-config.el | 108 ++++ modules/help-utils.el | 77 +++ modules/host-environment.el | 116 ++++ modules/httpd-config.el | 26 + modules/jumper.el | 177 ++++++ modules/keybindings.el | 100 +++ modules/keyboard-macros.el | 97 +++ modules/latex-config.el | 56 ++ modules/ledger-config.el | 50 ++ modules/lipsum-generator.el | 239 +++++++ modules/local-repository.el | 53 ++ modules/lorem-generator.el | 244 +++++++ modules/mail-config.el | 341 ++++++++++ modules/markdown-config.el | 47 ++ modules/media-utils.el | 187 ++++++ modules/modeline-config.el | 55 ++ modules/mu4e-org-contacts-integration.el | 167 +++++ modules/mu4e-org-contacts-setup.el | 24 + modules/music-config.el | 597 ++++++++++++++++++ modules/org-agenda-config.el | 290 +++++++++ modules/org-babel-config.el | 151 +++++ modules/org-capture-config.el | 143 +++++ modules/org-config.el | 267 ++++++++ modules/org-contacts-config.el | 205 ++++++ modules/org-drill-config.el | 109 ++++ modules/org-export-config.el | 162 +++++ modules/org-gcal-config.el | 92 +++ modules/org-noter-config.el | 60 ++ modules/org-refile-config.el | 78 +++ modules/org-roam-config.el | 178 ++++++ modules/org-webclipper.el | 145 +++++ modules/pdf-config.el | 59 ++ modules/prog-c.el | 32 + modules/prog-general.el | 299 +++++++++ modules/prog-go.el | 41 ++ modules/prog-lisp.el | 126 ++++ modules/prog-lsp.el | 55 ++ modules/prog-python.el | 81 +++ modules/prog-shell.el | 15 + modules/prog-training.el | 35 ++ modules/prog-webdev.el | 120 ++++ modules/prog-yaml.el | 18 + modules/quick-video-capture.el | 104 +++ modules/reconcile-open-repos.el | 72 +++ modules/selection-framework.el | 264 ++++++++ modules/show-kill-ring.el | 125 ++++ modules/system-defaults.el | 243 +++++++ modules/system-utils.el | 202 ++++++ modules/test-runner.el | 270 ++++++++ modules/text-config.el | 121 ++++ modules/tramp-config.el | 135 ++++ modules/ui-config.el | 141 +++++ modules/ui-navigation.el | 154 +++++ modules/ui-theme.el | 135 ++++ modules/undead-buffers.el | 181 ++++++ modules/user-constants.el | 180 ++++++ modules/vc-config.el | 131 ++++ modules/video-audio-recording.el | 184 ++++++ modules/weather-config.el | 40 ++ modules/wip.el | 121 ++++ modules/wrap-up.el | 30 + 82 files changed, 13879 insertions(+) create mode 100644 modules/ai-config.el create mode 100644 modules/ai-conversations.el create mode 100644 modules/auth-config.el create mode 100644 modules/calibredb-epub-config.el create mode 100644 modules/chrono-tools.el create mode 100644 modules/config-utilities.el create mode 100644 modules/custom-functions.el create mode 100644 modules/dashboard-config.el create mode 100644 modules/diff-config.el create mode 100644 modules/dirvish-config.el create mode 100644 modules/dwim-shell-config.el create mode 100644 modules/elfeed-config.el create mode 100644 modules/eradio-config.el create mode 100644 modules/erc-config.el create mode 100644 modules/eshell-vterm-config.el create mode 100644 modules/eww-config.el create mode 100644 modules/external-open.el create mode 100644 modules/flycheck-config.el create mode 100644 modules/flyspell-and-abbrev.el create mode 100644 modules/font-config.el create mode 100644 modules/games-config.el create mode 100644 modules/help-config.el create mode 100644 modules/help-utils.el create mode 100644 modules/host-environment.el create mode 100644 modules/httpd-config.el create mode 100644 modules/jumper.el create mode 100644 modules/keybindings.el create mode 100644 modules/keyboard-macros.el create mode 100644 modules/latex-config.el create mode 100644 modules/ledger-config.el create mode 100644 modules/lipsum-generator.el create mode 100644 modules/local-repository.el create mode 100644 modules/lorem-generator.el create mode 100644 modules/mail-config.el create mode 100644 modules/markdown-config.el create mode 100644 modules/media-utils.el create mode 100644 modules/modeline-config.el create mode 100644 modules/mu4e-org-contacts-integration.el create mode 100644 modules/mu4e-org-contacts-setup.el create mode 100644 modules/music-config.el create mode 100644 modules/org-agenda-config.el create mode 100644 modules/org-babel-config.el create mode 100644 modules/org-capture-config.el create mode 100644 modules/org-config.el create mode 100644 modules/org-contacts-config.el create mode 100644 modules/org-drill-config.el create mode 100644 modules/org-export-config.el create mode 100644 modules/org-gcal-config.el create mode 100644 modules/org-noter-config.el create mode 100644 modules/org-refile-config.el create mode 100644 modules/org-roam-config.el create mode 100644 modules/org-webclipper.el create mode 100644 modules/pdf-config.el create mode 100644 modules/prog-c.el create mode 100644 modules/prog-general.el create mode 100644 modules/prog-go.el create mode 100644 modules/prog-lisp.el create mode 100644 modules/prog-lsp.el create mode 100644 modules/prog-python.el create mode 100644 modules/prog-shell.el create mode 100644 modules/prog-training.el create mode 100644 modules/prog-webdev.el create mode 100644 modules/prog-yaml.el create mode 100644 modules/quick-video-capture.el create mode 100644 modules/reconcile-open-repos.el create mode 100644 modules/selection-framework.el create mode 100644 modules/show-kill-ring.el create mode 100644 modules/system-defaults.el create mode 100644 modules/system-utils.el create mode 100644 modules/test-runner.el create mode 100644 modules/text-config.el create mode 100644 modules/tramp-config.el create mode 100644 modules/ui-config.el create mode 100644 modules/ui-navigation.el create mode 100644 modules/ui-theme.el create mode 100644 modules/undead-buffers.el create mode 100644 modules/user-constants.el create mode 100644 modules/vc-config.el create mode 100644 modules/video-audio-recording.el create mode 100644 modules/weather-config.el create mode 100644 modules/wip.el create mode 100644 modules/wrap-up.el (limited to 'modules') diff --git a/modules/ai-config.el b/modules/ai-config.el new file mode 100644 index 00000000..ef574412 --- /dev/null +++ b/modules/ai-config.el @@ -0,0 +1,419 @@ +;;; ai-config.el --- Configuration for AI Integrations -*- lexical-binding: t; coding: utf-8; -*- +;; author Craig Jennings +;; +;;; Commentary: +;; Configuration for AI integrations in Emacs, focused on GPTel. +;; +;; Main Features: +;; - Quick toggle for AI assistant window (F9 or M-a t) +;; - Custom keymap (M-a prefix, overrides 'backwards-sentence') for AI-related commands. +;; - Enhanced org-mode conversation formatting with timestamps +;; allows switching models and easily compare and track responses. +;; - Various specialized AI directives (coder, reviewer, etc.) +;; - Context management for adding files/buffers to conversations +;; - Conversation persistence with save/load functionality +;; - Integration with Magit for code review +;; +;; Basic Workflow +;; +;; Using a side-chat window: +;; - Launch GPTel via F9 or M-a t, and chat in the AI-Assistant side window (C- to send) +;; - Change system prompt (expertise, personalities) with M-a p +;; - Add context from files (M-a f) or buffers (M-a b) +;; - Save conversations with M-a s, load previous ones with M-a l +;; - Clear the conversation and start over with M-a x +;; Or in any buffer: +;; - Add directive as above, and select a region to rewrite with M-a r. +;; + +;;; Code: + +(autoload 'cj/gptel-save-conversation "ai-conversations" "Save the AI conversation to a file." t) +(autoload 'cj/gptel-load-conversation "ai-conversations" "Load a saved AI conversation." t) +(autoload 'cj/gptel-delete-conversation "ai-conversations" "Delete a saved AI conversation." t) + +(with-eval-after-load 'gptel + (require 'ai-conversations)) + +;;; ------------------------- AI Config Helper Functions ------------------------ + +;; Define all our variables upfront +(defvar cj/anthropic-api-key-cached nil "Cached Anthropic API key.") +(defvar cj/openai-api-key-cached nil "Cached OpenAI API key.") +(defvar gptel-claude-backend nil "Claude backend, lazy-initialized.") +(defvar gptel-chatgpt-backend nil "ChatGPT backend, lazy-initialized.") + + +(defun cj/auth-source-secret (host user) + "Fetch a secret from auth-source for HOST and USER. + +HOST and USER must be strings that identify the credential to return." + (let* ((found (auth-source-search :host host :user user :require '(:secret) :max 1)) + (secret (plist-get (car found) :secret))) + (cond + ((functionp secret) (funcall secret)) + ((stringp secret) secret) + (t (error "No usable secret found for host %s and user %s" host user))))) + +(defun cj/anthropic-api-key () + "Return the Anthropic API key, caching the result after first retrieval." + (or cj/anthropic-api-key-cached + (setq cj/anthropic-api-key-cached + (cj/auth-source-secret "api.anthropic.com" "apikey")))) + +(defun cj/openai-api-key () + "Return the OpenAI API key, caching the result after first retrieval." + (or cj/openai-api-key-cached + (setq cj/openai-api-key-cached + (cj/auth-source-secret "api.openai.com" "apikey")))) + +(defun cj/ensure-gptel-backends () + "Initialize GPTel backends if they are not already available. + +Call this only after loading 'gptel' so the backend constructors exist." + (unless gptel-claude-backend + (setq gptel-claude-backend + (gptel-make-anthropic + "Claude" + :key (cj/anthropic-api-key) + :models '( + "claude-opus-4-1-20250805" + "claude-3-5-sonnet-20241022" + "claude-3-opus-20240229" + "claude-3-5-haiku-20241022" + ) + :stream t))) + (unless gptel-chatgpt-backend + (setq gptel-chatgpt-backend + (gptel-make-openai + "ChatGPT" + :key (cj/openai-api-key) + :models '( + "gpt-4o" + "gpt-5" + "gpt-4.1" + "o1" + ) + :stream t))) + ;; Set default backend + (unless gptel-backend + (setq gptel-backend (or gptel-chatgpt-backend gptel-claude-backend)))) + +(autoload 'cj/toggle-gptel "ai-config" "Toggle the AI-Assistant window" t) + +;; ------------------ Gptel Conversation And Utility Commands ------------------ + +(defun cj/gptel--available-backends () + "Return an alist of (NAME . BACKEND), ensuring gptel and backends are initialized." + (unless (featurep 'gptel) + (require 'gptel)) + (cj/ensure-gptel-backends) + (delq nil + (list (and (bound-and-true-p gptel-claude-backend) + (cons "Anthropic - Claude" gptel-claude-backend)) + (and (bound-and-true-p gptel-chatgpt-backend) + (cons "OpenAI - ChatGPT" gptel-chatgpt-backend))))) + +(defun cj/gptel--model->string (m) + (cond + ((stringp m) m) + ((symbolp m) (symbol-name m)) + (t (format "%s" m)))) + +;; Backend/model switching commands (moved out of use-package so they are commandp) +(defun cj/gptel-change-model () + "Change the GPTel backend and select a model from that backend. + +Present all available models from every backend, switching backends when +necessary. Prompt for whether to apply the selection globally or buffer-locally." + (interactive) + (let* ((backends (cj/gptel--available-backends)) + (all-models + (mapcan + (lambda (pair) + (let* ((backend-name (car pair)) + (backend (cdr pair)) + (models (when (fboundp 'gptel-backend-models) + (gptel-backend-models backend)))) + (mapcar (lambda (m) + (list (format "%s: %s" backend-name (cj/gptel--model->string m)) + backend + (cj/gptel--model->string m) + backend-name)) + models))) + backends)) + (current-backend-name (car (rassoc (bound-and-true-p gptel-backend) backends))) + (current-selection (format "%s: %s" + (or current-backend-name "AI") + (cj/gptel--model->string (bound-and-true-p gptel-model)))) + (scope (completing-read "Set model for: " '("buffer" "global") nil t)) + (selected (completing-read + (format "Select model (current: %s): " current-selection) + (mapcar #'car all-models) nil t nil nil current-selection))) + (let* ((model-info (assoc selected all-models)) + (backend (nth 1 model-info)) + (model (intern (nth 2 model-info))) ;; Convert string to symbol + (backend-name (nth 3 model-info))) + (if (string= scope "global") + (progn + (setq gptel-backend backend) + (setq gptel-model model) + (message "Changed to %s model: %s (global)" backend-name model)) + (setq-local gptel-backend backend) + (setq-local gptel-model (if (stringp model) (intern model) model)) + (message "Changed to %s model: %s (buffer-local)" backend-name model))))) + +(defun cj/gptel-switch-backend () + "Switch the GPTel backend and then choose one of its models." + (interactive) + (let* ((backends (cj/gptel--available-backends)) + (choice (completing-read "Select GPTel backend: " (mapcar #'car backends) nil t)) + (backend (cdr (assoc choice backends)))) + (unless backend + (user-error "Invalid GPTel backend: %s" choice)) + (let* ((models (when (fboundp 'gptel-backend-models) + (gptel-backend-models backend))) + (model (completing-read (format "Select %s model: " choice) + (mapcar #'cj/gptel--model->string models) + nil t nil nil (cj/gptel--model->string (bound-and-true-p gptel-model))))) + (setq gptel-backend backend + gptel-model model) + (message "Switched to %s with model: %s" choice model)))) + +;; Clear assistant buffer (moved out so it's always available) +(defun cj/gptel-clear-buffer () + "Erase the current GPTel buffer while preserving the initial Org heading. + +Operate only when `gptel-mode' is active in an Org buffer so the heading +can be reinserted." + (interactive) + (let ((is-gptel (bound-and-true-p gptel-mode)) + (is-org (derived-mode-p 'org-mode))) + (if (and is-gptel is-org) + (progn + (erase-buffer) + (when (fboundp 'cj/gptel--fresh-org-prefix) + (insert (cj/gptel--fresh-org-prefix))) + (message "GPTel buffer cleared and heading reset")) + (message "Not a GPTel buffer in org-mode. Nothing cleared.")))) + +;; ----------------------------- Context Management ---------------------------- + +(defun cj/gptel--add-file-to-context (file-path) + "Add FILE-PATH to the GPTel context. + +Returns t on success, nil on failure. +Provides consistent user feedback about the context state." + (when (and file-path (file-exists-p file-path)) + (gptel-add-file file-path) + (let ((context-count (if (boundp 'gptel-context--alist) + (length gptel-context--alist) + 0))) + (message "Added %s to GPTel context (%d sources total)" + (file-name-nondirectory file-path) + context-count)) + t)) + +(defun cj/gptel-add-file () + "Add a file to the GPTel context. + +If inside a Projectile project, prompt from that project's file list. +Otherwise, prompt with `read-file-name'." + (interactive) + (let* ((in-proj (and (featurep 'projectile) + (fboundp 'projectile-project-p) + (projectile-project-p))) + (file-name (if in-proj + (let ((cands (projectile-current-project-files))) + (if (fboundp 'projectile-completing-read) + (projectile-completing-read "GPTel add file: " cands) + (completing-read "GPTel add file: " cands nil t))) + (read-file-name "GPTel add file: "))) + (file-path (if in-proj + (expand-file-name file-name (projectile-project-root)) + file-name))) + (unless (cj/gptel--add-file-to-context file-path) + (error "Failed to add file: %s" file-path)))) + +(defun cj/gptel-add-buffer-file () + "Select a buffer and add its associated file to the GPTel context. + +Lists all open buffers for selection. If the selected buffer is visiting +a file, that file is added to the GPTel context. Otherwise, an error +message is displayed." + (interactive) + (let* ((buffers (mapcar #'buffer-name (buffer-list))) + (selected-buffer-name (completing-read "Add file from buffer: " buffers nil t)) + (selected-buffer (get-buffer selected-buffer-name)) + (file-path (and selected-buffer + (buffer-file-name selected-buffer)))) + (if file-path + (cj/gptel--add-file-to-context file-path) + (message "Buffer '%s' is not visiting a file" selected-buffer-name)))) + +(defun cj/gptel-add-this-buffer () + "Add the current buffer to the GPTel context. + +Works for any buffer, whether it's visiting a file or not." + (interactive) + ;; Load gptel-context if needed + (unless (featurep 'gptel-context) + (require 'gptel-context)) + ;; Use gptel-add with prefix arg '(4) to add current buffer + (gptel-add '(4)) + (message "Added buffer '%s' to GPTel context" (buffer-name))) + +;;; ---------------------------- GPTel Configuration ---------------------------- + +(use-package gptel + :defer t + :commands (gptel gptel-send gptel-menu) + :bind + (("" . cj/toggle-gptel) + :map gptel-mode-map + ("C-" . gptel-send)) + :custom + (gptel-default-mode 'org-mode) + (gptel-expert-commands t) + (gptel-track-media t) + ;; TODO: add reasoning to a buffer. See docstring. + (gptel-include-reasoning 'ignore) + (gptel-log-level 'info) + (gptel--debug nil) + :config + (cj/ensure-gptel-backends) + ;; Set ChatGPT as default after initialization + (setq gptel-backend gptel-chatgpt-backend) + + ;; Named backend list for switching + (defvar cj/gptel-backends + `(("Anthropic - Claude" . ,gptel-claude-backend) + ("OpenAI - ChatGPT" . ,gptel-chatgpt-backend)) + "Alist of GPTel backends for interactive switching.") + + (setq gptel-confirm-tool-calls nil) ;; allow tool access by default + ;;; ---------------------------- Backend Management --------------------------- + + (setq gptel-backend gptel-chatgpt-backend) ;; use ChatGPT as default + ;; (setq gptel-backend gptel-claude-backend) ;; use Claude as default + +;;; -------------------------- Org Header Construction -------------------------- + + ;; Dynamic user prefix for org-mode heading (string, refreshed just before send) + (defun cj/gptel--fresh-org-prefix () + "Generate a fresh org-mode header with current timestamp for user messages." + (concat "* " user-login-name " " (format-time-string "[%Y-%m-%d %H:%M:%S]") "\n")) + + ;; Initialize as a string (GPTel expectation) + (setf (alist-get 'org-mode gptel-prompt-prefix-alist) + (cj/gptel--fresh-org-prefix)) + + ;; Refresh immediately before each send for accurate timestamp + (defun cj/gptel--refresh-org-prefix (&rest _) + "Update the org-mode prefix with fresh timestamp before sending message." + (setf (alist-get 'org-mode gptel-prompt-prefix-alist) + (cj/gptel--fresh-org-prefix))) + (advice-add 'gptel-send :before #'cj/gptel--refresh-org-prefix) + + ;; AI header on each reply: (e.g. "*** AI: [timestamp]") + (defun cj/gptel-backend-and-model () + "Return backend, model, and timestamp as a single string." + (let* ((backend (pcase (bound-and-true-p gptel-backend) + ((and v (pred vectorp)) (aref v 1)) ;; display name if vector + (_ "AI"))) + (model (format "%s" (or (bound-and-true-p gptel-model) ""))) + (ts (format-time-string "[%Y-%m-%d %H:%M:%S]"))) + (format "%s: %s %s" backend model ts))) + + (defun cj/gptel-insert-model-heading (response-begin-pos _response-end-pos) + "Insert an Org heading for the AI reply at RESPONSE-BEGIN-POS." + (save-excursion + (goto-char response-begin-pos) + (insert (format "* %s\n" (cj/gptel-backend-and-model))))) + + (add-hook 'gptel-post-response-functions #'cj/gptel-insert-model-heading)) + +;;; ---------------------------- Toggle GPTel Window ---------------------------- + +(defun cj/toggle-gptel () + "Toggle the visibility of the AI-Assistant buffer, and place point at its end." + (interactive) + (let* ((buf-name "*AI-Assistant*") + (buffer (get-buffer buf-name)) + (win (and buffer (get-buffer-window buffer)))) + (if win + (delete-window win) + ;; Ensure GPTel and our backends are initialized before creating the buffer + (unless (featurep 'gptel) + (require 'gptel)) + (cj/ensure-gptel-backends) + (unless buffer + ;; Pass backend, not model + (gptel buf-name gptel-backend)) + (setq buffer (get-buffer buf-name)) + (setq win + (display-buffer-in-side-window + buffer + '((side . right) + (window-width . 0.4)))) + (select-window win) + (with-current-buffer buffer + (goto-char (point-max)))))) + +;; ------------------------------- Clear Context ------------------------------- + +(defun cj/gptel-context-clear () + "Clear all GPTel context sources, with compatibility across GPTel versions." + (interactive) + (cond + ((fboundp 'gptel-context-remove-all) + (call-interactively 'gptel-context-remove-all) + (message "GPTel context cleared")) + ((fboundp 'gptel-context-clear) + (call-interactively 'gptel-context-clear) + (message "GPTel context cleared")) + ((boundp 'gptel-context--alist) + (setq gptel-context--alist nil) + (message "GPTel context cleared")) + (t + (message "No known GPTel context clearing function available")))) + +;;; -------------------------------- GPTel-Magit -------------------------------- + +(use-package gptel-magit + :defer t + :hook (magit-mode . gptel-magit-install)) + +;; ------------------------------ GPTel Directives ----------------------------- + +(use-package gptel-prompts + :load-path (lambda () (expand-file-name "custom/" user-emacs-directory)) + :after gptel + :if (file-exists-p (expand-file-name "custom/gptel-prompts.el" user-emacs-directory)) + :custom + (gptel-prompts-directory (concat user-emacs-directory "ai-prompts")) + :config + (gptel-prompts-update) + (gptel-prompts-add-update-watchers)) + +;;; --------------------------------- AI Keymap --------------------------------- + +(define-prefix-command 'cj/ai-keymap nil + "Keymap for AI operations.") +(define-key cj/custom-keymap "a" 'cj/ai-keymap) +(define-key cj/ai-keymap "B" #'cj/gptel-switch-backend) ;; change the backend (OpenAI, Anthropic, etc.) +(define-key cj/ai-keymap "M" #'gptel-menu) ;; gptel's transient menu +(define-key cj/ai-keymap "d" #'cj/gptel-delete-conversation) ;; delete conversation +(define-key cj/ai-keymap "." #'cj/gptel-add-this-buffer) ;; add buffer to context +(define-key cj/ai-keymap "f" #'cj/gptel-add-file) ;; add a file to context +(define-key cj/ai-keymap "l" #'cj/gptel-load-conversation) ;; load and continue conversation +(define-key cj/ai-keymap "m" #'cj/gptel-change-model) ;; change the LLM model +(define-key cj/ai-keymap "p" #'gptel-system-prompt) ;; change prompt +(define-key cj/ai-keymap "&" #'gptel-rewrite) ;; rewrite a region of code/text +(define-key cj/ai-keymap "r" #'cj/gptel-context-clear) ;; remove all context +(define-key cj/ai-keymap "s" #'cj/gptel-save-conversation) ;; save conversation +(define-key cj/ai-keymap "t" #'cj/toggle-gptel) ;; toggles the ai-assistant window +(define-key cj/ai-keymap "x" #'cj/gptel-clear-buffer) ;; clears the assistant buffer + +(provide 'ai-config) +;;; ai-config.el ends here. diff --git a/modules/ai-conversations.el b/modules/ai-conversations.el new file mode 100644 index 00000000..92549176 --- /dev/null +++ b/modules/ai-conversations.el @@ -0,0 +1,277 @@ +;;; ai-conversations.el --- GPTel conversation persistence and autosave -*- lexical-binding: t; coding: utf-8; -*- +;; Author: Craig Jennings +;; Maintainer: Craig Jennings +;; Version 0.1 +;; Package-Requires: ((emacs "27.1")) +;; Keywords: convenience, tools +;; +;;; Commentary: +;; Provides conversation save/load/delete, autosave after responses, and +;; org-visibility headers for GPTel-powered assistant buffers. +;; +;; Loads lazily via autoloads for the interactive entry points. + +;;; Code: + +(defgroup cj/ai-conversations nil + "Conversation persistence for GPTel (save/load/delete, autosave)." + :group 'gptel + :prefix "cj/") + +(defcustom cj/gptel-conversations-directory + (expand-file-name "ai-conversations" user-emacs-directory) + "Directory where GPTel conversations are stored." + :type 'directory + :group 'cj/ai-conversations) + +(defcustom cj/gptel-conversations-window-side 'right + "Side to display the AI-Assistant buffer when loading a conversation." + :type '(choice (const :tag "Right" right) + (const :tag "Left" left) + (const :tag "Bottom" bottom) + (const :tag "Top" top)) + :group 'cj/ai-conversations) + +(defcustom cj/gptel-conversations-window-width 0.4 + "Set the side window width when loading a conversation. + +If displaying on the top or bottom, treat this value as a height fraction." + :type 'number + :group 'cj/ai-conversations) + +(defcustom cj/gptel-conversations-sort-order 'newest-first + "Sort order for conversation selection prompts." + :type '(choice (const :tag "Newest first" newest-first) + (const :tag "Oldest first" oldest-first)) + :group 'cj/ai-conversations) + +(defvar-local cj/gptel-autosave-enabled nil + "Non-nil means auto-save after each AI response in GPTel buffers.") + +(defvar-local cj/gptel-autosave-filepath nil + "File path used for auto-saving the conversation buffer.") + +(defcustom cj/gptel-conversations-autosave-on-send t + "Non-nil means auto-save the conversation immediately after `gptel-send'." + :type 'boolean + :group 'cj/ai-conversations) + +(defun cj/gptel--autosave-after-send (&rest _args) + "Auto-save current GPTel buffer right after `gptel-send' if enabled." + (when (and cj/gptel-conversations-autosave-on-send + (bound-and-true-p gptel-mode) + cj/gptel-autosave-enabled + (stringp cj/gptel-autosave-filepath) + (> (length cj/gptel-autosave-filepath) 0)) + (condition-case err + (cj/gptel--save-buffer-to-file (current-buffer) cj/gptel-autosave-filepath) + (error (message "cj/gptel autosave-on-send failed: %s" (error-message-string err)))))) + +(with-eval-after-load 'gptel + (unless (advice-member-p #'cj/gptel--autosave-after-send #'gptel-send) + (advice-add 'gptel-send :after #'cj/gptel--autosave-after-send))) + +(defun cj/gptel--slugify-topic (s) + "Return a filesystem-friendly slug for topic string S." + (let* ((down (downcase (or s ""))) + (repl (replace-regexp-in-string "[^a-z0-9]+" "-" down)) + (trim (replace-regexp-in-string "^-+\\|-+$" "" repl))) + (or (and (> (length trim) 0) trim) "conversation"))) + +(defun cj/gptel--existing-topics () + "Return topic slugs, without timestamps, present in the conversations directory." + (when (file-exists-p cj/gptel-conversations-directory) + (let* ((files (directory-files cj/gptel-conversations-directory nil "\\.gptel$"))) + (delete-dups + (mapcar + (lambda (f) + (replace-regexp-in-string "_[0-9]\\{8\\}-[0-9]\\{6\\}\\.gptel$" "" f)) + files))))) + +(defun cj/gptel--latest-file-for-topic (topic-slug) + "Return the newest saved conversation filename for TOPIC-SLUG, or nil." + (let* ((rx (format "^%s_[0-9]\\{8\\}-[0-9]\\{6\\}\\.gptel$" + (regexp-quote topic-slug))) + (files (and (file-exists-p cj/gptel-conversations-directory) + (directory-files cj/gptel-conversations-directory nil rx)))) + (car (sort files #'string>)))) + +(defun cj/gptel--timestamp-from-filename (filename) + "Return an Emacs timestamp extracted from FILENAME, or nil. + +Expect FILENAME to match _YYYYMMDD-HHMMSS.gptel." + (when (string-match "_\\([0-9]\\{8\\}\\)-\\([0-9]\\{6\\}\\)\\.gptel\\'" filename) + (let* ((date (match-string 1 filename)) + (time (match-string 2 filename)) + (Y (string-to-number (substring date 0 4))) + (M (string-to-number (substring date 4 6))) + (D (string-to-number (substring date 6 8))) + (h (string-to-number (substring time 0 2))) + (m (string-to-number (substring time 2 4))) + (s (string-to-number (substring time 4 6)))) + (encode-time s m h D M Y)))) + +(defun cj/gptel--conversation-candidates () + "Return conversation candidates sorted per `cj/gptel-conversations-sort-order'." + (unless (file-exists-p cj/gptel-conversations-directory) + (user-error "Conversations directory doesn't exist: %s" cj/gptel-conversations-directory)) + (let* ((files (directory-files cj/gptel-conversations-directory nil "\\.gptel$")) + (enriched + (mapcar + (lambda (f) + (let* ((full (expand-file-name f cj/gptel-conversations-directory)) + (ptime (or (cj/gptel--timestamp-from-filename f) + (nth 5 (file-attributes full)))) + (disp (format "%s [%s]" f (format-time-string "%Y-%m-%d %H:%M" ptime)))) + (list :file f :time ptime :display disp))) + files)) + (sorted + (sort enriched + (lambda (a b) + (let ((ta (plist-get a :time)) + (tb (plist-get b :time))) + (if (eq cj/gptel-conversations-sort-order 'newest-first) + (time-less-p tb ta) ;; tb earlier than ta => a first + (time-less-p ta tb)))))) + (cands (mapcar (lambda (pl) + (cons (plist-get pl :display) + (plist-get pl :file))) + sorted))) + cands)) + +(defun cj/gptel--save-buffer-to-file (buffer filepath) + "Save BUFFER content to FILEPATH with Org visibility properties." + (with-current-buffer buffer + (let ((content (buffer-string))) + (with-temp-buffer + (insert "#+STARTUP: showeverything\n") + (insert "#+VISIBILITY: all\n\n") + (insert content) + (write-region (point-min) (point-max) filepath nil 'silent)))) + filepath) + +(defun cj/gptel--ensure-ai-buffer () + "Return the *AI-Assistant* buffer, creating it via `gptel' if needed." + (let* ((buf-name "*AI-Assistant*") + (buffer (get-buffer buf-name))) + (unless buffer + (gptel buf-name)) + (or (get-buffer buf-name) + (user-error "Could not create or find *AI-Assistant* buffer")))) + +;;;###autoload +(defun cj/gptel-save-conversation () + "Save the current AI-Assistant buffer to a .gptel file. + +Enable autosave for subsequent AI responses to the same file." + (interactive) + (let ((buf (get-buffer "*AI-Assistant*"))) + (unless buf + (user-error "No AI-Assistant buffer found")) + (unless (file-exists-p cj/gptel-conversations-directory) + (make-directory cj/gptel-conversations-directory t) + (message "Created directory: %s" cj/gptel-conversations-directory)) + (let* ((topics (or (cj/gptel--existing-topics) '())) + (input (completing-read "Conversation topic: " topics nil nil)) + (topic-slug (cj/gptel--slugify-topic input)) + (latest (cj/gptel--latest-file-for-topic topic-slug)) + (use-existing (and latest + (y-or-n-p (format "Update existing file %s? " latest)))) + (filepath (if use-existing + (expand-file-name latest cj/gptel-conversations-directory) + (let* ((timestamp (format-time-string "%Y%m%d-%H%M%S")) + (filename (format "%s_%s.gptel" topic-slug timestamp))) + (expand-file-name filename cj/gptel-conversations-directory))))) + (cj/gptel--save-buffer-to-file buf filepath) + (with-current-buffer buf + (setq-local cj/gptel-autosave-filepath filepath) + (setq-local cj/gptel-autosave-enabled t)) + (message "Conversation saved to: %s" filepath)))) + +;;;###autoload +(defun cj/gptel-delete-conversation () + "Delete a saved GPTel conversation file (chronologically sorted candidates)." + (interactive) + (unless (file-exists-p cj/gptel-conversations-directory) + (user-error "Conversations directory doesn't exist: %s" cj/gptel-conversations-directory)) + (let* ((cands (cj/gptel--conversation-candidates))) + (unless cands + (user-error "No saved conversations found in %s" cj/gptel-conversations-directory)) + (let* ((completion-extra-properties '(:display-sort-function identity + :cycle-sort-function identity)) + (selection (completing-read "Delete conversation: " cands nil t)) + (filename (cdr (assoc selection cands))) + (filepath (and filename + (expand-file-name filename cj/gptel-conversations-directory)))) + (unless filename + (user-error "No conversation selected")) + (when (y-or-n-p (format "Really delete %s? " filename)) + (delete-file filepath) + (message "Deleted conversation: %s" filename))))) + +(defun cj/gptel--strip-visibility-headers () + "Strip org visibility headers at the top of the current buffer if present." + (save-excursion + (goto-char (point-min)) + (while (looking-at "^#\\+\\(STARTUP\\|VISIBILITY\\):.*\n") + (delete-region (match-beginning 0) (match-end 0))) + (when (looking-at "^\n+") + (delete-region (point) (match-end 0))))) + +;;;###autoload +(defun cj/gptel-load-conversation () + "Load a saved GPTel conversation into the AI-Assistant buffer. + +Prompt to save the current conversation first when appropriate, then enable autosave." + (interactive) + (let ((ai-buffer (get-buffer-create "*AI-Assistant*"))) + (when (and (with-current-buffer ai-buffer (> (buffer-size) 0)) + (with-current-buffer ai-buffer (bound-and-true-p gptel-mode))) + (when (y-or-n-p "Save current conversation before loading new one? ") + (with-current-buffer ai-buffer + (call-interactively #'cj/gptel-save-conversation))))) + (unless (file-exists-p cj/gptel-conversations-directory) + (user-error "Conversations directory doesn't exist: %s" cj/gptel-conversations-directory)) + (let* ((cands (cj/gptel--conversation-candidates))) + (unless cands + (user-error "No saved conversations found in %s" cj/gptel-conversations-directory)) + (let* ((completion-extra-properties '(:display-sort-function identity + :cycle-sort-function identity)) + (selection (completing-read "Load conversation: " cands nil t)) + (filename (cdr (assoc selection cands))) + (filepath (and filename + (expand-file-name filename cj/gptel-conversations-directory)))) + (unless filename + (user-error "No conversation selected")) + (with-current-buffer (cj/gptel--ensure-ai-buffer) + (erase-buffer) + (insert-file-contents filepath) + (cj/gptel--strip-visibility-headers) + (goto-char (point-max)) + (set-buffer-modified-p t) + (setq-local cj/gptel-autosave-filepath filepath) + (setq-local cj/gptel-autosave-enabled t)) + (let ((buf (get-buffer "*AI-Assistant*"))) + (unless (get-buffer-window buf) + (display-buffer-in-side-window + buf `((side . ,cj/gptel-conversations-window-side) + (window-width . ,cj/gptel-conversations-window-width))))) + (select-window (get-buffer-window "*AI-Assistant*")) + (message "Loaded conversation from: %s" filepath)))) + +(defun cj/gptel--autosave-after-response (&rest _args) + "Auto-save the current GPTel buffer when enabled." + (when (and (bound-and-true-p gptel-mode) + cj/gptel-autosave-enabled + (stringp cj/gptel-autosave-filepath) + (> (length cj/gptel-autosave-filepath) 0)) + (condition-case err + (cj/gptel--save-buffer-to-file (current-buffer) cj/gptel-autosave-filepath) + (error (message "cj/gptel autosave failed: %s" (error-message-string err)))))) + +(with-eval-after-load 'gptel + (unless (member #'cj/gptel--autosave-after-response gptel-post-response-functions) + (add-hook 'gptel-post-response-functions #'cj/gptel--autosave-after-response))) + +(provide 'ai-conversations) +;;; ai-conversations.el ends here diff --git a/modules/auth-config.el b/modules/auth-config.el new file mode 100644 index 00000000..a42bd52a --- /dev/null +++ b/modules/auth-config.el @@ -0,0 +1,45 @@ +;; auth-config.el --- Configuration for Authentication Utilities -*- lexical-binding: t; coding: utf-8; -*- +;; author Craig Jennings + +;;; Commentary: +;; +;; Configuration for Emacs authentication and GPG integration: + +;; • auth-source +;; – Forces use of your default authinfo file +;; – Disable external GPG agent in favor of Emacs’s own prompt +;; – Enable auth-source debug messages + +;; • Easy PG Assistant (epa) +;; – Force using the ‘gpg2’ executable for encryption/decryption operations + +;;; Code: + +(require 'user-constants) ;; defines authinfo-file location + +;; -------------------------------- Auth Sources ------------------------------- +;; auth sources settings + +(use-package auth-source + :ensure nil ;; built in + :demand t ;; load this package immediately + :config + (setenv "GPG_AGENT_INFO" nil) ;; disassociate with external gpg agent + (setq auth-sources `(,authinfo-file)) ;; use authinfo.gpg (see user-constants.el) + (setq auth-source-debug t)) ;; echo debug info to Messages + +;; ----------------------------- Easy PG Assistant ----------------------------- +;; Key management, cryptographic operations on regions and files, dired +;; integration, and automatic encryption/decryption of *.gpg files. + +(use-package epa + :ensure nil ;; built-in + :demand t + :config + (epa-file-enable) + ;; (setq epa-pinentry-mode 'loopback) ;; emacs request passwords in minibuffer + (setq epg-gpg-program "gpg2")) ;; force use gpg2 (not gpg v.1) + + +(provide 'auth-config) +;;; auth-config.el ends here. diff --git a/modules/calibredb-epub-config.el b/modules/calibredb-epub-config.el new file mode 100644 index 00000000..bd82c588 --- /dev/null +++ b/modules/calibredb-epub-config.el @@ -0,0 +1,223 @@ +;;; calibredb-epub-config --- Functionality for Ebook Management and Display -*- lexical-binding: t; coding: utf-8; -*- +;; author Craig Jennings + +;;; Commentary: + +;; This module provides a comprehensive ebook management and reading experience +;; within Emacs, integrating CalibreDB for library management and Nov for EPUB +;; reading. +;; +;; FEATURES: +;; - CalibreDB integration for managing your Calibre ebook library +;; - Nov mode for reading EPUB files with customized typography and layout +;; - Seamless navigation between Nov reading buffers and CalibreDB entries +;; - Image centering in EPUB documents without modifying buffer text +;; - Quick filtering and searching within your ebook library +;; +;; KEY BINDINGS: +;; - M-B: Open CalibreDB library browser +;; - In CalibreDB search mode: +;; - l: Filter by tag +;; - L: Clear all filters +;; - In Nov mode: +;; - z: Open current EPUB in external viewer (zathura) +;; - C-c C-b: Jump to CalibreDB entry for current book +;; - m: Set bookmark +;; - b: List bookmarks +;; +;; WORKFLOW: +;; 1. Press M-B to browse your Calibre library +;; 2. Use filters (l for tags, L to clear) to narrow results +;; 3. Open an EPUB to read it in Nov with optimized typography +;; 4. While reading, use C-c C-b to jump back to the book's metadata +;; 5. Use z to open in external reader when needed +;; +;; CONFIGURATION NOTES: +;; - Prefers EPUB format when available, falls back to PDF +;; - Centers images in EPUB documents using display properties +;; - Applies custom typography with larger fonts for comfortable reading +;; - Uses visual-fill-column for centered text with appropriate margins + +;;; Code: + +(require 'user-constants) ;; for books-dir + +;; -------------------------- CalibreDB Ebook Manager -------------------------- + +(use-package calibredb + :defer 1 + :commands calibredb + :bind + ("M-B" . calibredb) + ;; use built-in filter by tag, add clear-filters + (:map calibredb-search-mode-map + ("l" . calibredb-filter-by-tag) + ("L" . cj/calibredb-clear-filters)) + :config + ;; basic config + (setq calibredb-root-dir books-dir) + (setq calibredb-db-dir (expand-file-name "metadata.db" calibredb-root-dir)) + (setq calibredb-program "/usr/bin/calibredb") + (setq calibredb-preferred-format "epub") + (setq calibredb-search-page-max-rows 20000) + + ;; search window display + (setq calibredb-size-show nil) + (setq calibredb-order "asc") + (setq calibredb-id-width 7)) + +(defun cj/calibredb-clear-filters () + "Clear active filters and show all results." + (interactive) + (setq calibredb-tag-filter-p nil + calibredb-favorite-filter-p nil + calibredb-author-filter-p nil + calibredb-date-filter-p nil + calibredb-format-filter-p nil + calibredb-search-current-page 1) + ;; empty string resets keyword filter and refreshes listing + (calibredb-search-keyword-filter "")) + +;; ------------------------------ Nov Epub Reader ------------------------------ + +(use-package nov + :defer .5 + :after visual-fill-column + :mode ("\\.epub\\'" . nov-mode) + :hook (nov-mode . cj/nov-apply-preferences) + :bind + (:map nov-mode-map + ("m" . bookmark-set) + ("b" . bookmark-bmenu-list) + ("r" . nov-render-document) + ("l" . recenter-top-bottom) + ("d" . sdcv-search-input) + ("." . cj/forward-paragraph-and-center) + ("<" . nov-history-back) + (">" . nov-history-forward) + ("," . backward-paragraph) + ;; open current EPUB with zathura (same key in pdf-view) + ("z" . (lambda () (interactive) (cj/open-file-with-command "zathura"))) + ("t" . nov-goto-toc) + ("C-c C-b" . cj/nov-jump-to-calibredb))) + +(defun cj/forward-paragraph-and-center () + "Forward one paragraph and center the page." + (interactive) + (forward-paragraph) + (recenter)) + +(defun cj/nov-apply-preferences () + "Apply preferences after nov-mode has launched." + (interactive) + (face-remap-add-relative 'variable-pitch :height 180) + (face-remap-add-relative 'fixed-pitch :height 180) + ;; Make this buffer-local so other Nov buffers can choose differently + (setq-local nov-text-width 115) + (when (require 'visual-fill-column nil t) + (setq-local visual-fill-column-center-text t + ;; small cushion above nov-text-width prevents truncation + visual-fill-column-width (+ nov-text-width 10)) + (hl-line-mode) + (visual-fill-column-mode 1)) + (nov-render-document)) + +(defun cj/nov-center-images () + "Center images in the current Nov buffer without modifying text. + +Use line-prefix and wrap-prefix with a space display property aligned to a +computed column based on the window text area width." + (let ((inhibit-read-only t)) + ;; Clear any prior centering prefixes first (fresh render usually makes this + ;; unnecessary, but it makes the function idempotent). + (remove-text-properties (point-min) (point-max) + '(line-prefix nil wrap-prefix nil)) + (save-excursion + (goto-char (point-min)) + ;; Work in the selected window showing this buffer (if any). + (when-let* ((win (get-buffer-window (current-buffer) t)) + (col-width (window-body-width win)) ;; columns + (col-px (* col-width (window-font-width win)))) + (while (let ((m (text-property-search-forward + 'display nil + (lambda (_ p) (and (consp p) (eq (car-safe p) 'image)))))) + (when m + (let* ((img (prop-match-value m)) + (img-px (car (image-size img t))) ;; pixel width + ;; Convert pixel image width to columns for alignment. + (img-cols (max 1 (ceiling (/ (float img-px) + (max 1 (window-font-width win)))))) + (pad-cols (max 0 (/ (- col-width img-cols) 2))) + (prefix (propertize " " 'display `(space :align-to ,pad-cols)))) + (save-excursion + (goto-char (prop-match-beginning m)) + (beginning-of-line) + (let ((bol (point)) + (eol (line-end-position))) + (add-text-properties bol eol + `(line-prefix ,prefix + wrap-prefix ,prefix))))) + t))))))) + +(add-hook 'nov-post-html-render-hook #'cj/nov-center-images) + +;; Jump from a Nov buffer to the corresponding CalibreDB entry. +(defun cj/nov--metadata-get (key) + "Return a metadata value from nov-metadata trying KEY as symbol and string." + (let* ((v (or (and (boundp 'nov-metadata) + (or (alist-get key nov-metadata nil nil #'equal) + (alist-get (if (symbolp key) (symbol-name key) key) + nov-metadata nil nil #'equal))) + nil))) + (cond + ((and (listp v) (= (length v) 1)) (car v)) + ((stringp v) v) + (t v)))) + +(defun cj/nov--file-path () + "Return the current EPUB file path when in nov-mode, or nil." + (when (derived-mode-p 'nov-mode) + ;; In nov, the buffer visits the .epub; buffer-file-name is usually the EPUB. + (or buffer-file-name + (and (boundp 'nov-epub-filename) nov-epub-filename) + (and (boundp 'nov-epub-file) nov-epub-file)))) + +(defun cj/nov-jump-to-calibredb () + "Open CalibreDB focused on the current EPUB's book entry. + +Try to use the Calibre book id from the parent folder name (for example, +\"Title (123)\"). Fall back to a title or author search when no id exists." + (interactive) + (require 'calibredb) + (let* ((file (cj/nov--file-path)) + (title (or (cj/nov--metadata-get 'title) + (cj/nov--metadata-get "title"))) + (author (or (cj/nov--metadata-get 'creator) + (cj/nov--metadata-get 'author) + (cj/nov--metadata-get "creator") + (cj/nov--metadata-get "author"))) + (id (when file + (let* ((parent (file-name-nondirectory + (directory-file-name (file-name-directory file))))) + (when (string-match " (\\([0-9]+\\))\\'" parent) + (match-string 1 parent)))))) + (calibredb) + (with-current-buffer (calibredb-find-create-search-buffer) + (setq calibredb-search-current-page 1) + (cond + (id + (calibredb-search-keyword-filter (format "id:%s" id)) + (message "CalibreDB: focused by id:%s" id)) + ((or title author) + (let* ((q (string-join + (delq nil (list (and title (format "title:\"%s\"" title)) + (and author (format "authors:\"%s\"" author)))) + " and "))) + (calibredb-search-keyword-filter q) + (message "CalibreDB: search %s" (if (string-empty-p q) "" q)))) + (t + (calibredb-search-keyword-filter "") + (message "CalibreDB: no metadata; showing all")))))) + +(provide 'calibredb-epub-config) +;;; calibredb-epub-config.el ends here diff --git a/modules/chrono-tools.el b/modules/chrono-tools.el new file mode 100644 index 00000000..f6c4c0f6 --- /dev/null +++ b/modules/chrono-tools.el @@ -0,0 +1,118 @@ +;;; chrono-tools.el --- Config for Date and Time-Related Utils -*- lexical-binding: t; coding: utf-8; -*- +;; author Craig Jennings +;; +;;; Commentary: +;; +;; This module centralizes configuration for Emacs time-related tools: +;; +;; – world-clock: predefined city list and custom time format +;; – calendar: quick navigation keybindings by day, month, and year +;; – tmr: lightweight timer setup with sounds, notifications, and history +;; +;;; Code: + +(require 'user-constants) + +(use-package time + :ensure nil ;; built-in + :defer 0.5 + :bind ("C-x c" . world-clock) + :config + (setq world-clock-list + '(("Pacific/Honolulu" " Honolulu") + ("America/Los_Angeles" " San Francisco, LA") + ("America/Chicago" " Chicago, New Orleans") + ("America/New_York" " New York, Boston") + ("Etc/UTC" " UTC =================") + ("Europe/London" " London, Lisbon") + ("Europe/Paris" " Paris, Berlin, Rome") + ("Europe/Athens" " Athens, Istanbul, Moscow") + ("Asia/Kolkata" " India") + ("Asia/Shanghai" " Shanghai, Singapore") + ("Asia/Tokyo" " Tokyo, Seoul"))) + (setq world-clock-time-format " %a, %d %b @ %I:%M %p %Z")) + +(use-package calendar + :ensure nil ;; built-in + :defer 0.5 + :bind (("M-#" . calendar) + :map calendar-mode-map + ("," . calendar-backward-day) + ("." . calendar-forward-day) + ("<" . calendar-backward-month) + (">" . calendar-forward-month) + ("M-," . calendar-backward-year) + ("M-." . calendar-forward-year))) + + +;; ------------------------------------ TMR ------------------------------------ + +(defun cj/tmr-select-sound-file () + "Select a sound file from `sounds-dir' to use for tmr timers. + +Present all audio files in the sounds directory and set the chosen file as +`tmr-sound-file'. Use \\[universal-argument] to reset to the default sound." + (interactive) + (if current-prefix-arg + ;; With prefix arg, reset to default + (progn + (setq tmr-sound-file notification-sound) + (message "Timer sound reset to default: %s" + (file-name-nondirectory notification-sound))) + ;; Otherwise, select a new sound + (let* ((audio-extensions '("mp3" "m4a" "ogg" "opus" "wav" "flac" "aac")) + (extension-regex (concat "\\." (regexp-opt audio-extensions t) "$")) + (sound-files (when (file-directory-p sounds-dir) + (directory-files sounds-dir nil extension-regex))) + (current-file (when (and tmr-sound-file (file-exists-p tmr-sound-file)) + (file-name-nondirectory tmr-sound-file))) + (selected-file (when sound-files + (completing-read + (format "Select timer sound%s: " + (if current-file + (format " (current: %s)" current-file) + "")) + sound-files + nil + t + nil + nil + current-file)))) ; Default to current file + (cond + ((not (file-directory-p sounds-dir)) + (message "Sounds directory does not exist: %s" sounds-dir)) + ((null sound-files) + (message "No audio files found in %s" sounds-dir)) + (selected-file + (setq tmr-sound-file (expand-file-name selected-file sounds-dir)) + (when (equal tmr-sound-file notification-sound) + (message "Timer sound set to default: %s" selected-file)) + (unless (equal tmr-sound-file notification-sound) + (message "Timer sound set to: %s" selected-file))) + (t + (message "No file selected")))))) + +(defun cj/tmr-reset-sound-to-default () + "Reset the tmr sound file to the default notification sound." + (interactive) + (setq tmr-sound-file notification-sound) + (message "Timer sound reset to default: %s" + (file-name-nondirectory notification-package))) + +(use-package tmr + :defer 0.5 + :init + (global-unset-key (kbd "M-t")) + :bind (("M-t" . tmr-prefix-map) + :map tmr-prefix-map + ("*" . tmr) + ("t" . tmr-with-details) + ("S" . cj/tmr-select-sound-file) + ("R" . cj/tmr-reset-sound-to-default)) + :config + (setq tmr-sound-file notification-sound) + (setq tmr-notification-urgency 'normal) + (setq tmr-descriptions-list 'tmr-description-history)) + +(provide 'chrono-tools) +;;; chrono-tools.el ends here diff --git a/modules/config-utilities.el b/modules/config-utilities.el new file mode 100644 index 00000000..beb44bf7 --- /dev/null +++ b/modules/config-utilities.el @@ -0,0 +1,291 @@ +;;; config-utilities --- Config Hacking Utilities -*- lexical-binding: t; coding: utf-8; -*- +;; author Craig Jennings + +;;; Commentary: +;; Convenience utilities for working on Emacs configuration. + +;;; Code: + +(require 'ert) +(require 'cl-lib) + +;; ------------------------------ Reload Init File ----------------------------- +;; it does what it says it does. + +(defun cj/reload-init-file () + "Reload the init file. Useful when modifying Emacs config." + (interactive) + (load-file user-init-file)) + +;; ---------------------------- Recompile Emacs Home --------------------------- +;; deletes all .elc and .eln files in user-emacs-directory, then compiles +;; all emacs-lisp files natively if supported, or byte-compiles them if not. + +(defun cj/recompile-emacs-home() + "Delete all compiled files in the Emacs home before recompiling. + +Recompile natively when supported, otherwise fall back to byte compilation." + (interactive) + (let* ((native-comp-supported (boundp 'native-compile-async)) + (elt-dir + (expand-file-name (if native-comp-supported "eln" "elc") + user-emacs-directory)) + (message-format + (format "Please confirm recursive %s recompilation of %%s: " + (if native-comp-supported "native" "byte"))) + (compile-message (format "%scompiling all emacs-lisp files in %%s" + (if native-comp-supported "Natively " "Byte-")))) + (if (yes-or-no-p (format message-format user-emacs-directory)) + (progn + (message "Deleting all compiled files in %s" user-emacs-directory) + (dolist (file (directory-files-recursively user-emacs-directory + "\\(\\.elc\\|\\.eln\\)$")) + (delete-file file)) + (when (file-directory-p elt-dir) + (delete-directory elt-dir t t)) + (message compile-message user-emacs-directory) + (if native-comp-supported + (let ((comp-async-report-warnings-errors nil)) + (native-compile-async user-emacs-directory 'recursively)) + (byte-recompile-directory user-emacs-directory 0))) + (message "Cancelled recompilation of %s" user-emacs-directory)))) + +;; ---------------------- Delete Emacs Home Compiled Files --------------------- +;; removes all compiled files and deletes the eln directory + +(defun cj/delete-emacs-home-compiled-files () + "Delete all compiled files recursively in \='user-emacs-directory\='." + (interactive) + (message "Deleting compiled files under %s. This may take a while." + user-emacs-directory) + (require 'find-lisp) ;; make sure the package is required + (mapc (lambda (path) + (when (or (string-suffix-p ".elc" path) + (string-suffix-p ".eln" path)) + (delete-file path))) + (find-lisp-find-files user-emacs-directory "")) + (message "Done. Compiled files removed under %s" user-emacs-directory)) + +;; ---------------------- List Loaded Packages --------------------- +;; you don't really need an explanation for this function, do you? + +(defvar cj--loaded-file-paths nil + "All file paths that are loaded.") +(defvar cj--loaded-packages-buffer "*loaded-packages*" + "Buffer name for data about loaded packages.") +(defvar cj--loaded-features-buffer "*loaded-features*" + "Buffer name for data about loaded features.") + +(defun cj/list-loaded-packages() + "List all currently loaded packages." + (interactive) + (with-current-buffer (get-buffer-create cj--loaded-packages-buffer) + (erase-buffer) + (pop-to-buffer (current-buffer)) + + (insert "* Live Packages Exploration\n\n") + (insert (format "%s total packages currently loaded\n" + (length cj--loaded-file-paths))) + + ;; Extract data from builtin variable `load-history'. + (setq cj--loaded-file-paths + (seq-filter #'stringp + (mapcar #'car load-history))) + (cl-sort cj--loaded-file-paths 'string-lessp) + (cl-loop for file in cj--loaded-file-paths + do (insert "\n" file)) + + (goto-char (point-min)))) + +;; ---------------------------- List Loaded Features --------------------------- +;; this function's also self-explanatory + +(defun cj/list-loaded-features() + "List all currently loaded features." + (interactive) + (with-current-buffer (get-buffer-create cj--loaded-features-buffer) + (erase-buffer) + (pop-to-buffer (current-buffer)) + + (insert (format "\n** %d features currently loaded\n" + (length features))) + + (let ((features-vec (apply 'vector features))) + (cl-sort features-vec 'string-lessp) + (cl-loop for x across features-vec + do (insert (format " - %-25s: %s\n" x + (locate-library (symbol-name x)))))) + (goto-char (point-min)))) + +;; ------------------------ Validate Org Agenda Entries ------------------------ + +(defun cj/check-org-agenda-invalid-timestamps () + "Scan all files in `org-agenda-files' for invalid timestamps. + +Checks DEADLINE, SCHEDULED, TIMESTAMP properties and inline timestamps in headline contents. + +Generates an Org-mode report buffer with links to problematic entries, property/type, and raw timestamp string." + (interactive) + (require 'org-element) + (let ((report-buffer (get-buffer-create "*Org Invalid Timestamps Report*"))) + (with-current-buffer report-buffer + (erase-buffer) + (org-mode) + (insert "#+TITLE: Org Invalid Timestamps Report\n\n") + (insert "* Overview\nScan of org-agenda-files for invalid timestamps.\n\n")) + (dolist (file org-agenda-files) + (with-current-buffer (find-file-noselect file) + (let ((invalid-entries '()) + (props '("DEADLINE" "SCHEDULED" "TIMESTAMP")) + (parse-tree (org-element-parse-buffer 'headline))) + (org-element-map parse-tree 'headline + (lambda (hl) + (let ((headline-text (org-element-property :raw-value hl)) + (begin-pos (org-element-property :begin hl))) + (dolist (prop props) + (let ((timestamp (org-element-property (intern (downcase prop)) hl))) + (when timestamp + (let ((time-str (org-element-property :raw-value timestamp))) + (unless (ignore-errors (org-time-string-to-absolute time-str)) + (push (list file begin-pos headline-text prop time-str) invalid-entries)))))) + (let ((contents-begin (org-element-property :contents-begin hl)) + (contents-end (org-element-property :contents-end hl))) + (when (and contents-begin contents-end) + (save-excursion + (goto-char contents-begin) + (while (re-search-forward org-ts-regexp contents-end t) + (let ((ts-string (match-string 0))) + (unless (ignore-errors (org-time-string-to-absolute ts-string)) + (push (list file begin-pos headline-text "inline timestamp" ts-string) invalid-entries)))))))))) + + (with-current-buffer report-buffer + (insert (format "* %s\n" file)) + (if invalid-entries + (dolist (entry (reverse invalid-entries)) + (cl-destructuring-bind (f pos head prop ts) entry + (insert (format "- [[file:%s::%d][%s]]\n - Property/Type: %s\n - Invalid timestamp: \"%s\"\n" + f pos head prop ts)))) + (insert "No invalid timestamps found.\n"))) + (with-current-buffer report-buffer (insert "\n"))))) + (pop-to-buffer report-buffer))) + +;; ----------------------------- Reset-Auth-Sources ---------------------------- + +(defun cj/reset-auth-cache () + "Clear Emacs auth-source cache." + (interactive) + (auth-source-forget-all-cached) + (message "Emacs auth-source cache cleared.")) + +;; --------------------------- Org-Alert-Check Timers -------------------------- +;; Utility to list timers running org-alert-check + +(defun cj/org-alert-list-timers () + "List all active timers running `org-alert-check' with next run time in human-readable form." + (interactive) + (let ((timers (cl-remove-if-not + (lambda (timer) + (eq (timer--function timer) #'org-alert-check)) + timer-list))) + (if timers + (let ((lines + (mapcar + (lambda (timer) + (let* ((next-run (timer--time timer)) + (next-run-str (format-time-string "%Y-%m-%d %H:%M:%S" next-run))) + (format "Timer next runs at: %s" next-run-str))) + timers))) + (message "org-alert-check timers:\n%s" (string-join lines "\n"))) + (message "No org-alert-check timers found.")))) + +;; ------------------------------- Sqlite Tracing ------------------------------ + + +(defvar cj/sqlite-tracing-enabled nil) +(defvar cj/sqlite--db-origins (make-hash-table :test 'eq :weakness 'key)) + +(defun cj/capture-backtrace () + (condition-case nil + (if (fboundp 'backtrace-frames) + (mapcar (lambda (fr) (car fr)) (backtrace-frames)) + (list "no-backtrace-frames")) + (error (list "failed-to-capture-backtrace")))) + +(defun cj/take (n xs) + (cl-subseq xs 0 (min n (length xs)))) + +(defun cj--ad-sqlite-open (orig file &rest opts) + (let ((db (apply orig file opts))) + (puthash db + (list :file file + :opts opts + :where (or load-file-name buffer-file-name) + :time (current-time-string) + :stack (cj/capture-backtrace)) + cj/sqlite--db-origins) + db)) + +(defun cj--ad-sqlite-close (orig db &rest args) + (let ((info (gethash db cj/sqlite--db-origins))) + (when info + (message "cj/sqlite: closing %s opened at %s by %s" + (plist-get info :file) + (plist-get info :time) + (or (plist-get info :where) "unknown")))) + (apply orig db args)) + +(defun cj--ad-set-finalizer (orig obj fn) + (let* ((origin (list :time (current-time-string) + :where (or load-file-name buffer-file-name) + :stack (cj/capture-backtrace) + :sqlite-open (when (and (fboundp 'sqlitep) + (ignore-errors (sqlitep obj))) + (gethash obj cj/sqlite--db-origins)))) + (wrapped + (lambda (&rest args) + (condition-case err + (apply fn args) + (error + (let* ((stack (cj/take 8 (plist-get origin :stack))) + (dbi (plist-get origin :sqlite-open)) + (extra (if dbi + (format " db=%s opened at %s by %s" + (plist-get dbi :file) + (plist-get dbi :time) + (or (plist-get dbi :where) "unknown")) + ""))) + (message "cj/finalizer: failed; created at %s (%s); callers=%S;%s; error=%S" + (plist-get origin :time) + (or (plist-get origin :where) "unknown") + stack extra err)) + ;; Re-signal so Emacs still shows the standard finalizer message. + (signal (car err) (cdr err))))))) + (funcall orig obj wrapped))) + +(defun cj/sqlite-tracing-enable () + "Enable tracing of sqlite opens/closes and annotate failing finalizers." + (interactive) + (unless cj/sqlite-tracing-enabled + (setq cj/sqlite-tracing-enabled t) + (advice-add 'set-finalizer :around #'cj--ad-set-finalizer) + (when (fboundp 'sqlite-open) + (advice-add 'sqlite-open :around #'cj--ad-sqlite-open) + (advice-add 'sqlite-close :around #'cj--ad-sqlite-close)) + (message "cj/sqlite tracing enabled"))) + +(defun cj/sqlite-tracing-disable () + "Disable sqlite/finalizer tracing and clear recorded origins." + (interactive) + (setq cj/sqlite-tracing-enabled nil) + (ignore-errors (advice-remove 'set-finalizer #'cj--ad-set-finalizer)) + (when (fboundp 'sqlite-open) + (ignore-errors (advice-remove 'sqlite-open #'cj--ad-sqlite-open)) + (ignore-errors (advice-remove 'sqlite-close #'cj--ad-sqlite-close))) + (clrhash cj/sqlite--db-origins) + (message "cj/sqlite tracing disabled")) + +(cj/sqlite-tracing-enable) +(setq debug-on-message (rx bos "finalizer failed")) + +(provide 'config-utilities) +;;; config-utilities.el ends here diff --git a/modules/custom-functions.el b/modules/custom-functions.el new file mode 100644 index 00000000..5899eec7 --- /dev/null +++ b/modules/custom-functions.el @@ -0,0 +1,1012 @@ +;;; custom-functions.el --- My Custom Functions and Keymaps -*- lexical-binding: t; coding: utf-8; -*- +;; author Craig Jennings + +;;; Commentary: +;; +;; These are custom utility functions I use frequently. +;; For convenience, they are bound to a custom keymap with a prefix of "C-;". + +;; Additional keymaps are created on top of this prefix to collect similar operations. +;; +;; C-; --- Custom Key Map +;; C-; ) → jump to matching parenthesis +;; C-; f → re-formats region or buffer (delete trailing whitespace, reindent, and untabify). +;; C-; W → counts words in region or buffer displaying results in echo area. +;; C-; / → replace common glyph fractions (½) to text (1/2) (text to glyph with C-u). +;; C-; A → align text by regexp with spaces +;; C-; | → toggle visibility of the fill-column indicator +;; +;; C-; b --- Buffer & File Operations +;; C-; b m → move buffer and file to another directory +;; C-; b r → rename buffer and its file simultaneously +;; C-; b d → delete buffer and its file simultaneously +;; C-; b l → copy file:// link of buffer’s source file +;; C-; b c → copy entire buffer to the kill rung +;; C-; b b → clear contents of buffer from point to beginnning +;; C-; b e → clear contents of buffer from point to end +;; +;; C-; w --- Whitespace Operations +;; C-; w r → remove leading/trailing whitespace from line or region (buffer with C-u). +;; C-; w c → collapses runs of whitespace to one space. +;; C-; w l → delete all blank lines in region or buffer +;; C-; w h → hyphenate all whitespace in region +;; +;; C-; s --- Surround, Append & Prepend +;; C-; s s → surround word or region with string +;; C-; s a → append a string to each line +;; C-; s p → prepend a string to each line +;; +;; C-; d --- Date/Time Insertion +;; C-; d r → readable date and time : Sunday, August 31, 2025 at 04:07:02 PM CDT +;; C-; d s → sortable date and time : 2025-08-31 Sun @ 16:07:30 -0500 +;; C-; d t → sortable time only : 04:07:50 PM CDT +;; C-; d D → readable time only : 4:08 PM +;; C-; d T → readable date only : Sunday, August 31, 2025 +;; C-; d d → sortable date only : 2025-08-31 Sun +;; +;; C-; l --- Line & Paragraph Operations +;; C-; l j → join lines (or selected region of lines) +;; C-; l J → join entire paragraph. guesses at the lines that constitute paragraph. +;; C-; l d → duplicates the line or region +;; C-; l r → remove duplicate lines from the buffer, keeping the first occurrence. +;; C-; l R → remove lines containing specific text from the region or buffer. +;; C-; l u → "underline" current line: repeat a chosen character to same length on line below. + +;; +;; C-; m --- Comment Styling & Removal +;; C-; m r → reformats selecton into a commented paragraph re-wrapping at fill column width. +;; C-; m c → insert centered comment +;; C-; m - → insert hyphen-style comment +;; C-; m b → draw a comment box +;; C-; m D → delete all comments in buffer +;; +;; C-; o --- Ordering & Sorting +;; C-; o a → arrayify lines into quoted list +;; C-; o u → unarrayify list into lines +;; C-; o A → alphabetize items in region +;; C-; o l → split comma-separated text onto lines +;; +;; C-; c --- Case-Change Operations +;; C-; c t → Change selected text to Title Case : This is the Title of a Movie +;; C-; c u → Change word or region to Upper Case : THIS IS THE TITLE OF A MOVIE +;; C-; c d → Change word or region to Lower Case : this is the title of a movie + +;;; Code: + +(require 'subr-x) + +(use-package expand-region + :demand t) ;; used w/in join paragraph + +;;; ----------------- Miscellaneous Functions And Custom Keymap ----------------- + +(defun cj/jump-to-matching-paren () + "Jump to the matching parenthesis when point is on one. + +Signal a message when point is not on a parenthesis." + (interactive) + (cond ((looking-at "\\s\(\\|\\s\{\\|\\s\[") + (forward-list)) + ((looking-back "\\s\)\\|\\s\}\\|\\s\\]") + (backward-list)) + (t (message "Cursor doesn't follow parenthesis, so there's no match.")))) + +(defun cj/format-region-or-buffer () + "Reformat the region or the entire buffer. + +Replaces tabs with spaces, deletes trailing whitespace, and reindents the region." + (interactive) + (let ((start-pos (if (use-region-p) (region-beginning) (point-min))) + (end-pos (if (use-region-p) (region-end) (point-max)))) + (save-excursion + (save-restriction + (narrow-to-region start-pos end-pos) + (untabify (point-min) (point-max))) + (indent-region (point-min) (point-max)) + (delete-trailing-whitespace)))) + +(defun cj/count-words-buffer-or-region () + "Count the number of words in the buffer or region. + +Display the result in the minibuffer and *Messages* buffer." + (interactive) + (let ((begin (point-min)) + (end (point-max)) + (area_type "the buffer")) + (when mark-active + (setq begin (region-beginning) + end (region-end) + area_type "the region")) + (message (format "There are %d words in %s." (count-words begin end) area_type)))) + +(defun cj/replace-fraction-glyphs (start end) + "Replace common fraction glyphs between START and END. + +Operate on the buffer or region designated by START and END. +Replace the text representations with glyphs when called with a \[universal-argument] prefix." + (interactive (if (use-region-p) + (list (region-beginning) (region-end)) + (list (point-min) (point-max)))) + (let ((replacements (if current-prefix-arg + '(("1/4" . "¼") + ("1/2" . "½") + ("3/4" . "¾") + ("1/3" . "⅓") + ("2/3" . "⅔")) + '(("¼" . "1/4") + ("½" . "1/2") + ("¾" . "3/4") + ("⅓" . "1/3") + ("⅔" . "2/3"))))) + (save-excursion + (dolist (r replacements) + (goto-char start) + (while (search-forward (car r) end t) + (replace-match (cdr r))))))) + +(defun cj/align-regexp-with-spaces (orig-fun &rest args) + "Call ORIG-FUN with ARGS while temporarily disabling tabs for alignment. + +This advice ensures `align-regexp' uses spaces by binding `indent-tabs-mode' to nil." + (let ((indent-tabs-mode nil)) + (apply orig-fun args))) + +(advice-remove 'align-regexp #'align-regexp-with-spaces) ; in case this is reloaded +(advice-add 'align-regexp :around #'cj/align-regexp-with-spaces) + +;; Must unbind Flyspell's 'C-;' keybinding before it's assigned to cj/custom-keymap +(global-unset-key (kbd "C-;")) +(eval-after-load "flyspell" + '(define-key flyspell-mode-map (kbd "C-;") nil)) + +(defvar cj/custom-keymap + (let ((map (make-sparse-keymap))) + (define-key map ")" 'cj/jump-to-matching-paren) + (define-key map "f" 'cj/format-region-or-buffer) + (define-key map "W" 'cj/count-words-buffer-or-region) + (define-key map "/" 'cj/replace-fraction-glyphs) + (define-key map "A" 'align-regexp) + (define-key map "B" 'toggle-debug-on-error) + (define-key map "|" 'display-fill-column-indicator-mode) + + ;; load debug helpers only on this keybinding + map) + "The base key map for custom elisp functions holding miscellaneous functions. +Other key maps extend from this key map to hold categorized functions.") +(global-set-key (kbd "C-;") cj/custom-keymap) + +;;; ------------------- Buffer And File Operations And Keymap ------------------- + +(defun cj/move-buffer-and-file (dir) + "Move both current buffer and the file it visits to DIR." + (interactive "DMove buffer and file (to new directory): ") + (let* ((name (buffer-name)) + (filename (buffer-file-name)) + (dir + (if (string-match dir "\\(?:/\\|\\\\)$") + (substring dir 0 -1) dir)) + (newname (concat dir "/" name))) + (if (not filename) + (message "Buffer '%s' is not visiting a file!" name) + (progn (copy-file filename newname 1) (delete-file filename) + (set-visited-file-name newname) (set-buffer-modified-p nil) t)))) + +(defun cj/rename-buffer-and-file (new-name) + "Rename both current buffer and the file it visits to NEW-NAME." + (interactive + (list (if (not (buffer-file-name)) + (user-error "Buffer '%s' is not visiting a file!" (buffer-name)) + (read-string "Rename buffer and file (to new name): " + (file-name-nondirectory (buffer-file-name)))))) + (let ((name (buffer-name)) + (filename (buffer-file-name))) + (if (get-buffer new-name) + (message "A buffer named '%s' already exists!" new-name) + (progn + (rename-file filename new-name 1) + (rename-buffer new-name) + (set-visited-file-name new-name) + (set-buffer-modified-p nil))))) + +(defun cj/delete-buffer-and-file () + "Kill the current buffer and delete the file it visits." + (interactive) + (let ((filename (buffer-file-name))) + (when filename + (if (vc-backend filename) + (vc-delete-file filename) + (progn + (delete-file filename t) + (message "Deleted file %s" filename) + (kill-buffer)))))) + +(defun cj/copy-link-to-buffer-file () + "Copy the full file:// path of the current buffer's source file to the kill ring." + (interactive) + (let ((file-path (buffer-file-name))) + (when file-path + (setq file-path (concat "file://" file-path)) + (kill-new file-path) + (message "Copied file link to kill ring: %s" file-path)))) + +(defun cj/copy-path-to-buffer-file-as-kill () + "Copy the full path of the current buffer's file to the kill ring. +Signal an error if the buffer is not visiting a file." + (interactive) + (let ((path (buffer-file-name))) + (if (not path) + (user-error "Current buffer is not visiting a file") + (kill-new path) + (message "Copied file path: %s" path) + path))) + +(defun cj/copy-whole-buffer () + "Copy the entire contents of the current buffer to the kill ring. + +Point and mark are left exactly where they were. No transient region +is created. A message is displayed when done." + (interactive) + (let ((contents (buffer-substring-no-properties (point-min) (point-max)))) + (kill-new contents) + (message "Buffer contents copied to kill ring"))) + +(defun cj/clear-to-bottom-of-buffer () + "Delete all text from point to the end of the current buffer. + +This does not save the deleted text in the kill ring." + (interactive) + (delete-region (point) (point-max)) + (message "Buffer contents removed to the end of the buffer.")) + +(defun cj/clear-to-top-of-buffer () + "Delete all text from point to the beginning of the current buffer. + +Do not save the deleted text in the kill ring." + (interactive) + (delete-region (point) (point-min)) + (message "Buffer contents removed to the beginning of the buffer.")) + +;; prints using postscript for much nicer output +(use-package ps-print + :ensure nil ;; built-in + :config + (defun cj/print-buffer-ps () + "Print the current buffer as PostScript (monochrome) to the system default printer. +Sends directly to the spooler (no temp files), with no page header." + (interactive) + (let* ((spooler + (cond + ((executable-find "lpr") "lpr") + ((executable-find "lp") "lp") + (t (user-error "Cannot print: neither 'lpr' nor 'lp' found in PATH")))) + ;; Configure spooler for this invocation + (ps-lpr-command spooler) + (ps-printer-name nil) ;; nil => system default printer + (ps-lpr-switches nil) + ;; Force monochrome and ignore face backgrounds for this job + (ps-print-color-p nil) + (ps-use-face-background nil) + ;; Ensure no headers + (ps-print-header nil) + (ps-header-lines 0) + (ps-left-header nil) + (ps-right-header nil)) + (ps-print-buffer-with-faces) + (message "Sent print job via %s to default printer (no header)" spooler)))) + +;; Buffer & file operations prefix and keymap +(define-prefix-command 'cj/buffer-and-file-map nil + "Keymap for buffer-and-file operations.") +(define-key cj/custom-keymap "b" 'cj/buffer-and-file-map) +(define-key cj/buffer-and-file-map "m" 'cj/move-buffer-and-file) +(define-key cj/buffer-and-file-map "r" 'cj/rename-buffer-and-file) +(define-key cj/buffer-and-file-map "p" 'cj/print-buffer-ps) +(define-key cj/buffer-and-file-map "d" 'cj/delete-buffer-and-file) +(define-key cj/buffer-and-file-map "c" 'cj/copy-whole-buffer) +(define-key cj/buffer-and-file-map "t" 'cj/clear-to-top-of-buffer) +(define-key cj/buffer-and-file-map "b" 'cj/clear-to-bottom-of-buffer) +(define-key cj/buffer-and-file-map "x" 'erase-buffer) +(define-key cj/buffer-and-file-map "s" 'write-file) ;; save as :) + +(define-key cj/buffer-and-file-map "l" 'cj/copy-link-to-buffer-file) +(define-key cj/buffer-and-file-map "P" 'cj/copy-path-to-buffer-file-as-kill) + +;;; ---------------------- Whitespace Operations And Keymap --------------------- + +(defun cj/remove-leading-trailing-whitespace () + "Remove leading and trailing whitespace in a region, line, or buffer. + +When called interactively: +- If a region is active, operate on the region. +- If called with a \[universal-argument] prefix, operate on the entire buffer. +- Otherwise, operate on the current line." + (interactive) + (let ((start (cond (current-prefix-arg (point-min)) + ((use-region-p) (region-beginning)) + (t (line-beginning-position)))) + (end (cond (current-prefix-arg (point-max)) + ((use-region-p) (region-end)) + (t (line-end-position))))) + (save-excursion + (save-restriction + (narrow-to-region start end) + (goto-char (point-min)) + (while (re-search-forward "^[ \t]+" nil t) (replace-match "")) + (goto-char (point-min)) + (while (re-search-forward "[ \t]+$" nil t) (replace-match "")))))) + +(defun cj/collapse-whitespace-line-or-region () + "Collapse whitespace to one space in the current line or active region. + +Ensure there is exactly one space between words and remove leading and trailing whitespace." + (interactive) + (save-excursion + (let* ((region-active (use-region-p)) + (beg (if region-active (region-beginning) (line-beginning-position))) + (end (if region-active (region-end) (line-end-position)))) + (save-restriction + (narrow-to-region beg end) + ;; Replace all tabs with space + (goto-char (point-min)) + (while (search-forward "\t" nil t) + (replace-match " " nil t)) + ;; Remove leading and trailing spaces + (goto-char (point-min)) + (while (re-search-forward "^\\s-+\\|\\s-+$" nil t) + (replace-match "" nil nil)) + ;; Ensure only one space between words/symbols + (goto-char (point-min)) + (while (re-search-forward "\\s-\\{2,\\}" nil t) + (replace-match " " nil nil)))))) + +(defun cj/delete-blank-lines-region-or-buffer (start end) + "Delete blank lines between START and END. + +Treat blank lines as lines that contain nothing or only whitespace. +Operate on the active region when one exists. +Prompt before operating on the whole buffer when no region is selected. +Signal a user error and do nothing when the user declines. +Restore point to its original position after deletion." + (interactive + (if (use-region-p) + ;; grab its boundaries if there's a region + (list (region-beginning) (region-end)) + ;; or ask if user intended operating on whole buffer + (if (yes-or-no-p "Delete blank lines in entire buffer? ") + (list (point-min) (point-max)) + (user-error "Aborted")))) + (save-excursion + (save-restriction + (widen) + ;; Regexp "^[[:space:]]*$" matches lines of zero or more spaces/tabs. + (flush-lines "^[[:space:]]*$" start end))) + ;; Return nil (Emacs conventions). Point is already restored. + nil) + +(defun cj/hyphenate-whitespace-in-region (start end) + "Replace runs of whitespace between START and END with hyphens. + +Operate on the active region designated by START and END." + (interactive "*r") + (if (use-region-p) + (save-excursion + (save-restriction + (narrow-to-region start end) + (goto-char (point-min)) + (while (re-search-forward "[ \t\n\r]+" nil t) + (replace-match "-")))) + (message "No region; nothing to hyphenate."))) + + +;; Whitespace operations prefix and keymap +(define-prefix-command 'cj/whitespace-map nil + "Keymap for whitespace operations.") +(define-key cj/custom-keymap "w" 'cj/whitespace-map) +(define-key cj/whitespace-map "r" 'cj/remove-leading-trailing-whitespace) +(define-key cj/whitespace-map "c" 'cj/collapse-whitespace-line-or-region) +(define-key cj/whitespace-map "l" 'cj/delete-blank-lines-region-or-buffer) +(define-key cj/whitespace-map "-" 'cj/hyphenate-whitespace-in-region) + +;;; ------------------------- Surround, Append, Prepend ------------------------- + +(defun cj/surround-word-or-region () + "Surround the word at point or active region with a string read from the minibuffer." + (interactive) + (let ((str (read-string "Surround with: ")) + (regionp (use-region-p))) + (save-excursion + (if regionp + (let ((beg (region-beginning)) + (end (region-end))) + (goto-char end) + (insert str) + (goto-char beg) + (insert str)) + (if (thing-at-point 'word) + (let ((bounds (bounds-of-thing-at-point 'word))) + (goto-char (cdr bounds)) + (insert str) + (goto-char (car bounds)) + (insert str)) + (message "Can't insert around. No word at point and no region selected.")))))) + +(defun cj/append-to-lines-in-region-or-buffer (str) + "Append STR to the end of each line in the region or entire buffer." + (interactive "sEnter string to append: ") + (let ((start-pos (if (use-region-p) + (region-beginning) + (point-min))) + (end-pos (if (use-region-p) + (region-end) + (point-max)))) + (save-excursion + (goto-char start-pos) + (while (< (point) end-pos) + (move-end-of-line 1) + (insert str) + (forward-line 1))))) + +(defun cj/prepend-to-lines-in-region-or-buffer (str) + "Prepend STR to the beginning of each line in the region or entire buffer." + (interactive "sEnter string to prepend: ") + (let ((start-pos (if (use-region-p) + (region-beginning) + (point-min))) + (end-pos (if (use-region-p) + (region-end) + (point-max)))) + (save-excursion + (goto-char start-pos) + (while (< (point) end-pos) + (beginning-of-line 1) + (insert str) + (forward-line 1))))) + +;; Surround, append, prepend prefix keymap +(define-prefix-command 'cj/surround-map nil + "Keymap for surrounding, appending, and prepending operations.") +(define-key cj/custom-keymap "s" 'cj/surround-map) +(define-key cj/surround-map "s" 'cj/surround-word-or-region) +(define-key cj/surround-map "a" 'cj/append-to-lines-in-region-or-buffer) +(define-key cj/surround-map "p" 'cj/prepend-to-lines-in-region-or-buffer) + +;;; -------------------------- Date And Time Insertion -------------------------- + +(defvar readable-date-time-format "%A, %B %d, %Y at %I:%M:%S %p %Z " + "Format string used by `cj/insert-readable-date-time'. + +See `format-time-string' for possible replacements.") + +(defun cj/insert-readable-date-time () + "Insert the current date and time into the current buffer. + +Use `readable-date-time-format' for formatting." + (interactive) + (insert (format-time-string readable-date-time-format (current-time)))) + +(defvar sortable-date-time-format "%Y-%m-%d %a @ %H:%M:%S %z " + "Format string used by `cj/insert-sortable-date-time'. + +See `format-time-string' for possible replacements.") + +(defun cj/insert-sortable-date-time () + "Insert the current date and time into the current buffer. + +Use `sortable-date-time-format' for formatting." + (interactive) + (insert (format-time-string sortable-date-time-format (current-time)))) + +(defvar sortable-time-format "%I:%M:%S %p %Z " + "Format string used by `cj/insert-sortable-time'. + +See `format-time-string' for possible replacements.") + +(defun cj/insert-sortable-time () + "Insert the current time into the current buffer. + +Use `sortable-time-format' for formatting." + (interactive) + (insert (format-time-string sortable-time-format (current-time)))) + +(defvar readable-time-format "%-I:%M %p " + "Format string used by `cj/insert-readable-time'. + +See `format-time-string' for possible replacements.") + +(defun cj/insert-readable-time () + "Insert the current time into the current buffer. + +Use `readable-time-format' for formatting." + (interactive) + (insert (format-time-string readable-time-format (current-time)))) + +(defvar sortable-date-format "%Y-%m-%d %a" + "Format string used by `cj/insert-sortable-date'. + +See `format-time-string' for possible replacements.") + +(defun cj/insert-sortable-date () + "Insert the current date into the current buffer. + +Use `sortable-date-format' for formatting." + (interactive) + (insert (format-time-string sortable-date-format (current-time)))) + +(defvar readable-date-format "%A, %B %d, %Y" + "Format string used by `cj/insert-readable-date'. + +See `format-time-string' for possible replacements.") + +(defun cj/insert-readable-date () + "Insert the current date into the current buffer. + +Use `readable-date-format' for formatting." + (interactive) + (insert (format-time-string readable-date-format (current-time)))) + +;; Date/time insertion prefix and keymap +(define-prefix-command 'cj/datetime-map nil + "Keymap for inserting various date/time formats.") +(define-key cj/custom-keymap "d" 'cj/datetime-map) +(define-key cj/datetime-map "r" 'cj/insert-readable-date-time) +(define-key cj/datetime-map "s" 'cj/insert-sortable-date-time) +(define-key cj/datetime-map "t" 'cj/insert-sortable-time) +(define-key cj/datetime-map "T" 'cj/insert-readable-time) +(define-key cj/datetime-map "d" 'cj/insert-sortable-date) +(define-key cj/datetime-map "D" 'cj/insert-readable-date) + +;;; ----------------------- Line And Paragraph Operations ----------------------- + + +(defun cj/join-line-or-region () + "Join lines in the active region or join the current line with the previous one." + (interactive) + (if (use-region-p) + (let ((beg (region-beginning)) + (end (copy-marker (region-end)))) + (goto-char beg) + (while (< (point) end) + (join-line 1)) + (goto-char end) + (newline)) + ;; No region - only join if there's a previous line + (when (> (line-number-at-pos) 1) + (join-line)) + (newline))) + +(defun cj/join-paragraph () + "Join all lines in the current paragraph using `cj/join-line-or-region'." + (interactive) + (er/mark-paragraph) ;; from package expand region + (cj/join-line-or-region (region-beginning)(region-end)) + (forward-line)) + +(defun cj/duplicate-line-or-region (&optional comment) + "Duplicate the current line or active region below. + +Comment the duplicated text when optional COMMENT is non-nil." + (interactive "P") + (let* ((b (if (region-active-p) (region-beginning) (line-beginning-position))) + (e (if (region-active-p) (region-end) (line-end-position))) + (lines (split-string (buffer-substring-no-properties b e) "\n"))) + (save-excursion + (goto-char e) + (dolist (line lines) + (open-line 1) + (forward-line 1) + (insert line) + ;; If the COMMENT prefix argument is non-nil, comment the inserted text + (when comment + (comment-region (line-beginning-position) (line-end-position))))))) + +(defun cj/remove-duplicate-lines-region-or-buffer () + "Remove duplicate lines in the region or buffer, keeping the first occurrence. + +Operate on the active region when one exists; otherwise operate on the whole buffer." + (interactive) + (let ((start (if (use-region-p) (region-beginning) (point-min))) + (end (if (use-region-p) (region-end) (point-max)))) + (save-excursion + (let ((end-marker (copy-marker end))) + (while + (progn + (goto-char start) + (re-search-forward "^\\(.*\\)\n\\(\\(.*\n\\)*\\)\\1\n" end-marker t)) + (replace-match "\\1\n\\2")))))) + + +(defun cj/remove-lines-containing (text) + "Remove all lines containing TEXT. + +If region is active, operate only on the region, otherwise on entire buffer. +The operation is undoable." + (interactive "sRemove lines containing: ") + (save-excursion + (save-restriction + (let ((region-active (use-region-p)) + (count 0)) + (when region-active + (narrow-to-region (region-beginning) (region-end))) + (goto-char (point-min)) + ;; Count lines before deletion + (while (re-search-forward (regexp-quote text) nil t) + (setq count (1+ count)) + (beginning-of-line) + (forward-line)) + ;; Go back and delete + (goto-char (point-min)) + (delete-matching-lines (regexp-quote text)) + ;; Report what was done + (message "Removed %d line%s containing '%s' from %s" + count + (if (= count 1) "" "s") + text + (if region-active "region" "buffer")))))) + +(defun cj/underscore-line () + "Underline the current line by inserting a row of characters below it. + +If the line is empty or contains only whitespace, abort with a message." + (interactive) + (let ((line (buffer-substring-no-properties + (line-beginning-position) + (line-end-position)))) + (if (string-match-p "^[[:space:]]*$" line) + (message "Line empty or only whitespace. Aborting.") + (let* ((char (read-char "Enter character for underlining: ")) + (len (save-excursion + (goto-char (line-end-position)) + (current-column)))) + (save-excursion + (end-of-line) + (insert "\n" (make-string len char))))))) + + +;; Line & paragraph operations prefix and keymap +(define-prefix-command 'cj/line-and-paragraph-map nil + "Keymap for line and paragraph manipulation.") +(define-key cj/custom-keymap "l" 'cj/line-and-paragraph-map) +(define-key cj/line-and-paragraph-map "j" 'cj/join-line-or-region) +(define-key cj/line-and-paragraph-map "J" 'cj/join-paragraph) +(define-key cj/line-and-paragraph-map "d" 'cj/duplicate-line-or-region) +(define-key cj/line-and-paragraph-map "R" 'cj/remove-duplicate-lines-region-or-buffer) +(define-key cj/line-and-paragraph-map "r" 'cj/remove-lines-containing) +(define-key cj/line-and-paragraph-map "u" 'cj/underscore-line) + +;;; ---------------------------------- Comments --------------------------------- + +(defun cj/comment-reformat () + "Reformat commented text into a single paragraph." + (interactive) + + (if mark-active + (let ((beg (region-beginning)) + (end (copy-marker (region-end))) + (orig-fill-column fill-column)) + (uncomment-region beg end) + (setq fill-column (- fill-column 3)) + (cj/join-line-or-region beg end) + (comment-region beg end) + (setq fill-column orig-fill-column ))) + ;; if no region + (message "No region was selected. Select the comment lines to reformat.")) + +(defun cj/comment-centered (&optional comment-char) + "Insert comment text centered around the COMMENT-CHAR character. + +Default to the hash character when COMMENT-CHAR is nil. + +Use the lesser of `fill-column' or 80 to calculate the comment length. +Begin and end the line with the appropriate comment symbols for the current mode." + (interactive) + (if (not (char-or-string-p comment-char)) + (setq comment-char "#")) + (let* ((comment (capitalize (string-trim (read-from-minibuffer "Comment: ")))) + (fill-column (min fill-column 80)) + (comment-length (length comment)) + (comment-start-length (length comment-start)) + (comment-end-length (length comment-end)) + (current-column-pos (current-column)) + (space-on-each-side (/ (- fill-column + current-column-pos + comment-length + (length comment-start) + (length comment-end) + ;; Single space on each side of comment + (if (> comment-length 0) 2 0) + ;; Single space after comment syntax sting + 1) + 2))) + (if (< space-on-each-side 2) + (message "Comment string is too big to fit in one line") + (progn + (insert comment-start) + (when (equal comment-start ";") ; emacs-lisp line comments are ;; + (insert comment-start)) ; so insert comment-char again + (insert " ") + (dotimes (_ space-on-each-side) (insert comment-char)) + (when (> comment-length 0) (insert " ")) + (insert comment) + (when (> comment-length 0) (insert " ")) + (dotimes (_ (if (= (% comment-length 2) 0) + (- space-on-each-side 1) + space-on-each-side)) + (insert comment-char)) + ;; Only insert trailing space and comment-end if comment-end is not empty + (when (not (string-empty-p comment-end)) + (insert " ") + (insert comment-end)))))) + +(defun cj/comment-box () + "Insert a comment box around text that the user inputs. + +The box extends to the fill column, centers the text, and uses the current +mode's comment syntax at both the beginning and end of each line. The box +respects the current indentation level and avoids trailing whitespace." + (interactive) + (let* ((comment-char (if (equal comment-start ";") ";;" + (string-trim comment-start))) + (comment-end-char (if (string-empty-p comment-end) + comment-char + (string-trim comment-end))) + (line-char (if (equal comment-char ";;") "-" "#")) + (comment (capitalize (string-trim (read-from-minibuffer "Comment: ")))) + (comment-length (length comment)) + (current-column-pos (current-column)) + (max-width (min fill-column 80)) + ;; Calculate available width between comment markers + (available-width (- max-width + current-column-pos + (length comment-char) + (length comment-end-char))) + ;; Inner width is the width without the spaces after comment start and before comment end + (inner-width (- available-width 2)) + ;; Calculate padding for each side of the centered text + (padding-each-side (max 1 (/ (- inner-width comment-length) 2))) + ;; Adjust for odd-length comments + (right-padding (if (= (% (- inner-width comment-length) 2) 0) + padding-each-side + (1+ padding-each-side)))) + + ;; Check if we have enough space + (if (< inner-width (+ comment-length 4)) ; minimum sensible width + (message "Comment string is too big to fit in one line") + (progn + ;; Top line - fill entirely with line characters except for space after comment start + (insert comment-char) + (insert " ") + (insert (make-string inner-width (string-to-char line-char))) + (insert " ") + (insert comment-end-char) + (newline) + + ;; Add indentation on the new line to match current column + (dotimes (_ current-column-pos) (insert " ")) + + ;; Middle line with centered text + (insert comment-char) + (insert " ") + ;; Left padding + (dotimes (_ padding-each-side) (insert " ")) + ;; The comment text + (insert comment) + ;; Right padding + (dotimes (_ right-padding) (insert " ")) + (insert " ") + (insert comment-end-char) + (newline) + + ;; Add indentation on the new line to match current column + (dotimes (_ current-column-pos) (insert " ")) + + ;; Bottom line - same as top line + (insert comment-char) + (insert " ") + (dotimes (_ inner-width) (insert line-char)) + (insert " ") + (insert comment-end-char) + (newline))))) + +(defun cj/comment-hyphen() + "Insert a centered comment with '-' (hyphens) on each side." + (interactive) + (cj/comment-centered "-")) + +(defun cj/delete-buffer-comments () + "Delete all comments within the current buffer." + (interactive) + (goto-char (point-min)) + (let (kill-ring) + (comment-kill (count-lines (point-min) (point-max))))) + +;; Comment styles & removal prefix and keymap +(define-prefix-command 'cj/comment-map nil + "Keymap for comment styling and removal.") +(define-key cj/custom-keymap "C" 'cj/comment-map) +(define-key cj/comment-map "r" 'cj/comment-reformat) +(define-key cj/comment-map "c" 'cj/comment-centered) +(define-key cj/comment-map "-" 'cj/comment-hyphen) +(define-key cj/comment-map "b" 'cj/comment-box) +(define-key cj/comment-map "D" 'cj/delete-buffer-comments) + +;;; ---------------------- Ordering And Sorting Operations ---------------------- + +(defun cj/arrayify (start end quote) + "Convert lines between START and END into quoted, comma-separated strings. + +START and END identify the active region. +QUOTE specifies the quotation characters to surround each element." + (interactive "r\nMQuotation character to use for array element: ") + (let ((insertion + (mapconcat + (lambda (x) (format "%s%s%s" quote x quote)) + (split-string (buffer-substring start end)) ", "))) + (delete-region start end) + (insert insertion))) + +(defun cj/unarrayify (start end) + "Convert quoted, comma-separated strings between START and END into separate lines. + +START and END identify the active region." + (interactive "r") + (let ((insertion + (mapconcat + (lambda (x) (replace-regexp-in-string "[\"']" "" x)) + (split-string (buffer-substring start end) ", ") "\n"))) + (delete-region start end) + (insert insertion))) + +(defun cj/alphabetize-region () + "Alphabetize words in the active region and replace the original text. + +Produce a comma-separated list as the result." + (interactive) + (unless (use-region-p) + (user-error "No region selected")) + (let ((start (region-beginning)) + (end (region-end)) + (string (buffer-substring-no-properties (region-beginning) (region-end)))) + (delete-region start end) + (goto-char start) + (insert + (mapconcat #'identity + (sort (split-string string "[[:space:],]+" t) + #'string-lessp) + ", ")))) + +(defun cj/comma-separated-text-to-lines () + "Break up comma-separated text in the active region so each item is on its own line." + (interactive) + (if (not (region-active-p)) + (error "No region selected")) + + (let ((beg (region-beginning)) + (end (region-end)) + (text (buffer-substring-no-properties (region-beginning) (region-end)))) + (with-temp-buffer + (insert text) + (goto-char (point-min)) + (while (search-forward "," nil t) + (replace-match "\n" nil t)) + (delete-trailing-whitespace) + (setq text (buffer-string))) + + (delete-region beg end) + (goto-char beg) + (insert text))) + + +;; Ordering & sorting prefix and keymap +(define-prefix-command 'cj/ordering-map nil + "Keymap for text ordering and sorting operations.") +(define-key cj/custom-keymap "o" 'cj/ordering-map) +(define-key cj/ordering-map "a" 'cj/arrayify) +(define-key cj/ordering-map "u" 'cj/unarrayify) +(define-key cj/ordering-map "A" 'cj/alphabetize-region) +(define-key cj/ordering-map "l" 'cj/comma-separated-text-to-lines) + +;;; --------------------------- Case Change Operations -------------------------- + +(defun cj/title-case-region () + "Capitalize the region in title case format. + +Title case is a capitalization convention where major words +are capitalized,and most minor words are lowercase. Nouns, +verbs (including linking verbs), adjectives, adverbs,pronouns, +and all words of four letters or more are considered major words. +Short (i.e., three letters or fewer) conjunctions, short prepositions, +and all articles are considered minor words." + (interactive) + (let ((beg nil) + (end nil) + (prev-word-end nil) + ;; Allow capitals for skip characters after this, so: + ;; Warning: An Example + ;; Capitalizes the `An'. + (chars-skip-reset '(?: ?! ??)) + ;; Don't capitalize characters directly after these. e.g. + ;; "Foo-bar" or "Foo\bar" or "Foo's". + + (chars-separator '(?\\ ?- ?' ?.)) + + (word-chars "[:alnum:]") + (word-skip + (list "a" "an" "and" "as" "at" "but" "by" + "for" "if" "in" "is" "nor" "of" + "on" "or" "so" "the" "to" "yet")) + (is-first t)) + (cond + ((region-active-p) + (setq beg (region-beginning)) + (setq end (region-end))) + (t + (setq beg (line-beginning-position)) + (setq end (line-end-position)))) + (save-excursion + ;; work on uppercased text (e.g., headlines) by downcasing first + (downcase-region beg end) + (goto-char beg) + + (while (< (point) end) + (setq prev-word-end (point)) + (skip-chars-forward (concat "^" word-chars) end) + (let ((word-end + (save-excursion + (skip-chars-forward word-chars end) + (point)))) + + (unless (memq (char-before (point)) chars-separator) + (let* ((c-orig (char-to-string (char-after (point)))) + (c-up (capitalize c-orig))) + (unless (string-equal c-orig c-up) + (let ((word (buffer-substring-no-properties (point) word-end))) + (when + (or + ;; Always allow capitalization. + is-first + ;; If it's not a skip word, allow. + (not (member word word-skip)) + ;; Check the beginning of the previous word doesn't reset first. + (save-excursion + (and + (not (zerop + (skip-chars-backward "[:blank:]" prev-word-end))) + (memq (char-before (point)) chars-skip-reset)))) + (delete-region (point) (1+ (point))) + (insert c-up)))))) + (goto-char word-end) + (setq is-first nil)))))) + +;; replace the capitalize-region keybinding to call title-case +(global-set-key [remap capitalize-region] 'cj/title-case-region) + +(defun cj/upcase-dwim () + "Upcase the active region, or upcase the symbol at point if no region." + (interactive) + (if (use-region-p) + (upcase-region (region-beginning) (region-end)) + (let ((bounds (bounds-of-thing-at-point 'symbol))) + (if bounds + (upcase-region (car bounds) (cdr bounds)) + (user-error "No symbol at point"))))) + +(defun cj/downcase-dwim () + "Downcase the active region, or downcase the symbol at point if no region." + (interactive) + (if (use-region-p) + (downcase-region (region-beginning) (region-end)) + (let ((bounds (bounds-of-thing-at-point 'symbol))) + (if bounds + (downcase-region (car bounds) (cdr bounds)) + (user-error "No symbol at point"))))) + +;; Case-change operations prefix and keymap +(define-prefix-command 'cj/case-map nil + "Keymap for case-change operations.") +(define-key cj/custom-keymap "c" 'cj/case-map) +(define-key cj/case-map "t" 'cj/title-case-region) +(define-key cj/case-map "u" 'cj/upcase-dwim) +(define-key cj/case-map "l" 'cj/downcase-dwim) ;; for "lower" case + +(provide 'custom-functions) +;;; custom-functions.el ends here. diff --git a/modules/dashboard-config.el b/modules/dashboard-config.el new file mode 100644 index 00000000..73a76b6b --- /dev/null +++ b/modules/dashboard-config.el @@ -0,0 +1,144 @@ +;;; dashboard-config.el --- Dashboard Configuration -*- lexical-binding: t; coding: utf-8; -*- +;; author Craig Jennings + +;;; Commentary: + +;; Note: +;; Nerd-Icons Cheat Sheet: https://www.nerdfonts.com/cheat-sheet + +;;; Code: + +(require 'undead-buffers) + +;; ------------------------ Dashboard Bookmarks Override ----------------------- +;; overrides the bookmark insertion from the dashboard package to provide an +;; option that only shows the bookmark name, avoiding the path. Paths are often +;; too long and the truncation options aren't aesthetically pleasing. Should be +;; accompanied by the setting (setq dashboard-bookmarks-show-path nil) in +;; config. + +(defcustom dashboard-bookmarks-item-format "%s" + "Format to use when showing the base of the file name." + :type 'string + :group 'dashboard) + +(defun dashboard-insert-bookmarks (list-size) + "Add the list of LIST-SIZE items of bookmarks." + (require 'bookmark) + (dashboard-insert-section + "Bookmarks:" + (dashboard-subseq (bookmark-all-names) list-size) + list-size + 'bookmarks + (dashboard-get-shortcut 'bookmarks) + `(lambda (&rest _) (bookmark-jump ,el)) + (if-let* ((filename el) + (path (bookmark-get-filename el)) + (path-shorten (dashboard-shorten-path path 'bookmarks))) + (cl-case dashboard-bookmarks-show-path + (`align + (unless dashboard--bookmarks-cache-item-format + (let* ((len-align (dashboard--align-length-by-type 'bookmarks)) + (new-fmt (dashboard--generate-align-format + dashboard-bookmarks-item-format len-align))) + (setq dashboard--bookmarks-cache-item-format new-fmt))) + (format dashboard--bookmarks-cache-item-format filename path-shorten)) + (`nil filename) + (t (format dashboard-bookmarks-item-format filename path-shorten))) + el))) + +;; ----------------------------- Display Dashboard ----------------------------- +;; convenience function to redisplay dashboard and kill all other windows + +(defun cj/dashboard-only () + "Switch to *dashboard* buffer and kill all other buffers and windows." + (interactive) + (dired-sidebar-hide-sidebar) + (if (get-buffer "*dashboard*") + (progn + (switch-to-buffer "*dashboard*") + (cj/kill-all-other-buffers-and-windows)) + (dashboard-open))) + +;; --------------------------------- Dashboard --------------------------------- +;; a useful startup screen for Emacs + +(use-package dashboard + :defer t + :hook (emacs-startup . cj/dashboard-only) + :bind ("" . cj/dashboard-only) + :custom + (dashboard-projects-backend 'projectile) + + (dashboard-item-generators + '((projects . dashboard-insert-projects) + (bookmarks . dashboard-insert-bookmarks))) + + (dashboard-items '((projects . 5) + (bookmarks . 15))) + + (dashboard-startupify-list + '(dashboard-insert-banner + dashboard-insert-banner-title + dashboard-insert-newline + dashboard-insert-newline + dashboard-insert-navigator + dashboard-insert-init-info + dashboard-insert-newline + dashboard-insert-newline + dashboard-insert-items + dashboard-insert-newline)) + :config + + ;; == general + (dashboard-setup-startup-hook) ;; run dashboard post emacs init + + (if (< (length command-line-args) 2) + (setq initial-buffer-choice (lambda () (get-buffer "*dashboard*")))) ;; don't display dashboard if opening a file + (setq dashboard-display-icons-p t) ;; display icons on both GUI and terminal + (setq dashboard-icon-type 'nerd-icons) ;; use `nerd-icons' package + (setq dashboard-center-content t) ;; horizontally center dashboard content + (setq dashboard-bookmarks-show-path nil) ;; don't show paths in bookmarks + (setq dashboard-set-footer nil) ;; don't show footer and quotes + + ;; == banner + (setq dashboard-startup-banner (concat user-emacs-directory "assets/M-x_butterfly.png")) + (setq dashboard-banner-logo-title "Emacs: The Editor That Saves Your Soul") + + ;; == navigation + (setq dashboard-set-navigator t) + (setq dashboard-navigator-buttons + `(((,(nerd-icons-faicon "nf-fa-envelope") + "Email" "Mu4e Email Client" + (lambda (&rest _) (mu4e))) + + (,(nerd-icons-faicon "nf-fae-book_open_o") + "Ebooks" "Calibre Ebook Reader" + (lambda (&rest _) (calibredb))) + + (,(nerd-icons-mdicon "nf-md-school") + "Flashcards" "Org-Drill" + (lambda (&rest _) (cj/drill-start))) + + (,(nerd-icons-faicon "nf-fa-rss_square") + "Feeds" "Elfeed Feed Reader" + (lambda (&rest _) (cj/elfeed-open))) + + (,(nerd-icons-faicon "nf-fa-comments") + "IRC" "Emacs Relay Chat" + (lambda (&rest _) (cj/erc-start-or-switch))) + + ;; (,(nerd-icons-faicon "nf-fae-telegram") + ;; "Telegram" "Telega Chat Client" + ;; (lambda (&rest _) (telega))) + + (,(nerd-icons-faicon "nf-fa-folder_o") + "Files" "Dirvish File Manager" + (lambda (&rest _) (dirvish user-home-dir)))))) + + ;; == content + (setq dashboard-show-shortcuts nil) ;; don't show dashboard item abbreviations + ) ;; end use-package dashboard + +(provide 'dashboard-config) +;;; dashboard-config.el ends here. diff --git a/modules/diff-config.el b/modules/diff-config.el new file mode 100644 index 00000000..ff106ead --- /dev/null +++ b/modules/diff-config.el @@ -0,0 +1,53 @@ +;;; diff-config.el --- diff Configuration -*- lexical-binding: t; coding: utf-8; -*- +;; author Craig Jennings + +;;; Commentary: + +;; I've configured Ediff for a clean and efficient diff experience. + +;; • Ediff will use a plain control window, horizontal splits, ignore whitespace, and only highlight the current change. +;; • A single keymap under "C-c D" has bindings: +;; - ediff-files (f) +;; - ediff-buffers (b) +;; - ediff-revision (r) +;; - ediff-directories (D) +;; • An Ediff hook that remaps j/k to next/previous differences for easier navigation +;; • The winner-mode functionality ensures window layouts are restored after quitting Ediff + +;; Note: Here's a highly useful setup for configuring ediff. +;; https://oremacs.com/2015/01/17/setting-up-ediff/ + +;;; Code: + +(use-package ediff + :ensure nil ;; built-in + :defer t + :custom + (ediff-window-setup-function 'ediff-setup-windows-plain) + (ediff-split-window-function 'split-window-horizontally) + (ediff-diff-options "-w") + (ediff-highlight-all-diffs nil) + :bind-keymap ("C-c D" . cj/ediff-map) + :init + ;; adding this to a hook to make sure ediff is loaded due to :defer + (defvar cj/ediff-map + (let ((m (make-sparse-keymap))) + (define-key m "f" #'ediff-files) ; C-c D f + (define-key m "b" #'ediff-buffers) ; C-c D b + (define-key m "r" #'ediff-revision) ; C-c D r + (define-key m "D" #'ediff-directories) ; C-c D D + m) + "Prefix map for quick Ediff commands under C-c D.") + :config + (defun cj/ediff-hook () + "Use j/k to navigate differences in Ediff." + (ediff-setup-keymap) ;; keep the defaults… + (define-key ediff-mode-map "j" #'ediff-next-difference) + (define-key ediff-mode-map "k" #'ediff-previous-difference)) + + (add-hook 'ediff-mode-hook #'cj/ediff-hook) + (add-hook 'ediff-after-quit-hook-internal #'winner-undo)) + + +(provide 'diff-config) +;;; diff-config.el ends here diff --git a/modules/dirvish-config.el b/modules/dirvish-config.el new file mode 100644 index 00000000..82b44008 --- /dev/null +++ b/modules/dirvish-config.el @@ -0,0 +1,403 @@ +;;; dirvish-config.el --- Dired/Dirvish Configuration -*- lexical-binding: t; coding: utf-8; -*- +;; author: Craig Jennings + +;;; Commentary: + +;; DIRVISH NOTES: +;; access the quick access directories by pressing 'g' (for "go") + +;;; Code: + +(require 'user-constants) +(require 'system-utils) + +;;; ----------------------------- Dired Ediff Files ----------------------------- + +(defun cj/dired-ediff-files () + "Ediff two selected files within Dired." + (interactive) + (let ((files (dired-get-marked-files)) + (wnd (current-window-configuration))) + (if (<= (length files) 2) + (let ((file1 (car files)) + (file2 (if (cdr files) + (cadr files) + (read-file-name + "file: " + (dired-dwim-target-directory))))) + (if (file-newer-than-file-p file1 file2) + (ediff-files file2 file1) + (ediff-files file1 file2)) + (add-hook 'ediff-after-quit-hook-internal + (lambda () + (setq ediff-after-quit-hook-internal nil) + (set-window-configuration wnd)))) + (error "No more than 2 files should be marked")))) + +;; ------------------------ Create Playlist From Marked ------------------------ + +(defvar cj/audio-file-extensions + '("mp3" "flac" "m4a" "wav" "ogg" "aac" "opus" "aiff" "alac" "wma") + "List of audio file extensions (lowercase, no dot). +Used to filter files for M3U playlists.") + +(defun cj/dired-create-playlist-from-marked () + "Create an .m3u playlist file from marked files in Dired (or Dirvish). + +Filters for audio files, prompts for the playlist name, and saves the resulting +.m3u in the directory specified by =music-dir=. Interactive use only." + (interactive) + (let* ((marked-files (dired-get-marked-files)) + (audio-files + (cl-remove-if-not + (lambda (f) + (let ((ext (file-name-extension f))) + (and ext + (member (downcase ext) cj/audio-file-extensions)))) + marked-files)) + (count (length audio-files))) + (if (zerop count) + (user-error "No audio files marked (extensions: %s)" + (string-join cj/audio-file-extensions ", ")) + (let ((base-name nil) + (playlist-path nil) + (done nil)) + (while (not done) + (setq base-name (read-string + (format "Playlist name (without .m3u): "))) + ;; Sanitize: strip any trailing .m3u + (setq base-name (replace-regexp-in-string "\\.m3u\\'" "" base-name)) + (setq playlist-path (expand-file-name (concat base-name ".m3u") music-dir)) + (cond + ((not (file-exists-p playlist-path)) + ;; Safe to write + (setq done t)) + (t + (let ((choice (read-char-choice + (format "Playlist '%s' exists. [o]verwrite, [c]ancel, [r]ename? " + (file-name-nondirectory playlist-path)) + '(?o ?c ?r)))) + (cl-case choice + (?o (setq done t)) + (?c (user-error "Cancelled playlist creation")) + (?r (setq done nil))))))) + ;; Actually write the file + (with-temp-file playlist-path + (dolist (af audio-files) + (insert af "\n"))) + (message "Wrote playlist %s with %d tracks" (file-name-nondirectory playlist-path) count))))) + +;;; ----------------------------------- Dired ----------------------------------- + +(use-package dired + :ensure nil ;; built-in + :defer t + :bind + (:map dired-mode-map + ([remap dired-summary] . which-key-show-major-mode) + ("E" . wdired-change-to-wdired-mode) ;; edit names and properties in buffer + ("e" . cj/dired-ediff-files)) ;; ediff files + :custom + (dired-use-ls-dired nil) ;; non GNU FreeBSD doesn't support a "--dired" switch + :config + (setq dired-listing-switches "-l --almost-all --human-readable --group-directories-first") + (setq dired-dwim-target t) + (setq dired-clean-up-buffers-too t) ;; offer to kill buffers associated deleted files and dirs + (setq dired-clean-confirm-killing-deleted-buffers t) ;; don't ask; just kill buffers associated with deleted files + (setq dired-recursive-copies (quote always)) ;; “always” means no asking + (setq dired-recursive-deletes (quote top))) ;; “top” means ask once + +;; note: disabled as it prevents marking and moving files to another directory +;; (setq dired-kill-when-opening-new-dired-buffer t) ;; don't litter by leaving buffers when navigating directories + +(add-hook 'dired-mode-hook 'auto-revert-mode) ;; auto revert dired when files change + +;;; --------------------------- Dired Open HTML In EWW -------------------------- + +(defun cj/dirvish-open-html-in-eww () + "Open HTML file at point in dired/dirvish using eww." + (interactive) + (let ((file (dired-get-file-for-visit))) + (if (string-match-p "\\.html?\\'" file) + (eww-open-file file) + (message "Not an HTML file: %s" file)))) + +;;; ------------------------ Dired Mark All Visible Files ----------------------- + +(defun cj/dired-mark-all-visible-files () + "Mark all visible files in Dired mode." + (interactive) + (save-excursion + (goto-char (point-min)) + (while (not (eobp)) + (if (not (looking-at "^. d")) + (dired-mark 1)) + (forward-line 1)))) + +;;; ----------------------- Dirvish Open File Manager Here ---------------------- + +(defun cj/dirvish-open-file-manager-here () + "Open system's default file manager in the current dired/dirvish directory. + +Always opens the file manager in the directory currently being displayed, +regardless of what file or subdirectory the point is on." + (interactive) + (let ((current-dir (dired-current-directory))) + (if (and current-dir (file-exists-p current-dir)) + (progn + (message "Opening file manager in %s..." current-dir) + ;; Use shell-command with & to run asynchronously and detached + (let ((process-connection-type nil)) ; Use pipe instead of pty + (cond + ;; Linux/Unix with xdg-open + ((executable-find "xdg-open") + (call-process "xdg-open" nil 0 nil current-dir)) + ;; macOS + ((eq system-type 'darwin) + (call-process "open" nil 0 nil current-dir)) + ;; Windows + ((eq system-type 'windows-nt) + (call-process "explorer" nil 0 nil current-dir)) + ;; Fallback to shell-command + (t + (shell-command (format "xdg-open %s &" + (shell-quote-argument current-dir))))))) + (message "Could not determine current directory.")))) + +;;; ---------------------------------- Dirvish ---------------------------------- + +(use-package dirvish + :defer 1 + :init + (dirvish-override-dired-mode) + :custom + ;; This MUST be in :custom section, not :config + (dirvish-quick-access-entries + `(("h" "~/" "home") + ("cx" ,code-dir "code directory") + ("ex" ,user-emacs-directory "emacs home") + ("es" ,sounds-dir "notification sounds") + ("ra" ,video-recordings-dir "video recordings") + ("rv" ,audio-recordings-dir "audio recordings") + ("dl" ,dl-dir "downloads") + ("dr" ,(concat sync-dir "/drill/") "drill files") + ("dt" ,(concat dl-dir "/torrents/complete/") "torrents") + ("dx" "~/documents/" "documents") + ("lx" "~/lectures/" "lectures") + ("mb" "/media/backup/" "backup directory") + ("mx" "~/music/" "music") + ("pD" "~/projects/documents/" "project documents") + ("pd" "~/projects/danneel/" "project danneel") + ("pl" "~/projects/elibrary/" "project elibrary") + ("pf" "~/projects/finances/" "project finances") + ("pjr" "~/projects/jr-estate/" "project jr-estate") + ("ps" ,(concat pix-dir "/screenshots/") "pictures screenshots") + ("pw" ,(concat pix-dir "/wallpaper/") "pictures wallpaper") + ("px" ,pix-dir "pictures directory") + ("rcj" "/sshx:cjennings@cjennings.net:~" "remote cjennings.net") + ("rsb" "/sshx:cjennings@wolf.usbx.me:/home/cjennings/" "remote seedbox") + ("sx" ,sync-dir "sync directory") + ("so" "~/sync/org" "org directory") + ("sv" "~/sync/videos/" "sync/videos directory") + ("tg" ,(concat sync-dir "/text.games") "text games") + ("vr" ,video-recordings-dir "video recordings directory") + ("vx" ,videos-dir "videos"))) + :config + ;; Add the extensions directory to load-path + (let ((extensions-dir (expand-file-name "extensions" + (file-name-directory (locate-library "dirvish"))))) + (when (file-directory-p extensions-dir) + (add-to-list 'load-path extensions-dir))) + + ;; Load dirvish modules with error checking + (let ((dirvish-modules '(dirvish-emerge + dirvish-subtree + dirvish-narrow + dirvish-history + dirvish-ls + dirvish-yank + dirvish-quick-access + dirvish-collapse + dirvish-rsync + dirvish-vc + dirvish-icons + dirvish-side + dirvish-peek))) + (dolist (module dirvish-modules) + (condition-case err + (require module) + (error + (message "Failed to load %s: %s" module (error-message-string err)))))) + + ;; Enable peek mode with error checking + (condition-case err + (dirvish-peek-mode 1) + (error (message "Failed to enable dirvish-peek-mode: %s" (error-message-string err)))) + + ;; Enable side-follow mode with error checking + (condition-case err + (dirvish-side-follow-mode 1) + (error (message "Failed to enable dirvish-side-follow-mode: %s" + (error-message-string err)))) + + ;; Your other configuration settings + (setq dirvish-attributes '(nerd-icons file-size)) + (setq dirvish-preview-dispatchers '(image gif video audio epub pdf archive)) + (setq dirvish-use-mode-line nil) + (setq dirvish-use-header-line nil) + :bind + (("C-x d" . dirvish) + ("C-x C-d" . dirvish) + ("C-x D" . dirvish) + ("" . dirvish-side) + :map dirvish-mode-map + ("bg" . (lambda () (interactive) + (shell-command + (concat "nitrogen --save --set-zoom-fill " + (dired-file-name-at-point) " >>/dev/null 2>&1")))) + ("/" . dirvish-narrow) + ("" . dired-up-directory) + ("" . dired-find-file) + ("C-," . dirvish-history-go-backward) + ("C-." . dirvish-history-go-forward) + ("F" . dirvish-file-info-menu) + ("G" . revert-buffer) + ("l" . (lambda () (interactive) (cj/dired-copy-path-as-kill))) ;; overwrites dired-do-redisplay + ("h" . cj/dirvish-open-html-in-eww) ;; it does what it says it does + ("M" . cj/dired-mark-all-visible-files) + ("M-e" . dirvish-emerge-menu) + ("M-l" . dirvish-ls-switches-menu) + ("M-m" . dirvish-mark-menu) + ("M-p" . dirvish-peek-toggle) + ("M-s" . dirvish-setup-menu) + ("TAB" . dirvish-subtree-toggle) + ("d". dired-flag-file-deletion) + ("f" . cj/dirvish-open-file-manager-here) + ("g" . dirvish-quick-access) + ("o" . cj/xdg-open) + ("O" . cj/open-file-with-command) ; Prompts for command to run + ("r" . dirvish-rsync) + ("p" . cj/dired-create-playlist-from-marked) + ("s" . dirvish-quicksort) + ("v" . dirvish-vc-menu) + ("y" . dirvish-yank-menu))) + +;;; -------------------------------- Nerd Icons ------------------------------- + +(use-package nerd-icons + :defer .5) + +(use-package nerd-icons-dired + :commands (nerd-icons-dired-mode)) + +;;; ---------------------------- Dired Hide Dotfiles ---------------------------- + +(use-package dired-hide-dotfiles + :after dired + :hook + ;; Auto-hide dotfiles when entering dired/dirvish + ((dired-mode . dired-hide-dotfiles-mode) + (dirvish-mode . dired-hide-dotfiles-mode)) + :bind + (:map dired-mode-map + ("." . dired-hide-dotfiles-mode))) + +;;; ------------------------------- Dired Sidebar ------------------------------- + +(use-package dired-sidebar + :after (dired projectile) + :bind (("" . dired-sidebar-toggle-sidebar)) + :commands (dired-sidebar-toggle-sidebar) + :init + (add-hook 'dired-sidebar-mode-hook + (lambda () + (unless (file-remote-p default-directory) + (auto-revert-mode)))) + :config + (push 'toggle-window-split dired-sidebar-toggle-hidden-commands) ;; disallow splitting dired window when it's showing + (push 'rotate-windows dired-sidebar-toggle-hidden-commands) ;; disallow rotating windows when sidebar is showing + (setq dired-sidebar-subtree-line-prefix " ") ;; two spaces give simple and aesthetic indentation + (setq dired-sidebar-no-delete-other-windows t) ;; don't close when calling 'delete other windows' + (setq dired-sidebar-theme 'nerd-icons) ;; gimme fancy icons, please + (setq dired-sidebar-use-custom-font 'nil) ;; keep the same font as the rest of Emacs + (setq dired-sidebar-delay-auto-revert-updates 'nil) ;; don't delay auto-reverting + (setq dired-sidebar-pop-to-sidebar-on-toggle-open 'nil)) ;; don't jump to sidebar when it's toggled on + +;; --------------------------------- Copy Path --------------------------------- + +(defun cj/dired-copy-path-as-kill (&optional as-org-link) + "Copy path of file at point in Dired/Dirvish. +Copies relative path from project root if in a project, otherwise from home +directory (with ~ prefix) if applicable, otherwise the absolute path. + +With prefix arg or when AS-ORG-LINK is non-nil, format as \='org-mode\=' link." + (interactive "P") + (unless (derived-mode-p 'dired-mode) + (user-error "Not in a Dired buffer")) + + (let* ((file (dired-get-filename nil t)) + (file-name (file-name-nondirectory file)) + (project-root (cj/get-project-root)) + (home-dir (expand-file-name "~")) + path path-type) + + (unless file + (user-error "No file at point")) + + (cond + ;; Project-relative path + (project-root + (setq path (file-relative-name file project-root) + path-type "project-relative")) + + ;; Home-relative path + ((string-prefix-p home-dir file) + (let ((relative-from-home (file-relative-name file home-dir))) + (setq path (if (string= relative-from-home ".") + "~" + (concat "~/" relative-from-home)) + path-type "home-relative"))) + + ;; Absolute path + (t + (setq path file + path-type "absolute"))) + + ;; Format as org-link if requested + (when as-org-link + (setq path (format "[[file:%s][%s]]" path file-name))) + + ;; Copy to kill-ring and clipboard + (kill-new path) + + ;; Provide feedback + (message "Copied %s path%s: %s" + path-type + (if as-org-link " as org-link" "") + (if (> (length path) 60) + (concat (substring path 0 57) "...") + path)))) + +(defun cj/get-project-root () + "Get project root using projectile or project.el. +Returns nil if not in a project." + (cond + ;; Try projectile first if available + ((and (fboundp 'projectile-project-root) + (ignore-errors (projectile-project-root)))) + + ;; Fallback to project.el + ((and (fboundp 'project-current) + (project-current)) + (let ((proj (project-current))) + (if (fboundp 'project-root) + (project-root proj) + ;; Compatibility with older versions + (car (project-roots proj))))) + + ;; No project found + (t nil))) + + +(provide 'dirvish-config) +;;; dirvish-config.el ends here. diff --git a/modules/dwim-shell-config.el b/modules/dwim-shell-config.el new file mode 100644 index 00000000..a1ace2be --- /dev/null +++ b/modules/dwim-shell-config.el @@ -0,0 +1,732 @@ +;; dwim-shell-config.el --- Dired Shell Commands -*- coding: utf-8; lexical-binding: t; -*- +;; +;;; Commentary: +;; +;; This module provides a collection of DWIM (Do What I Mean) shell commands +;; for common file operations in Dired and other buffers. It leverages the +;; `dwim-shell-command' package to execute shell commands on marked files +;; with smart templating and progress tracking. +;; +;; Features: +;; - Audio/Video conversion (mp3, opus, webp, HEVC) +;; - Image manipulation (resize, flip, format conversion) +;; - PDF operations (merge, split, password protection, OCR) +;; - Archive management (zip/unzip) +;; - Document conversion (epub to org, docx to pdf, pdf to txt) +1;; - Git operations (clone from clipboard) +;; - External file opening with context awareness +;; +;; Workflow: +;; 1. *Mark files in Dired/Dirvish* +;; - Use =m= to mark individual files +;; - Use =* .= to mark by extension +;; - Use =% m= to mark by regexp +;; - Or operate on the file under cursor if nothing is marked +;; +;; 2. *Execute a DWIM command* +;; - Call the command via =M-x dwim-shell-commands-[command-name]= +;; - Or bind frequently used commands to keys +;; +;; 3. *Command execution* +;; - The command runs asynchronously in the background +;; - A =*Async Shell Command*= buffer shows progress +;; - Files are processed with smart templating (replacing =<>=, =<>=, etc.) +;; +;; 4. *Results* +;; - New files appear in the Dired/Dirvish buffer +;; - Buffer auto-refreshes when command completes +;; - Errors appear in the async buffer if something fails +;; +;; Requirements: +;; The commands rely on various external utilities that need to be installed: +;; - ffmpeg: Audio/video conversion +;; - imagemagick (convert): Image manipulation +;; - qpdf: PDF operations +;; - tesseract: OCR functionality +;; - pandoc: Document conversion +;; - atool: Archive extraction +;; - rsvg-convert: SVG to PNG conversion +;; - pdftotext: PDF text extraction +;; - git: Version control operations +;; - gpgconf: GPG agent management +;; +;; On Arch Linux, install the requirements with: +;; #+begin_src bash +;; sudo pacman -S --needed ffmpeg imagemagick qpdf tesseract tesseract-data-eng pandoc atool librsvg poppler git gnupg zip unzip mkvtoolnix-cli mpv ruby +;; #+end_src +;; +;; On MacOS, install the requirements with: +;; #+begin_src bash +;; brew install ffmpeg imagemagick qpdf tesseract pandoc atool librsvg poppler gnupg mkvtoolnix mpv +;; #+end_src +;; +;; Usage: +;; Commands operate on marked files in Dired or the current file in other modes. +;; The package automatically replaces standard shell commands with DWIM versions +;; for a more intuitive experience. +;; +;; Template Variables: +;; - <>: Full path to file +;; - <>: File name without extension +;; - <>: File extension +;; - <>: Temporary directory +;; - <>: Clipboard contents +;; - <<*>>: All marked files +;; + +;;; Code: + +(require 'system-utils) + +;; -------------------------- Dwim Shell Commands Menu ------------------------- + +(defun dwim-shell-commands-menu () + "Select and execute a dwim-shell-command function with prettified names." + (interactive) + (let* ((commands (cl-loop for symbol being the symbols + when (and (fboundp symbol) + (string-prefix-p "cj/dwim-shell-commands-" (symbol-name symbol)) + (not (eq symbol 'dwim-shell-commands-menu))) + collect symbol)) + ;; Create alist of (pretty-name . command-symbol) + (command-alist (mapcar (lambda (cmd) + (cons (replace-regexp-in-string + "-" " " + (replace-regexp-in-string + "^cj/dwim-shell-commands-" + "" + (symbol-name cmd))) + cmd)) + commands)) + (selected (completing-read "Command: " + command-alist + nil + t + nil + 'dwim-shell-command-history)) + (command (alist-get selected command-alist nil nil #'string=))) + (when command + (call-interactively command)))) + +(with-eval-after-load 'dired + (define-key dired-mode-map (kbd "M-D") #'dwim-shell-commands-menu)) + +;; ----------------------------- Dwim Shell Command ---------------------------- + +(use-package dwim-shell-command + :defer 0.5 + :bind (([remap shell-command] . dwim-shell-command) + :map dired-mode-map + ([remap dired-do-async-shell-command] . dwim-shell-command) + ([remap dired-do-shell-command] . dwim-shell-command) + ([remap dired-smart-shell-command] . dwim-shell-command)) + :init + (defun cj/dwim-shell-commands-convert-audio-to-mp3 () + "Convert all marked audio to mp3(s)." + (interactive) + (dwim-shell-command-on-marked-files + "Convert to mp3" + "ffmpeg -stats -n -i '<>' -acodec libmp3lame '<>.mp3'" + :utils "ffmpeg")) + + (defun cj/dwim-shell-commands-convert-audio-to-opus () + "Convert all marked audio to opus(s)." + (interactive) + (dwim-shell-command-on-marked-files + "Convert to opus" + "ffmpeg -stats -n -i '<>' -c:a libopus -vbr on -compression_level 10 -b:a 256k '<>.opus'" + :utils "ffmpeg")) + + (defun cj/dwim-shell-commands-view-image-exif-metadata () + "View EXIF metadata in image(s)." + (interactive) + (dwim-shell-command-on-marked-files + "View EXIF" + "exiftool '<>'" + :utils "exiftool")) + + (defun cj/dwim-shell-commands-flip-image-horizontally () + "Horizontally flip image(s)." + (interactive) + (dwim-shell-command-on-marked-files + "Image horizontal flip" + "convert -verbose -flop '<>' '<>_h_flipped.<>'" + :utils "convert")) + + (defun cj/dwim-shell-commands-flip-image-vertically () + "Horizontally flip image(s)." + (interactive) + (dwim-shell-command-on-marked-files + "Image vertical flip" + "convert -verbose -flip '<>' '<>_v_flipped.<>'" + :utils "convert")) + + (defun cj/dwim-shell-commands-convert-image-to () + "Convert all marked images to a specified format." + (interactive) + (let ((format (completing-read "Convert to format: " + '("jpg" "png" "webp" "gif" "bmp" "tiff") + nil t))) + (dwim-shell-command-on-marked-files + (format "Convert to %s" format) + (format "convert -verbose '<>' '<>.%s'" format) + :utils "convert"))) + + (defun cj/dwim-shell-commands-convert-svg-to-png () + "Convert all marked svg(s) to png(s)." + (interactive) + (dwim-shell-command-on-marked-files + "Convert to png" + "rsvg-convert -b white '<>' -f png -o '<>.png'" + :utils "rsvg-convert")) + + (defun cj/dwim-shell-commands-join-images-into-pdf () + "Join all marked images as a single pdf." + (interactive) + (dwim-shell-command-on-marked-files + "Join as pdf" + (format "convert -verbose '<<*>>' '<<%s(u)>>'" + (dwim-shell-command-read-file-name + "Join as pdf named (default \"joined.pdf\"): " + :extension "pdf" + :default "joined.pdf")) + :utils "convert")) + + (defun cj/dwim-shell-commands-extract-pdf-page-number () + "Keep a page from pdf." + (interactive) + (let ((page-num (read-number "Keep page number: " 1))) + (dwim-shell-command-on-marked-files + "Keep pdf page" + (format "qpdf '<>' --pages . %d -- '<>_%d.<>'" page-num page-num) + :utils "qpdf"))) + + (defun cj/dwim-shell-commands-ocr-text-from-image-using-tesseract () + "Extract text from image via tesseract." + (interactive) + (dwim-shell-command-on-marked-files + "Extract text from image via tesseract." + "tesseract '<>' -" + :utils "tesseract")) + + (defun cj/dwim-shell-commands-convert-video-to-webp () + "Convert all marked videos to webp(s)." + (interactive) + (dwim-shell-command-on-marked-files + "Convert to webp" + "ffmpeg -i '<>' -vcodec libwebp -filter:v fps=fps=10 -compression_level 3 -loop 0 -preset default -an -vsync 0 '<>'.webp" + :utils "ffmpeg")) + + (defun cj/dwim-shell-commands-convert-video-to-high-compatibility-mp4 () + "Convert all marked video(s) to MP4 format with H.264/AAC." + (interactive) + (dwim-shell-command-on-marked-files + "Convert to MP4" + "ffmpeg -i '<>' -c:v libx264 -preset slow -crf 23 -profile:v baseline -level 3.0 -c:a aac -b:a 128k '<>.mp4'" + :utils "ffmpeg")) + + (defun cj/dwim-shell-commands-convert-video-to-hevc-mkv () + "Convert all marked videos to HEVC (H.265) in MKV container." + (interactive) + (dwim-shell-command-on-marked-files + "Convert to HEVC/H.265" + "ffmpeg -i '<>' -c:v libx265 -preset slower -crf 22 -x265-params profile=main10:level=4.0 -c:a copy -c:s copy '<>.mkv'" + :utils "ffmpeg")) + + (defun cj/dwim-shell-commands-extract-archive-smartly () + "Unzip all marked archives (of any kind) using =atool'. + +If there's only one file, unzip it to current directory. +Otherwise, unzip it to an appropriately named subdirectory " + (interactive) + (dwim-shell-command-on-marked-files + "Unzip" "atool --extract --subdir --explain '<>'" + :utils "atool")) + + (defun cj/dwim-shell-commands-zip-file-or-directory () + "Zip all marked files into archive.zip." + (interactive) + (dwim-shell-command-on-marked-files + "Zip" (if (eq 1 (seq-length (dwim-shell-command--files))) + "zip -r '<>.<>' '<>'" + "zip -r '<>' '<<*>>'") + :utils "zip")) + + (defun cj/dwim-shell-commands-tar-gzip-file-or-directory () + "Tar gzip all marked files into archive.tar.gz." + (interactive) + (dwim-shell-command-on-marked-files + "Tar gzip" (if (eq 1 (seq-length (dwim-shell-command--files))) + "tar czf '<>.tar.gz' '<>'" + "tar czf '<>' '<<*>>'") + :utils "tar")) + + (defun cj/dwim-shell-commands-epub-to-org () + "Convert epub(s) to org." + (interactive) + (dwim-shell-command-on-marked-files + "epub to org" + "pandoc --from=epub --to=org '<>' > '<>.org'" + :extensions "epub" + :utils "pandoc")) + + (defun cj/dwim-shell-commands-document-to-pdf () + "Convert document(s) to pdf (via latex). + +Supports docx, odt, and other pandoc-compatible formats." + (interactive) + (dwim-shell-command-on-marked-files + "Document to pdf (via latex)" + "pandoc -t latex '<>' -o '<>.pdf'" + :extensions '("docx" "odt" "odp" "ods" "rtf" "doc") + :utils "pdflatex")) + + (defun cj/dwim-shell-commands-pdf-to-txt () + "Convert pdf to txt." + (interactive) + (dwim-shell-command-on-marked-files + "pdf to txt" + "pdftotext -layout '<>' '<>.txt'" + :utils "pdftotext")) + + (defun cj/dwim-shell-commands-resize-image-by-factor () + "Resize marked image(s) by factor." + (interactive) + (dwim-shell-command-on-marked-files + "Resize image" + (let ((factor (read-number "Resize scaling factor: " 0.5))) + (format "convert -resize %%%d '<>' '<>_x%.2f.<>'" + (* 100 factor) factor)) + :utils "convert")) + + (defun cj/dwim-shell-commands-resize-image-in-pixels () + "Resize marked image(s) in pixels." + (interactive) + (dwim-shell-command-on-marked-files + "Resize image" + (let ((width (read-number "Resize width (pixels): " 500))) + (format "convert -resize %dx '<>' '<>_x%d.<>'" width width)) + :utils "convert")) + + (defun cj/dwim-shell-commands-pdf-password-protect () + "Add a password to pdf(s)." + (interactive) + (dwim-shell-command-on-marked-files + "Password protect pdf" + (format "qpdf --verbose --encrypt '%s' '%s' 256 -- '<>' '<>_protected.<>'" + (read-passwd "user-password: ") + (read-passwd "owner-password: ")) + :utils "qpdf" + :extensions "pdf")) + + (defun cj/dwim-shell-commands-pdf-password-unprotect () + "Remove a password from pdf(s)." + (interactive) + (dwim-shell-command-on-marked-files + "Remove protection from pdf" + (format "qpdf --verbose --decrypt --password='%s' -- '<>' '<>_unprotected.<>'" + (read-passwd "password: ")) + :utils "qpdf" + :extensions "pdf")) + + (defun cj/dwim-shell-commands-video-trim () + "Trim video with options for beginning, end, or both." + (interactive) + (let* ((trim-type (completing-read "Trim from: " + '("Beginning" "End" "Both") + nil t)) + (command (pcase trim-type + ("Beginning" + (let ((seconds (read-number "Seconds to trim from beginning: " 5))) + (format "ffmpeg -i '<>' -y -ss %d -c:v copy -c:a copy '<>_trimmed.<>'" + seconds))) + ("End" + (let ((seconds (read-number "Seconds to trim from end: " 5))) + (format "ffmpeg -sseof -%d -i '<>' -y -c:v copy -c:a copy '<>_trimmed.<>'" + seconds))) + ("Both" + (let ((start (read-number "Seconds to trim from beginning: " 5)) + (end (read-number "Seconds to trim from end: " 5))) + (format "ffmpeg -i '<>' -y -ss %d -sseof -%d -c:v copy -c:a copy '<>_trimmed.<>'" + start end)))))) + (dwim-shell-command-on-marked-files + (format "Trim video (%s)" trim-type) + command + :silent-success t + :utils "ffmpeg"))) + + (defun cj/dwim-shell-commands-drop-audio-from-video () + "Drop audio from all marked videos." + (interactive) + (dwim-shell-command-on-marked-files + "Drop audio" + "ffmpeg -i '<>' -c copy -an '<>_no_audio.<>'" + :utils "ffmpeg")) + + (defun cj/dwim-shell-commands-open-externally () + "Open file(s) externally." + (interactive) + (dwim-shell-command-on-marked-files + "Open externally" + (cond ((eq system-type 'darwin) + (if (derived-mode-p 'prog-mode) + (format "open -a Xcode --args --line %d '<>'" + (line-number-at-pos (point))) + "open '<>'")) + ((eq system-type 'windows-nt) + "start '<>'") + (t ;; Linux/Unix + "xdg-open '<>' 2>/dev/null || (echo 'Failed to open with xdg-open' && exit 1)")) + :silent-success t + :utils (cond ((eq system-type 'darwin) "open") + ((eq system-type 'windows-nt) "start") + (t "xdg-open")))) + + + (defun cj/dwim-shell-commands-git-clone-clipboard-url () + "Clone git URL in clipboard to `default-directory'." + (interactive) + (dwim-shell-command-on-marked-files + (format "Clone %s" (file-name-base (current-kill 0))) + "git clone <>" + :utils "git")) + + (defun cj/dwim-shell-commands-open-file-manager () + "Open the default file manager in the current directory." + (interactive) + (dwim-shell-command-on-marked-files + "Open file manager" + (cond ((eq system-type 'darwin) + "open .") + ((eq system-type 'windows-nt) + "explorer .") + (t ;; Linux/Unix - try multiple options + (cond ((executable-find "thunar") "thunar .") + ((executable-find "nautilus") "nautilus .") + ((executable-find "dolphin") "dolphin .") + ((executable-find "pcmanfm") "pcmanfm .") + (t "xdg-open .")))) + :silent-success t + :no-progress t)) + + (defun cj/dwim-shell-commands-count-words-lines () + "Count words, lines, and characters in text file(s)." + (interactive) + (dwim-shell-command-on-marked-files + "Word count" + "wc -lwc '<>'" + :utils "wc")) + + (defun cj/dwim-shell-commands-checksum () + "Generate checksums for file(s) and save to .checksum file." + (interactive) + (let ((algorithm (completing-read "Algorithm: " + '("md5" "sha1" "sha256" "sha512") + nil t))) + (dwim-shell-command-on-marked-files + (format "Generate %s checksum" algorithm) + (format "%ssum '<>' | tee '<>.%s'" algorithm algorithm) + :utils (format "%ssum" algorithm)))) + + (defun cj/dwim-shell-commands-backup-with-timestamp () + "Create dated backup of file(s)." + (interactive) + (dwim-shell-command-on-marked-files + "Backup with date" + "cp -p '<>' '<>.$(date +%Y%m%d_%H%M%S).bak'" + :utils '("cp" "date"))) + + (defun cj/dwim-shell-commands-optimize-image-for-web () + "Optimize image(s) for web (reduce file size)." + (interactive) + (dwim-shell-command-on-marked-files + "Optimize image" + "convert '<>' -strip -interlace Plane -gaussian-blur 0.05 -quality 85% '<>_optimized.<>'" + :utils "convert")) + + (defun cj/dwim-shell-commands-csv-to-json () + "Convert CSV to JSON." + (interactive) + (dwim-shell-command-on-marked-files + "CSV to JSON" + "python -c \"import csv,json,sys; print(json.dumps(list(csv.DictReader(open('<>')))))\" > '<>.json'" + :extensions "csv" + :utils "python")) + + (defun cj/dwim-shell-commands-json-to-yaml () + "Convert JSON to YAML." + (interactive) + (dwim-shell-command-on-marked-files + "JSON to YAML" + "python -c \"import json,yaml,sys; yaml.dump(json.load(open('<>')), open('<>.yaml', 'w'))\" && echo 'Created <>.yaml'" + :extensions "json" + :utils "python")) + + (defun cj/dwim-shell-commands-extract-urls-from-file () + "Extract all URLs from file(s)." + (interactive) + (dwim-shell-command-on-marked-files + "Extract URLs" + "grep -Eo 'https?://[^[:space:]]+' '<>'" + :utils "grep")) + + (defun cj/dwim-shell-commands-extract-emails-from-file () + "Extract all email addresses from file(s)." + (interactive) + (dwim-shell-command-on-marked-files + "Extract emails" + "grep -Eo '[a-zA-Z0-9._%+-]+@[a-zA-Z0-9.-]+\\.[a-zA-Z]{2,}' '<>'" + :utils "grep")) + + (defun cj/dwim-shell-commands-create-gif-from-video () + "Create animated GIF from video." + (interactive) + (let ((fps (read-number "FPS for GIF: " 10)) + (scale (read-number "Scale (pixels width): " 480))) + (dwim-shell-command-on-marked-files + "Create GIF" + (format "ffmpeg -i '<>' -vf 'fps=%d,scale=%d:-1:flags=lanczos' '<>.gif'" fps scale) + :utils "ffmpeg"))) + + (defun cj/dwim-shell-commands-concatenate-videos () + "Concatenate multiple videos into one." + (interactive) + (dwim-shell-command-on-marked-files + "Concatenate videos" + "echo '<<*>>' | tr ' ' '\n' | sed 's/^/file /' > '<>/filelist.txt' && ffmpeg -f concat -safe 0 -i '<>/filelist.txt' -c copy '<>'" + :utils "ffmpeg")) + + (defun cj/dwim-shell-commands-create-video-thumbnail () + "Extract thumbnail from video at specific time." + (interactive) + (let ((time (read-string "Time (HH:MM:SS or seconds): " "00:00:05"))) + (dwim-shell-command-on-marked-files + "Extract video thumbnail" + (format "ffmpeg -i '<>' -ss %s -vframes 1 '<>_thumb.jpg'" time) + :utils "ffmpeg"))) + + (defun cj/dwim-shell-commands-merge-pdfs () + "Merge multiple PDFs into one." + (interactive) + (dwim-shell-command-on-marked-files + "Merge PDFs" + "qpdf --empty --pages '<<*>>' -- '<>'" + :extensions "pdf" + :utils "qpdf")) + + (defun cj/dwim-shell-commands-split-pdf-by-pages () + "Split PDF into individual pages." + (interactive) + (dwim-shell-command-on-marked-files + "Split PDF pages" + "qpdf --split-pages '<>' '<>-page-%d.pdf'" + :extensions "pdf" + :utils "qpdf")) + + (defun cj/dwim-shell-commands-compress-pdf () + "Compress PDF file size." + (interactive) + (let ((quality (completing-read "Quality: " + '("screen" "ebook" "printer" "prepress") + nil t "ebook"))) + (dwim-shell-command-on-marked-files + "Compress PDF" + (format "gs -sDEVICE=pdfwrite -dCompatibilityLevel=1.4 -dPDFSETTINGS=/%s -dNOPAUSE -dBATCH -sOutputFile='<>_compressed.pdf' '<>'" quality) + :extensions "pdf" + :utils "gs"))) + + (defun cj/dwim-shell-commands-ascii-art () + "Convert image to ASCII art." + (interactive) + (dwim-shell-command-on-marked-files + "Create ASCII art" + "jp2a --width=80 '<>'" + :utils "jp2a")) + + (defun cj/dwim-shell-commands-text-to-speech () + "Convert text file to speech (audio file)." + (interactive) + (let ((voice (if (eq system-type 'darwin) + (completing-read "Voice: " '("Alex" "Samantha" "Victoria" "Karen") nil t "Alex") + "en"))) + (dwim-shell-command-on-marked-files + "Text to speech" + (if (eq system-type 'darwin) + (format "say -v %s -o '<>.aiff' -f '<>'" voice) + "espeak -f '<>' -w '<>.wav'") + :utils (if (eq system-type 'darwin) "say" "espeak")))) + + (defun cj/dwim-shell-commands-remove-empty-directories () + "Remove all empty directories recursively." + (interactive) + (when (yes-or-no-p "Remove all empty directories? ") + (dwim-shell-command-on-marked-files + "Remove empty dirs" + "find . -type d -empty -delete" + :utils "find"))) + + (defun cj/dwim-shell-commands-create-thumbnail-from-image () + "Create thumbnail(s) from image(s)." + (interactive) + (let ((size (read-number "Thumbnail size (pixels): " 200))) + (dwim-shell-command-on-marked-files + "Create thumbnail" + (format "convert '<>' -thumbnail %dx%d '<>_thumb.<>'" size size) + :utils "convert"))) + + (defun cj/dwim-shell-commands-extract-audio-from-video () + "Extract audio track from video file(s)." + (interactive) + (dwim-shell-command-on-marked-files + "Extract audio" + "ffmpeg -i '<>' -vn -acodec copy '<>.m4a'" + :utils "ffmpeg")) + + (defun cj/dwim-shell-commands-normalize-audio-volume () + "Normalize audio volume in file(s)." + (interactive) + (dwim-shell-command-on-marked-files + "Normalize audio" + "ffmpeg -i '<>' -af 'loudnorm=I=-16:LRA=11:TP=-1.5' '<>_normalized.<>'" + :utils "ffmpeg")) + + (defun cj/dwim-shell-commands-remove-zip-encryption () + "Remove password protection from zip file(s)." + (interactive) + (let ((password (read-passwd "Current password: "))) + (dwim-shell-command-on-marked-files + "Remove zip encryption" + (format "TMPDIR=$(mktemp -d) && unzip -P '%s' '<>' -d \"$TMPDIR\" && cd \"$TMPDIR\" && zip -r archive.zip * && mv archive.zip '<>_decrypted.zip' && rm -rf \"$TMPDIR\"" + password) + :utils '("unzip" "zip")))) + + (defun cj/dwim-shell-commands-create-encrypted-zip () + "Create password-protected zip of file(s)." + (interactive) + (let ((password (read-passwd "Password: "))) + (dwim-shell-command-on-marked-files + "Create encrypted zip" + (format "zip -r -e -P '%s' '<>' '<<*>>'" password) + :utils "zip"))) + + + (defun cj/dwim-shell-commands-list-archive-contents () + "List contents of archive without extracting." + (interactive) + (dwim-shell-command-on-marked-files + "List archive contents" + "atool --list '<>'" + :utils "atool")) + + (defun cj/dwim-shell-commands-count-words-lines-in-text-file () + "Count words, lines, and characters in text file(s)." + (interactive) + (dwim-shell-command-on-marked-files + "Word count" + "wc -lwc '<>'" + :utils "wc")) + + (defun cj/dwim-shell-commands-make-executable () + "Make file(s) executable." + (interactive) + (dwim-shell-command-on-marked-files + "Make executable" + "chmod +x '<>'" + :silent-success t + :utils "chmod")) + + (defun cj/dwim-shell-commands-secure-delete () + "Securely delete file(s) by overwriting with random data." + (interactive) + (when (yes-or-no-p "This will permanently destroy files. Continue? ") + (dwim-shell-command-on-marked-files + "Secure delete" + "shred -vfz -n 3 '<>'" + :utils "shred"))) + + (defun cj/dwim-shell-commands-sanitize-filename () + "Sanitize filename(s) - remove spaces and special characters." + (interactive) + (dwim-shell-command-on-marked-files + "Sanitize filename" + "NEW_NAME=$(echo '<>' | tr ' ' '_' | tr -cd '[:alnum:]._-'); mv '<>' \"$(dirname '<>')/${NEW_NAME}\"" + :utils '("tr" "mv"))) + + (defun cj/dwim-shell-commands-number-files-sequentially () + "Rename files with sequential numbers." + (interactive) + (let ((prefix (read-string "Prefix (optional): ")) + (start (read-number "Start number: " 1))) + (dwim-shell-command-on-marked-files + "Number files" + (format "mv '<>' '<>/%s<>.<>'" prefix) + :utils "mv"))) + + (defun cj/dwim-shell-commands-git-history () + "Show git history for file(s)." + (interactive) + (dwim-shell-command-on-marked-files + "Git history" + "git log --oneline --follow '<>'" + :utils "git")) + + (defun cj/dwim-shell-commands-encrypt-with-gpg () + "Encrypt file(s) with GPG." + (interactive) + (let ((recipient (read-string "Recipient email (or leave empty for symmetric): "))) + (dwim-shell-command-on-marked-files + "GPG encrypt" + (if (string-empty-p recipient) + "gpg --symmetric --cipher-algo AES256 '<>'" + (format "gpg --encrypt --recipient '%s' '<>'" recipient)) + :utils "gpg"))) + + (defun cj/dwim-shell-commands-decrypt-with-gpg () + "Decrypt GPG file(s)." + (interactive) + (dwim-shell-command-on-marked-files + "GPG decrypt" + "gpg --decrypt '<>' > '<>'" + :extensions '("gpg" "asc" "pgp") + :utils "gpg")) + + +(defun cj/dwim-shell-commands-markdown-to-html5-and-open () + "Convert markdown file to HTML in specified directory and open it." + (interactive) + (let ((files (dwim-shell-command--files))) + ;; verify it's a markdown file + (unless (and files + (= 1 (length files)) + (string-match-p "\\.\\(md\\|markdown\\|mkd\\|mdown\\)\\'" (car files))) + (user-error "Please place cursor on a single markdown file")) + (let* ((dest-dir (expand-file-name (read-directory-name "Destination directory: " default-directory))) + (base-name (file-name-sans-extension (file-name-nondirectory (car files)))) + (output-file (expand-file-name (concat base-name ".html") dest-dir))) + (dwim-shell-command-on-marked-files + "Convert markdown to HTML" + (format "pandoc --standalone --from=markdown --to=html5 --metadata title='<>' '<>' -o '%s'" + output-file) + :utils "pandoc" + :on-completion (lambda (&rest args) + (when (file-exists-p output-file) + (cj/xdg-open output-file) + (message "Opened %s" output-file))))))) + + + + (defun cj/dwim-shell-commands-kill-gpg-agent () + "Kill (thus restart) gpg agent. + +Useful for when you get this error: +gpg: public key decryption failed: No pinentry +gpg: decryption failed: No pinentry" + (interactive) + (dwim-shell-command-on-marked-files + "Kill gpg agent" + "gpgconf --kill gpg-agent" + :utils "gpgconf" + :silent-success t))) + +(provide 'dwim-shell-config) +;;; dwim-shell-config.el ends here. diff --git a/modules/elfeed-config.el b/modules/elfeed-config.el new file mode 100644 index 00000000..46520be2 --- /dev/null +++ b/modules/elfeed-config.el @@ -0,0 +1,290 @@ +;;; elfeed-config --- Settings and Enhancements to the Elfeed RSS Feed Reader -*- lexical-binding: t; coding: utf-8; -*- +;; author Craig Jennings +;; +;;; Commentary: +;; Launch Elfeed with M-R to update feeds and focus the newest entry right away. +;; Inside the search buffer: +;; - Use v to stream via the default player, d to download, w/b to open via EWW or browser. +;; - Hit V to pick a different player for future launches. +;; - Use R/U to mark all visible stories read or unread before narrowing again. +;; +;; When a video needs streaming credentials the player selection drives yt-dlp format choices; +;; use `cj/select-media-player` to swap profiles, or customize `cj/media-players` for your system. +;; All commands assume yt-dlp and your players live on PATH. +;; +;;; Code: + +(require 'user-constants) +(require 'system-utils) +(require 'media-utils) + +;; ------------------------------- Elfeed Config ------------------------------- + +(use-package elfeed + :bind + ("M-R" . cj/elfeed-open) + (:map elfeed-show-mode-map + ("w" . eww-open-in-new-buffer)) + (:map elfeed-search-mode-map + ("w" . cj/elfeed-eww-open) ;; opens in eww + ("b" . cj/elfeed-browser-open) ;; opens in external browser + ("d" . cj/elfeed-youtube-dl) ;; async download with yt-dlp and tsp + ("v" . cj/play-with-video-player)) ;; async play with mpv + ("V" . cj/select-media-player) ;; Capital V to select player + ("R" . cj/elfeed-mark-all-as-read) ;; capital marks all as read, since upper case marks one as read + ("U" . cj/elfeed-mark-all-as-unread) ;; capital marks all as unread, since lower case marks one as unread + :config + (setq elfeed-db-directory (concat user-emacs-directory ".elfeed-db")) + (setq-default elfeed-search-title-max-width 150) + (setq-default elfeed-search-title-min-width 80) + (setq-default elfeed-search-filter "+unread") + (setq elfeed-feeds + '( + ;; The Daily + ("https://www.youtube.com/feeds/videos.xml?playlist_id=PLdMrbgYfVl-s16D_iT2BJCJ90pWtTO1A4" yt nytdaily) + + ;; The Ezra Klein Show + ("https://www.youtube.com/feeds/videos.xml?channel_id=UCnxuOd8obvLLtf5_-YKFbiQ" yt ezra) + + ;; Pivot with Kara Swisher and Scott Galloway + ("https://www.youtube.com/feeds/videos.xml?channel_id=UCBHGZpDF2fsqPIPi0pNyuTg" yt pivot) + + ;; The Prof G Pod + ("https://www.youtube.com/feeds/videos.xml?playlist_id=PLtQ-jBytlXCasRuBG86m22rOQfrEPcctq" yt profg) + + ;; On with Kara Swisher + ("https://www.youtube.com/feeds/videos.xml?playlist_id=PLKof9YSAshgxI6odrEJFKsJbxamwoQBju" yt) + + ;; Raging Moderates + ("https://www.youtube.com/feeds/videos.xml?channel_id=UCcvDWzvxz6Kn1iPQHMl2teA" yt raging-moderates) + + ;; Prof G Markets + ("https://www.youtube.com/feeds/videos.xml?playlist_id=PLtQ-jBytlXCY28ucRF8P1mNMSG8uC06Aw" yt profg-markets) + + ;; Trae Crowder Porch Rants + ("https://www.youtube.com/feeds/videos.xml?playlist_id=PL45Mc1cDgnsB-u1iLPBYNF1fk-y1cVzTJ" yt trae) + + ;; Tropical Tidbits + ("https://www.youtube.com/feeds/videos.xml?channel_id=UCrFIk7g_riIm2G2Vi90pxDA" yt) + + ;; If You're Listening | ABC News In-depth + ("https://www.youtube.com/feeds/videos.xml?playlist_id=PLDTPrMoGHssAfgMMS3L5LpLNFMNp1U_Nq" yt listening) + ))) + +;; ------------------------------ Elfeed Functions ----------------------------- + +(defun cj/elfeed-open () + "Open Elfeed, update all feeds, then move to the first entry." + (interactive) + (elfeed) + (elfeed-update) + (elfeed-search-update--force)) + +;; -------------------------- Elfeed Filter Functions -------------------------- + +(defun cj/elfeed-mark-all-as-read () + "Remove the \='unread\=' tag from all visible entries in search buffer." + (interactive) + (mark-whole-buffer) + (elfeed-search-untag-all-unread)) + +(defun cj/elfeed-mark-all-as-unread () + "Add the \='unread\=' tag from all visible entries in the search buffer." + (interactive) + (mark-whole-buffer) + (elfeed-search-tag-all 'unread)) + +(defun cj/elfeed-set-filter-and-update (filterstring) + "Set the Elfeed filter to FILTERSTRING and update the buffer." + (interactive "sFilter: ") + (setq elfeed-search-filter filterstring) + (elfeed-search-update--force) + (goto-char (point-min))) + +;; ----------------------------- Extract Stream URL ---------------------------- +;; TASK: Is this method reused anywhere here or in another file? + +(defun cj/extract-stream-url (url format) + "Extract the direct stream URL from URL using yt-dlp with FORMAT. +Returns the stream URL or nil on failure." + (unless (executable-find "yt-dlp") + (error "The program yt-dlp is not installed or not in PATH")) + (let* ((format-args (if format + (list "-f" format) + nil)) + (cmd-args (append '("yt-dlp" "-q" "-g") + format-args + (list url))) + ;; DEBUG: Log the command + (_ (cj/log-silently "DEBUG: Extracting with command: %s" + (mapconcat #'shell-quote-argument cmd-args " "))) + (output (with-temp-buffer + (let ((exit-code (apply #'call-process + (car cmd-args) nil t nil + (cdr cmd-args)))) + (if (zerop exit-code) + (string-trim (buffer-string)) + (progn + ;; DEBUG: Log failure + (cj/log-silently "DEBUG: yt-dlp failed with exit code %d" exit-code) + (cj/log-silently "DEBUG: Error output: %s" (buffer-string)) + nil)))))) + ;; DEBUG: Log the result + (cj/log-silently "DEBUG: Extracted URL: %s" + (if output (truncate-string-to-width output 100) "nil")) + (when (and output (string-match-p "^https?://" output)) + output))) + +;; -------------------------- Elfeed Core Processing --------------------------- + +(defun cj/elfeed-process-entries (action-fn action-name &optional skip-error-handling) + "Process selected Elfeed entries with ACTION-FN. +ACTION-NAME is used for error messages. Marks entries as read and +advances to the next line. If SKIP-ERROR-HANDLING is non-nil, errors +are not caught (useful for actions that handle their own errors)." + (let ((entries (elfeed-search-selected))) + (unless entries + (error "No entries selected")) + (cl-loop for entry in entries + do (elfeed-untag entry 'unread) + for link = (elfeed-entry-link entry) + when link + do (if skip-error-handling + (funcall action-fn link) + (condition-case err + (funcall action-fn link) + (error (message "Failed to %s %s: %s" + action-name + (truncate-string-to-width link 50) + (error-message-string err)))))) + (mapc #'elfeed-search-update-entry entries) + (unless (use-region-p) (forward-line)))) + +;; -------------------------- Elfeed Browser Functions ------------------------- + +(defun cj/elfeed-eww-open () + "Opens the links of the currently selected Elfeed entries with EWW. + +Applies cj/eww-readable-nonce hook after EWW rendering." + (interactive) + (cj/elfeed-process-entries + (lambda (link) + (add-hook 'eww-after-render-hook #'cj/eww-readable-nonce) + (eww-browse-url link)) + "open in EWW" + t)) ; skip error handling since eww handles its own errors + +(defun cj/eww-readable-nonce () + "Once-off call to eww-readable after EWW is done rendering." + (unwind-protect + (progn + (eww-readable) + (goto-char (point-min))) + (remove-hook 'eww-after-render-hook #'cj/eww-readable-nonce))) + +(defun cj/elfeed-browser-open () + "Opens the link of the selected Elfeed entries in the default browser." + (interactive) + (cj/elfeed-process-entries + #'browse-url-default-browser + "open in browser" + t)) ; skip error handling since browser handles its own errors + +;; --------------------- Elfeed Play And Download Functions -------------------- + +(defun cj/elfeed-youtube-dl () + "Downloads the selected Elfeed entries' links with youtube-dl." + (interactive) + (cj/elfeed-process-entries #'cj/yt-dl-it "download")) + +(defun cj/play-with-video-player () + "Plays the selected Elfeed entries' links with the configured media player. + +Note: Function name kept for backwards compatibility." + (interactive) + (cj/elfeed-process-entries #'cj/media-play-it + (format "play with %s" + (plist-get (alist-get cj/default-media-player cj/media-players) :name)))) + +;; --------------------- Youtube Url To Elfeed Feed Format --------------------- + +(defun cj/youtube-to-elfeed-feed-format (url type) + "Convert YouTube URL to elfeed-feeds format. + +TYPE should be either \='channel or \='playlist." + (let ((id nil) + (title nil) + (buffer nil) + (id-pattern (if (eq type 'channel) + "href=\"https://www\\.youtube\\.com/feeds/videos\\.xml\\?channel_id=\\([^\"]+\\)\"" + "/playlist\\?list=\\([^&]+\\)")) + (feed-format (if (eq type 'channel) + "https://www.youtube.com/feeds/videos.xml?channel_id=%s" + "https://www.youtube.com/feeds/videos.xml?playlist_id=%s")) + (error-msg (if (eq type 'channel) + "Could not extract channel information" + "Could not extract playlist information"))) + + ;; Extract ID based on type + (if (eq type 'channel) + ;; For channels, we need to fetch the page to get the channel_id + (progn + (setq buffer (url-retrieve-synchronously url)) + (when buffer + (with-current-buffer buffer + ;; Decode the content as UTF-8 + (set-buffer-multibyte t) + (decode-coding-region (point-min) (point-max) 'utf-8) + (goto-char (point-min)) + ;; Search for the channel_id in the RSS feed link + (when (re-search-forward id-pattern nil t) + (setq id (match-string 1)))))) + ;; For playlists, extract from URL first + (when (string-match id-pattern url) + (setq id (match-string 1 url)) + (setq buffer (url-retrieve-synchronously url)))) + + ;; Get title from the page + (when (and buffer id) + (with-current-buffer buffer + (unless (eq type 'channel) + ;; Decode for playlist (already done for channel above) + (set-buffer-multibyte t) + (decode-coding-region (point-min) (point-max) 'utf-8)) + ;; Search for the title in og:title meta tag + (goto-char (point-min)) + (when (re-search-forward "" title)) + (setq title (replace-regexp-in-string """ "\"" title)) + (setq title (replace-regexp-in-string "'" "'" title)) + (setq title (replace-regexp-in-string "'" "'" title)))) + (kill-buffer buffer)) + + (if (and id title) + (format ";; %s\n(\"%s\" yt)" + title + (format feed-format id)) + (error error-msg)))) + +(defun cj/youtube-channel-to-elfeed-feed-format (url) + "Convert YouTube channel URL to elfeed-feeds format and insert at point." + (interactive "sYouTube Channel URL: ") + (let ((result (cj/youtube-to-elfeed-feed-format url 'channel))) + (when (called-interactively-p 'interactive) + (insert result)) + result)) + +(defun cj/youtube-playlist-to-elfeed-feed-format (url) + "Convert YouTube playlist URL to elfeed-feeds format and insert at point." + (interactive "sYouTube Playlist URL: ") + (let ((result (cj/youtube-to-elfeed-feed-format url 'playlist))) + (when (called-interactively-p 'interactive) + (insert result)) + result)) + +(provide 'elfeed-config) +;;; elfeed-config.el ends here. diff --git a/modules/eradio-config.el b/modules/eradio-config.el new file mode 100644 index 00000000..63085aa8 --- /dev/null +++ b/modules/eradio-config.el @@ -0,0 +1,36 @@ +;;; eradio-config --- Simple Internet Radio Setup -*- lexical-binding: t; coding: utf-8; -*- +;; author Craig Jennings + +;;; Commentary: + +;;; Code: + +(use-package eradio + :bind + ("C-c r p" . eradio-play) + ("C-c r s" . eradio-stop) + ("C-c r " . eradio-toggle) + :config + (setq eradio-player '("mpv" "--no-video" "--no-terminal")) + (setq eradio-channels + '(("BAGeL Radio (alternative)" . "https://ais-sa3.cdnstream1.com/2606_128.mp3") + ("Blues Music Fan Radio (blues)" . "http://ais-sa2.cdnstream1.com/1992_128.mp3") + ("Blues Radio (blues)" . "http://cast3.radiohost.ovh:8352/") + ("Concertzender Baroque (classical)" . "http://streams.greenhost.nl:8080/barok") + ("Groove Salad (somafm)" . "https://somafm.com/groovesalad130.pls") + ("Indie Pop Rocks (somafm)" . "https://somafm.com/indiepop130.pls") + ("KDFC Classical (classical)" . "http://128.mp3.pls.kdfc.live/") + ("Radio Caprice Classical Lute (classical)" . "http://79.120.12.130:8000/lute") + ("Radio Swiss Classic German (classical)" . "http://stream.srg-ssr.ch/m/rsc_de/mp3_128") + ("Radio Caprice Acoustic Blues (blues)" . "http://79.111.14.76:8000/acousticblues") + ("Radio Caprice Delta Blues (blues)" . "http://79.120.77.11:8002/deltablues") + ("Seven Inch Soul (somafm)" . "https://somafm.com/nossl/7soul.pls") + ("Space Station Soma (somafm)" . "https://somafm.com/spacestation.pls") + ("Suburbs of Goa (somafm)" . "https://somafm.com/suburbsofgoa.pls") + ("Sunday Baroque (classical)" . "http://wshu.streamguys.org/wshu-baroque") + ("Underground 80s (somafm)" . "https://somafm.com/u80s256.pls") + ("Venice Classic Radio (classical)" . "https://www.veniceclassicradio.eu/live1/128.m3u") + ("WWOZ New Orleans (jazz/blues)" . "https://www.wwoz.org/listen/hi")))) + +(provide 'eradio-config) +;;; eradio-config.el ends here diff --git a/modules/erc-config.el b/modules/erc-config.el new file mode 100644 index 00000000..03c89aca --- /dev/null +++ b/modules/erc-config.el @@ -0,0 +1,317 @@ +;;; erc-config --- Preferences for Emacs Relay Chat (IRC Client) -*- lexical-binding: t; coding: utf-8; -*- +;; author Craig Jennings + +;;; Commentary: + +;; Enhanced ERC configuration with multi-server support. +;; +;; Main keybindings: +;; - C-c e C : Select and connect to a specific server +;; - C-c e c : Join a channel on current server +;; - C-c e b : Switch between ERC buffers across all servers +;; - C-c C-q : Quit current channel +;; - C-c C-Q : Quit ERC altogether + +;;; Code: + +;; Keymap for ERC commands +(defvar cj/erc-command-map + (let ((map (make-sparse-keymap))) + (define-key map "C" 'cj/erc-connect-server-with-completion) ;; Connect to server (capital C) + (define-key map "c" 'cj/erc-join-channel-with-completion) ;; join channel (lowercase c) + (define-key map "b" 'cj/erc-switch-to-buffer-with-completion) ;; switch Buffer + (define-key map "l" 'cj/erc-connected-servers) ;; print connected servers in echo area + (define-key map "q" 'erc-part-from-channel) ;; quit channel + (define-key map "Q" 'erc-quit-server) ;; Quit ERC entirely + map) + "Keymap for ERC-related commands.") + +(global-set-key (kbd "C-c e") cj/erc-command-map) + +;; ------------------------------------ ERC ------------------------------------ +;; Server definitions and connection settings + +(defvar cj/erc-server-alist + '(("Libera.Chat" + :host "irc.libera.chat" + :port 6697 + :tls t + :channels ("#erc" "#emacs" "#emacs-social" "#systemcrafters")) + + ("IRCnet" + :host "open.ircnet.net" + :port 6697 + :tls t + :channels ("#english")) + + ("Snoonet" + :host "irc.snoonet.org" + :port 6697 + :tls t + :channels ("#talk")) + + ("IRCNow" + :host "irc.ircnow.org" + :port 6697 + :tls t + :channels ("#general" "#lounge"))) + "Alist of IRC servers and their connection details.") + +(defun cj/erc-connect-server (server-name) + "Connect to a server specified by SERVER-NAME from =cj/erc-server-alist=." + (let* ((server-info (assoc server-name cj/erc-server-alist)) + (host (plist-get (cdr server-info) :host)) + (port (plist-get (cdr server-info) :port)) + (tls (plist-get (cdr server-info) :tls))) + (if tls + (erc-tls :server host + :port port + :nick "craigjennings" + :full-name user-whole-name) + (erc :server host + :port port + :nick "craigjennings" + :full-name user-whole-name)))) + +(defun cj/erc-connect-server-with-completion () + "Connect to a server using completion for server selection." + (interactive) + (let ((server-name (completing-read "Connect to IRC server: " + (mapcar #'car cj/erc-server-alist)))) + (cj/erc-connect-server server-name))) + +(defun cj/erc-connected-servers () + "Return a list of currently connected servers and display them in echo area." + (interactive) + (let ((server-buffers '())) + (dolist (buf (erc-buffer-list)) + (with-current-buffer buf + (when (eq (buffer-local-value 'erc-server-process buf) erc-server-process) + (unless (member (buffer-name) server-buffers) + (push (buffer-name) server-buffers))))) + + ;; Display the server list when called interactively + (when (called-interactively-p 'any) + (if server-buffers + (message "Connected ERC servers: %s" + (mapconcat 'identity server-buffers ", ")) + (message "No active ERC server connections"))) + + server-buffers)) + +(defun cj/erc-switch-to-buffer-with-completion () + "Switch to an ERC buffer using completion." + (interactive) + (let* ((erc-buffers (mapcar 'buffer-name (erc-buffer-list))) + (selected (completing-read "Switch to buffer: " erc-buffers))) + (switch-to-buffer selected))) + +(defun cj/erc-server-buffer-active-p () + "Return t if the current buffer is an active ERC server buffer." + (and (derived-mode-p 'erc-mode) + (erc-server-process-alive) + (erc-server-buffer-p))) + +(defun cj/erc-join-channel-with-completion () + "Join a channel on the current server. + +If not in an active ERC server buffer, reconnect first." + (interactive) + (unless (cj/erc-server-buffer-active-p) + (if (erc-buffer-list) + ;; We have ERC buffers, but current one isn't active + (let ((server-buffers (cl-remove-if-not + (lambda (buf) + (with-current-buffer buf + (and (erc-server-buffer-p) + (erc-server-process-alive)))) + (erc-buffer-list)))) + (if server-buffers + ;; Found active server buffer, switch to it + (switch-to-buffer (car server-buffers)) + ;; No active server buffer, reconnect + (message "No active ERC connection. Reconnecting...") + (call-interactively 'cj/erc-connect-server-with-completion))) + ;; No ERC buffers at all, connect to a server + (message "No active ERC connection. Connecting to server first...") + (call-interactively 'cj/erc-connect-server-with-completion))) + + ;; At this point we should have an active connection + (if (cj/erc-server-buffer-active-p) + (let ((channel (read-string "Join channel: "))) + (when (string-prefix-p "#" channel) + (erc-join-channel channel))) + (message "Failed to establish an active ERC connection"))) + + +;; Main ERC configuration +(use-package erc + :defer 1 + :ensure nil ;; built-in + :commands (erc erc-tls) + :hook + (erc-mode . emojify-mode) + :custom + (erc-modules + '(autojoin + button + completion + fill + irccontrols + list + log + match + move-to-prompt + noncommands + notifications + readonly + services + stamp + track)) ;; Added track module + + (erc-autojoin-channels-alist + (mapcar (lambda (server) + (cons (car server) + (plist-get (cdr server) :channels))) + cj/erc-server-alist)) + + (erc-nick "craigjennings") + (erc-user-full-name user-whole-name) + (erc-use-auth-source-for-nickserv-password t) + (erc-kill-buffer-on-part t) + (erc-kill-queries-on-quit t) + (erc-kill-server-buffer-on-quit t) + (erc-fill-column 120) + (erc-fill-function 'erc-fill-static) + (erc-fill-static-center 20) + + :config + + + ;; use all text mode abbrevs in ercmode + (abbrev-table-put erc-mode-abbrev-table :parents (list text-mode-abbrev-table)) + + ;; create log directory if it doesn't exist + (setq erc-log-channels-directory (concat user-emacs-directory "erc/logs/")) + (if (not (file-exists-p erc-log-channels-directory)) + (mkdir erc-log-channels-directory t)) + + ;; Configure buffer naming to include server name + (setq erc-rename-buffers t) + (setq erc-unique-buffers t) + + ;; Custom buffer naming function + (defun cj/erc-generate-buffer-name (parms) + "Generate buffer name in the format SERVER-CHANNEL." + (let ((network (plist-get parms :server)) + (target (plist-get parms :target))) + (if target + (concat (or network "") "-" (or target "")) + (or network "")))) + + (setq erc-generate-buffer-name-function 'cj/erc-generate-buffer-name) + + ;; Configure erc-track (show channel activity in modeline) + (setq erc-track-exclude-types '("JOIN" "NICK" "PART" "QUIT" "MODE" + "324" "329" "332" "333" "353" "477") + erc-track-exclude-server-buffer t + erc-track-visibility 'selected-visible + erc-track-switch-direction 'importance + erc-track-showcount t)) + +;; -------------------------------- ERC Track --------------------------------- +;; Better tracking of activity across channels (already included in modules above) + +(use-package erc-track + :ensure nil ;; built-in + :after erc + :custom + (erc-track-position-in-mode-line 'before-modes) + (erc-track-shorten-function 'erc-track-shorten-names) + (erc-track-shorten-cutoff 8) + (erc-track-shorten-start 1) + (erc-track-priority-faces-only 'all) + (erc-track-faces-priority-list + '(erc-error-face + erc-current-nick-face + erc-keyword-face + erc-nick-msg-face + erc-direct-msg-face + erc-notice-face + erc-prompt-face))) + +;; ------------------------ ERC Desktop Notifications ------------------------ +;; Implementation for desktop notifications + +(defun cj/erc-notify-on-mention (match-type nick message) + "Display a notification when MATCH-TYPE is 'current-nick. + +NICK is the sender and MESSAGE is the message text." + (when (and (eq match-type 'current-nick) + (not (string= nick (erc-current-nick))) + (display-graphic-p)) + (let ((title (format "ERC: %s mentioned you" nick))) + ;; Use alert.el if available, otherwise fall back to notifications + (if (fboundp 'alert) + (alert message :title title :category 'erc) + (when (fboundp 'notifications-notify) + (notifications-notify + :title title + :body message + :app-name "Emacs ERC" + :sound-name 'message)))))) + +(add-hook 'erc-text-matched-hook 'cj/erc-notify-on-mention) + +;; ------------------------------ ERC Colorize ------------------------------- +;; Better color management with built-in functionality + +(defun cj/erc-colorize-setup () + "Setup ERC colorization for nicknames." + (make-local-variable 'erc-nick-color-alist) + (setq erc-nick-color-alist + (cl-loop for i from 0 to 15 + for color in '("blue" "green" "red" "brown" "purple" + "olive" "dark cyan" "light gray" "dark gray" + "light blue" "light green" "light red" + "light brown" "light purple" "yellow" "white") + collect (cons i color))) + (setq erc-nick-color-function 'erc-get-color-for-nick)) + +(add-hook 'erc-mode-hook 'cj/erc-colorize-setup) + +;; -------------------------------- ERC Image --------------------------------- +;; show inlined images (png/jpg/gif/svg) in erc buffers. + +(use-package erc-image + :defer 1 + :after erc + :config + (setq erc-image-inline-rescale 300) + (add-to-list 'erc-modules 'image) + (erc-update-modules)) + +;; -------------------------------- ERC Hl Nicks ------------------------------- +;; uniquely identify names in ERC + +(use-package erc-hl-nicks + :defer 1 + :after erc + :config + (add-to-list 'erc-modules 'hl-nicks) + (erc-update-modules)) + +;; ------------------------------ ERC Yank To Gist ----------------------------- +;; automatically create a Gist if pasting more than 5 lines +;; this module requires https://github.com/defunkt/gist +;; via ruby: 'gem install gist' via the aur: yay -S gist + +(use-package erc-yank + :defer 1 + :after erc + :bind + (:map erc-mode-map + ("C-y" . erc-yank))) + +(provide 'erc-config) +;;; erc-config.el ends here diff --git a/modules/eshell-vterm-config.el b/modules/eshell-vterm-config.el new file mode 100644 index 00000000..ba0eba9f --- /dev/null +++ b/modules/eshell-vterm-config.el @@ -0,0 +1,229 @@ +;;; eshell-vterm-config --- Settings for the Emacs Shell -*- lexical-binding: t; coding: utf-8; -*- +;; author Craig Jennings + +;;; Commentary: + +;; ESHELL +;; - Eshell is useful as a REPL +;; - Redirect to the kill ring : ls > /dev/kill +;; - Redirect to the clioboard : ls > /dev/clip +;; - Redirect to a buffer : ls > # +;; - Use elisp functions : write your own "detox" command in elisp +;; : then use it in eshell +;; - cd to remote directories : cd /sshx:c@cjennings.net:/home/cjennings +;; : and take all the elisp functionality remotely +;; : including Dired or Magit on a remote server + +;; VTERM +;; At the moment, vterm behaves like a real terminal. For most keys, vterm will +;; just send them to the process that is currently running. So, C-a may be +;; beginning-of-the-line in a shell, or the prefix key in a screen session. + +;; If you enter vterm-copy-mode C-c C-t or , the buffer will become a normal +;; Emacs buffer. You can then use your navigation keys, select rectangles, etc. +;; When you press RET, the region will be copied and you'll be back in a working +;; terminal session. + +;; ANSI-TERM & TERM +;; I haven't yet found a need for term or ansi-term in my workflows, so I leave +;; them with their default configurations. + +;;; Code: + +(require 'system-utils) + +;; ------------------------------ Eshell ----------------------------- +;; the Emacs shell. + +(use-package eshell + :ensure nil ;; built-in + :defer .5 + :config + (setq eshell-banner-message "") + (setq eshell-scroll-to-bottom-on-input 'all) + (setq eshell-error-if-no-glob t) + (setq eshell-hist-ignoredups t) + (setq eshell-save-history-on-exit t) + (setq eshell-prefer-lisp-functions nil) + (setq eshell-destroy-buffer-when-process-dies t) + + (setq eshell-prompt-function + (lambda () + (concat + (propertize (format-time-string "[%d-%m-%y %T]") 'face '(:foreground "gray")) + " " + (propertize (user-login-name) 'face '(:foreground "gray")) + " " + (propertize (system-name) 'face '(:foreground "gray")) + ":" + (propertize (abbreviate-file-name (eshell/pwd)) 'face '(:foreground "gray")) + "\n" + (propertize "%" 'face '(:foreground "white")) + " "))) + + (add-hook + 'eshell-mode-hook + (lambda () + (setq pcomplete-cycle-completions nil))) + (setq eshell-cmpl-cycle-completions nil) + + (add-to-list 'eshell-modules-list 'eshell-tramp) + + (add-hook 'eshell-hist-mode-hook + (lambda () + (define-key eshell-hist-mode-map (kbd "") 'previous-line) + (define-key eshell-hist-mode-map (kbd "") 'next-line))) + + (add-hook 'eshell-mode-hook + (lambda () + (add-to-list 'eshell-visual-commands '("lf" "ranger" "tail" "htop" "gotop" "mc" "ncdu" "top")) + (add-to-list 'eshell-visual-subcommands '("git" "log" "diff" "show")) + (add-to-list 'eshell-visual-options '("git" "--help" "--paginate")) + + ;; aliases + (eshell/alias "clear" "clear 1") ;; leaves prompt at the top of the window + (eshell/alias "e" "find-file $1") + (eshell/alias "em" "find-file $1") + (eshell/alias "emacs" "find-file $1") + (eshell/alias "open" "cj/xdg-open $1") + (eshell/alias "gocj" "cd /sshx:cjennings@cjennings.net:/var/cjennings/") + (eshell/alias "gosb" "cd /sshx:cjennings@wolf.usbx.me:/home/cjennings/") + (eshell/alias "gowolf" "cd /sshx:cjennings@wolf.usbx.me:/home/cjennings/") + (eshell/alias "v" "eshell-exec-visual $*") + (eshell/alias "ff" "find-file-other-window $1") + (eshell/alias "f" "find-using-dired $1") + (eshell/alias "r" "ranger") + (eshell/alias "ll" "ls -laF")))) + +(defun eshell/find-file-other-window (&rest files) + "Open FILE(s) in other window from eshell." + (if (= 1 (length files)) + ;; Single file - just use it directly + (find-file-other-window (car files)) + ;; Multiple files - open each in other window + (dolist (file files) + (find-file-other-window file)))) + +(defun eshell/find-file (&rest files) + "Open FILE(s) from eshell." + (if (= 1 (length files)) + ;; Single file + (find-file (car files)) + ;; Multiple files + (dolist (file files) + (find-file file)))) + +(defun eshell/find-using-dired (file-pattern) + "Find a file FILE-PATTERN' using 'find-name-dired'." + (let ((escaped-pattern (regexp-quote file-pattern))) + (find-name-dired . escaped-pattern))) + +(defun cj/eshell-delete-window-on-exit () + "Close the eshell window when exiting." + (when (not (one-window-p)) + (delete-window))) +(advice-add 'eshell-life-is-too-much :after 'cj/eshell-delete-window-on-exit) + +(use-package eshell-toggle + :after eshell + :custom + (eshell-toggle-size-fraction 3) + (eshell-toggle-run-command nil) + (eshell-toggle-init-function #'eshell-toggle-init-eshell) + :bind + ("" . eshell-toggle)) + +(use-package xterm-color + :defer .5 + :after eshell + :hook + (eshell-before-prompt-hook . (lambda () + (setq xterm-color-preserve-properties t))) + :config + (setenv "TERM" "xterm-256color")) + +(use-package eshell-syntax-highlighting + :after esh-mode + :config + (eshell-syntax-highlighting-global-mode +1)) + +(use-package eshell-up + :after eshell + :config + (defalias 'eshell/up 'eshell-up) + (defalias 'eshell/up-peek 'eshell-up-peek)) + +;; Enhance history searching +(defun cj/eshell-history-search () + "Search eshell history with completion." + (interactive) + (insert + (completing-read "Eshell history: " + (delete-dups + (ring-elements eshell-history-ring))))) + +(add-hook 'eshell-mode-hook + (lambda () + (define-key eshell-mode-map (kbd "C-r") 'cj/eshell-history-search))) + +;; Better completion for eshell +(use-package pcmpl-args + :after eshell) + +;; Company mode integration for eshell +(use-package company-shell + :after (eshell company) + :config + (add-to-list 'company-backends 'company-shell) + (add-hook 'eshell-mode-hook + (lambda () + (setq-local company-minimum-prefix-length 2) + (setq-local company-idle-delay 2) + (company-mode 1)))) + + +;; ------------------------------ Vterm ------------------------------ +;; faster and highly dependable, but not extensible + +(use-package vterm + :defer .5 + :commands (vterm vterm-other-window) + :init + (setq vterm-always-compile-module t) + + (defun cj/turn-off-chrome-for-vterm () + (hl-line-mode -1) + (display-line-numbers-mode -1)) + + :hook (vterm-mode . cj/turn-off-chrome-for-vterm) + :bind + (:map vterm-mode-map + ("" . nil) + ("C-y" . vterm-yank) + ("C-p" . vtermf-copy-mode) + ("" . vterm-copy-mode)) + :custom + (vterm-kill-buffer-on-exit t) + (vterm-max-scrollback 100000) + :config + (setq vterm-timer-delay nil)) + +(use-package vterm-toggle + :defer .5 + :bind + ("C-" . vterm-toggle) + :config + (setq vterm-toggle-fullscreen-p nil) + (add-to-list 'display-buffer-alist + '((lambda (buffer-or-name _) + (let ((buffer (get-buffer buffer-or-name))) + (with-current-buffer buffer + (or (equal major-mode 'vterm-mode) + (string-prefix-p vterm-buffer-name (buffer-name buffer)))))) + (display-buffer-reuse-window display-buffer-at-bottom) + (dedicated . t) ;dedicated is supported in Emacs 27+ + (reusable-frames . visible) + (window-height . 0.25)))) + +(provide 'eshell-vterm-config) +;;; eshell-vterm-config.el ends here. diff --git a/modules/eww-config.el b/modules/eww-config.el new file mode 100644 index 00000000..7d990f3a --- /dev/null +++ b/modules/eww-config.el @@ -0,0 +1,153 @@ +;;; eww-config --- EWW Text Browser Settings -*- lexical-binding: t; coding: utf-8; -*- +;; author Craig Jennings +;; +;;; Commentary: +;; +;; This module provides a minimal, privacy-focused browsing experience with: +;; - Simplified navigation keybindings (< and > for back/forward) +;; - Quick URL copying to clipboard +;; - Image toggle functionality +;; - Privacy-conscious defaults (no tracking info sent) +;; - Alternative search engine (Frog Find for simplified web pages) +;; +;; Key features: +;; - `M-E' to launch EWW +;; - `u' to copy current URL +;; - `i' to toggle images +;; - `o' to open link in new buffer +;; +;; The configuration tries to prioritize text-based browsing and minimal distractions. +;; +;;; Code: + +;; ----------------------- EWW-Only User-Agent Injection ----------------------- + +(require 'cl-lib) + +(defgroup my-eww-user-agent nil + "EWW-only User-Agent management." + :group 'eww) + +(defcustom my-eww-user-agent + "Mozilla/5.0 (Windows NT 10.0; Win64; x64; rv:128.0) Gecko/20100101 Firefox/128.0" + "User-Agent string to send for EWW requests only." + :type 'string + :group 'my-eww-user-agent) + +(defun my-eww--inject-user-agent (orig-fun &rest args) + "Set a User-Agent only when making requests from an EWW buffer." + (if (derived-mode-p 'eww-mode) + (let* ((ua my-eww-user-agent) + ;; Remove any existing UA header, then add ours. + (url-request-extra-headers + (cons (cons "User-Agent" ua) + (cl-remove-if (lambda (h) + (and (consp h) + (stringp (car h)) + (string-equal (car h) "User-Agent"))) + url-request-extra-headers)))) + (apply orig-fun args)) + (apply orig-fun args))) + +(with-eval-after-load 'url + ;; Cover both async and sync fetches used by eww/shr (pages, images, etc.). + (advice-add 'url-retrieve :around #'my-eww--inject-user-agent) + (advice-add 'url-retrieve-synchronously :around #'my-eww--inject-user-agent)) + +;; --------------------------------- EWW Config -------------------------------- + +(use-package eww + :ensure nil ;; built-in + :bind + (("M-E" . eww) + :map eww-mode-map + ("<" . eww-back-url) + (">" . eww-forward-url) + ("i" . eww-toggle-images) + ("u" . cj/eww-copy-url) + ("b" . cj/eww-bookmark-quick-add) + ("B" . eww-list-bookmarks) + ("/" . cj/eww-switch-search-engine) + ("&" . cj/eww-open-in-external) + ("o" . eww-open-in-new-buffer) + ("r" . eww-readable)) + + :config + ;; Define search engines + (defvar cj/eww-search-engines + '(("frog" . "http://frogfind.com/?q=") + ("ddg" . "https://duckduckgo.com/html?q=") + ("searx" . "https://searx.be/search?q=")) + "List of search engines for EWW.") + + (defvar cj/eww-current-search-engine "frog" + "Currently selected search engine.") + + ;; Function definitions + (defun cj/eww-switch-search-engine () + "Switch between different search engines." + (interactive) + (let* ((engine (completing-read "Search engine: " + (mapcar #'car cj/eww-search-engines) + nil t nil nil cj/eww-current-search-engine)) + (url (cdr (assoc engine cj/eww-search-engines)))) + (when url + (setq eww-search-prefix url) + (setq cj/eww-current-search-engine engine) + (message "Search engine set to: %s" engine)))) + + (defun cj/eww-open-in-external () + "Open current URL in external browser." + (interactive) + (unless (derived-mode-p 'eww-mode) + (user-error "Not in EWW buffer")) + (if-let ((url (plist-get eww-data :url))) + (browse-url-xdg-open url) + (user-error "No URL to open"))) + + (defun cj/eww-bookmark-quick-add () + "Quickly bookmark current page with minimal prompting." + (interactive) + (unless (derived-mode-p 'eww-mode) + (user-error "Not in EWW buffer")) + (when-let ((title (plist-get eww-data :title))) + (let ((eww-bookmarks-directory (expand-file-name "eww-bookmarks" user-emacs-directory))) + (unless (file-exists-p eww-bookmarks-directory) + (make-directory eww-bookmarks-directory t)) + (eww-add-bookmark) + (message "Bookmarked: %s" title)))) + + (defun cj/eww-copy-url () + "Copy the current EWW URL to clipboard." + (interactive) + (unless (derived-mode-p 'eww-mode) + (user-error "Not in EWW buffer")) + (if-let ((current-url (plist-get eww-data :url))) + (progn + (kill-new current-url) + (message "URL copied: %s" current-url)) + (message "No URL to copy"))) + + (defun cj/eww-clear-cookies () + "Clear all cookies." + (interactive) + (setq url-cookie-storage nil) + (when (and url-cookie-file (file-exists-p url-cookie-file)) + (delete-file url-cookie-file)) + (message "Cookies cleared")) + + ;; Configuration settings + (setq shr-use-colors nil) + (setq shr-bullet "• ") + (setq eww-search-prefix (cdr (assoc cj/eww-current-search-engine cj/eww-search-engines))) + (setq url-cookie-file (expand-file-name "~/.local/share/cookies.txt")) + ;; sets the user-agent for everything (e.g., package.el) + ;;(setq url-user-agent "Mozilla/5.0 (Windows NT 10.0; Win64; x64; rv:128.0) Gecko/20100101 Firefox/128.0") + (setq url-privacy-level '(email lastloc)) + (setq shr-inhibit-images t) + (setq shr-use-fonts nil) + (setq shr-max-image-proportion 0.2) + (setq eww-retrieve-command nil)) + +(provide 'eww-config) +;;; eww-config.el ends here diff --git a/modules/external-open.el b/modules/external-open.el new file mode 100644 index 00000000..0fe6be64 --- /dev/null +++ b/modules/external-open.el @@ -0,0 +1,129 @@ +;;; external-open.el --- Open Files Using Default OS Handler -*- lexical-binding: t; coding: utf-8; -*- +;; author Craig Jennings +;; +;;; Commentary: +;; +;; This library provides a simple mechanism for opening files with specific +;; extensions using your operating system’s default application rather than +;; visiting them in an Emacs buffer. It offers: +;; +;; • A simple method to run a command on the current buffer's file +;; "C-c x o" bound to cj/open-this-file-with +;; • A customizable list =default-open-extensions= of file‐type suffixes +;; (e.g. “pdf”, “docx”, “png”) that should be handled externally. +;; • A function =default-open-file= (and its helper commands) which will +;; launch the matching file in the OS’s default MIME handler. +;; • Integration with =find-file-hook= so that any file whose extension +;; appears in =default-open-extensions= is automatically opened externally +;; upon visit. +;; • Optional interactive commands for manually invoking an external open on +;; point or on a user-chosen file. +;; +;;; Code: + +(require 'system-utils) ;; for xdg-open and others +(require 'host-environment) ;; environment information functions +(require 'cl-lib) + +(defgroup external-open nil + "Open certain files with the OS default handler." + :group 'files) + +(defcustom default-open-extensions + '( + ;; Video + "\\.3g2\\'" "\\.3gp\\'" "\\.asf\\'" "\\.avi\\'" "\\.divx\\'" "\\.dv\\'" + "\\.f4v\\'" "\\.flv\\'" "\\.m1v\\'" "\\.m2ts\\'" "\\.m2v\\'" "\\.m4v\\'" + "\\.mkv\\'" "\\.mov\\'" "\\.mpe\\'" "\\.mpeg\\'" "\\.mpg\\'" "\\.mp4\\'" + "\\.mts\\'" "\\.ogv\\'" "\\.rm\\'" "\\.rmvb\\'" "\\.ts\\'" "\\.vob\\'" + "\\.webm\\'" "\\.wmv\\'" + + ;; Audio + "\\.aac\\'" "\\.ac3\\'" "\\.aif\\'" "\\.aifc\\'" "\\.aiff\\'" + "\\.alac\\'" "\\.amr\\'" "\\.ape\\'" "\\.caf\\'" + "\\.dff\\'" "\\.dsf\\'" "\\.flac\\'" "\\.m4a\\'" "\\.mka\\'" + "\\.mid\\'" "\\.midi\\'" "\\.mp2\\'" "\\.mp3\\'" "\\.oga\\'" + "\\.ogg\\'" "\\.opus\\'" "\\.ra\\'" "\\.spx\\'" "\\.wav\\'" + "\\.wave\\'" "\\.weba\\'" "\\.wma\\'" + + ;; Microsoft Word + "\\.docx?\\'" "\\.docm\\'" + "\\.dotx?\\'" "\\.dotm\\'" + "\\.rtf\\'" + + ;; Microsoft Excel + "\\.xlsx?\\'" "\\.xlsm\\'" "\\.xlsb\\'" + "\\.xltx?\\'" "\\.xltm\\'" + + ;; Microsoft PowerPoint + "\\.pptx?\\'" "\\.pptm\\'" + "\\.ppsx?\\'" "\\.ppsm\\'" + "\\.potx?\\'" "\\.potm\\'" + + ;; Microsoft OneNote / Visio / Project / Access / Publisher + "\\.one\\'" "\\.onepkg\\'" "\\.onetoc2\\'" + "\\.vsdx?\\'" "\\.vsdm\\'" "\\.vstx?\\'" "\\.vstm\\'" "\\.vssx?\\'" "\\.vssm\\'" + "\\.mpp\\'" "\\.mpt\\'" + "\\.mdb\\'" "\\.accdb\\'" "\\.accde\\'" "\\.accdr\\'" "\\.accdt\\'" + "\\.pub\\'" + + ;; OpenDocument (LibreOffice/OpenOffice) + "\\.odt\\'" "\\.ott\\'" + "\\.ods\\'" "\\.ots\\'" + "\\.odp\\'" "\\.otp\\'" + "\\.odg\\'" "\\.otg\\'" + "\\.odm\\'" "\\.odf\\'" + ;; Flat OpenDocument variants + "\\.fodt\\'" "\\.fods\\'" "\\.fodp\\'" + + ;; Apple iWork + "\\.pages\\'" "\\.numbers\\'" "\\.key\\'" + + ;; Microsoft’s fixed-layout formats + "\\.xps\\'" "\\.oxps\\'" + ) + "Regexps matching file extensions that should be opened externally." + :type '(repeat (regexp :tag "File extension regexp")) + :group 'external-open) + +;; ------------------------------- Open File With ------------------------------ +;; TASK: Add this to buffer custom functions + +(defun cj/open-this-file-with (command) + "Open this buffer's file with COMMAND, detached from Emacs." + (interactive "MOpen with program: ") + (unless buffer-file-name + (user-error "Current buffer is not visiting a file")) + (let ((file (expand-file-name buffer-file-name))) + (cond + ;; Windows: launch via ShellExecute so the child isn't tied to Emacs. + ((env-windows-p) + (w32-shell-execute "open" command (format "\"%s\"" file))) + ;; POSIX: disown with nohup + background. No child remains. + (t + (call-process-shell-command + (format "nohup %s %s >/dev/null 2>&1 &" + command (shell-quote-argument file)) + nil 0))))) + +(global-set-key (kbd "C-c x o") #'cj/open-this-file-with) + +;; -------------------- Open Files With Default File Handler ------------------- + +(defun cj/find-file-auto (orig-fun &rest args) + "If file has an extension in `default-open-extensions', open externally. +Else call ORIG-FUN with ARGS." + (let* ((file (car args)) + (case-fold-search t)) + (if (and (stringp file) + (cl-some (lambda (re) (string-match-p re file)) + default-open-extensions)) + (cj/xdg-open file) + (apply orig-fun args)))) + +;; Make advice idempotent if you reevaluate this form. +(advice-remove 'find-file #'cj/find-file-auto) +(advice-add 'find-file :around #'cj/find-file-auto) + +(provide 'external-open) +;;; external-open.el ends here. diff --git a/modules/flycheck-config.el b/modules/flycheck-config.el new file mode 100644 index 00000000..f14d94ba --- /dev/null +++ b/modules/flycheck-config.el @@ -0,0 +1,99 @@ +;;; flycheck-config --- Syntax/Grammar Check -*- lexical-binding: t; coding: utf-8; -*- +;; author Craig Jennings + +;;; Commentary: + +;; This file configures Flycheck for on-demand syntax and grammar checking. +;; - Flycheck starts automatically only in sh-mode and emacs-lisp-mode + +;; - This binds a custom helper (=cj/flycheck-list-errors=) to “C-; ?” +;; for popping up Flycheck's error list in another window. + +;; - It also customizes Checkdoc to suppress only the “sentence-end-double-space” +;; and “warn-escape” warnings. + +;; - It registers a Proselint checker for prose files +;; (text-mode, markdown-mode, gfm-mode). + +;; Note: I do use proselint quite a bit in emails and org-mode files. However, some +;; org-files can be large and running proselint on them will slow Emacs to a crawl. +;; Therefore, hitting "C-; ?" also runs cj/flycheck-prose-on-demand if in an org buffer. + +;; +;; The cj/flycheck-prose-on-demand function: +;; - Turns on flycheck for the local buffer +;; - ensures proselint is added +;; - triggers an immediate check +;; +;; Since this is called within cj/flycheck-list-errors, flycheck's error list will still +;; display and the focus transferred to that buffer. + +;; OS Dependencies: +;; proselint (in the Arch AUR) + +;;; Code: + +(defun cj/prose-helpers-on () + "Ensure that abbrev, flyspell, and flycheck are all on." + (interactive) + (if (not (abbrev-mode)) + (abbrev-mode)) + ;; (flyspell-on-for-buffer-type) + (if (not (flycheck-mode)) + (flycheck-mode))) + +;; ---------------------------------- Linting ---------------------------------- + +(use-package flycheck + :after custom-functions ;; for keymap binding + :defer t + :commands (flycheck-list-errors + cj/flycheck-list-errors) + :hook ((sh-mode emacs-lisp-mode) . flycheck-mode) + :bind + (:map cj/custom-keymap + ("?" . cj/flycheck-list-errors)) + :custom + ;; Only disable these two Checkdoc warnings; leave all others intact. + (checkdoc-arguments + '(("sentence-end-double-space" nil) + ("warn-escape" nil))) + :config + + ;; use the load-path of the currently running Emacs instance + (setq flycheck-emacs-lisp-load-path 'inherit) + + ;; Define the prose checker (installed separately via OS). + (flycheck-define-checker proselint + "A linter for prose." + :command ("proselint" source-inplace) + :error-patterns + ((warning line-start (file-name) ":" line ":" column ": " + (id (one-or-more (not (any " ")))) + (message) line-end)) + :modes (text-mode markdown-mode gfm-mode org-mode)) + (add-to-list 'flycheck-checkers 'proselint) + + (defun cj/flycheck-list-errors () + "Display flycheck's error list and switch to its buffer. + +Runs flycheck-prose-on-demand if in an org-buffer." + (interactive) + (when (derived-mode-p 'org-mode) + (cj/flycheck-prose-on-demand)) + + (flycheck-list-errors) + (switch-to-buffer-other-window "*Flycheck errors*")) + + (defun cj/flycheck-prose-on-demand () + "Enable Flycheck+Proselint in this buffer, run it, and show errors." + (interactive) + ;; turn on Flycheck locally + (flycheck-mode 1) + ;; ensure proselint is valid for org/text + (flycheck-add-mode 'proselint major-mode) + ;; trigger immediate check + (flycheck-buffer))) + +(provide 'flycheck-config) +;;; flycheck-config.el ends here diff --git a/modules/flyspell-and-abbrev.el b/modules/flyspell-and-abbrev.el new file mode 100644 index 00000000..08b96036 --- /dev/null +++ b/modules/flyspell-and-abbrev.el @@ -0,0 +1,211 @@ +;;; flyspell-and-abbrev.el --- Spell Check Configuration -*- lexical-binding: t; coding: utf-8; -*- +;; author Craig Jennings + +;;; Commentary: + +;; WORKFLOW: +;; C-' is now my main interface for all spell checking. +;; +;; The workflow is that it finds the nearest misspelled word above where the +;; cursor is, allows for saving or correcting, then stops. You may proceed to +;; the next misspelling by selecting C-' again. +;; +;; Use M-o to get to 'other options', like saving to your personal dictionary. +;; +;; Flyspell will automatically run in a mode appropriate for the buffer type +;; - if it's a programming mode, it will only check comments +;; - if in text mode, it will check everything +;; - otherwise it will turn off. +;; This check happens on every mode switch. +;; +;; If you want flyspell on in another mode (say fundamental mode), or you want +;; to turn it off, you can toggle flyspell's state with 'C-c f' +;; +;; The nicest thing is that each spell correction creates an abbrev. This +;; essentially is a shortcut that expands that same misspelling to the correct +;; spelling the next time it's typed. That idea comes courtesy Artur Malabarba, +;; and it's increased my overall typing speed. +;; +;; Original idea here: +;; http://endlessparentheses.com/ispell-and-abbrev-the-perfect-auto-correct.html +;; +;; The code below is my refactoring of Artur Malabarba's code, and using +;; flyspell rather than ispell. +;; +;; NOTES: +;; +;; FYI, the keybinding typically taken for the flyspell-mode-map "C-;" has +;; been deliberately hijacked in custom-functions.el for my personal-keymap. +;; This is the code run there: + +;; (eval-after-load "flyspell" +;; '(define-key flyspell-mode-map (kbd "C-;") nil)) + +;;; Code: + +;; ----------------------------------- Abbrev ---------------------------------- + +(use-package abbrev-mode + :ensure nil + :defer 0.5 + :custom + (abbrev-file-name (concat user-emacs-directory "assets/abbrev_defs")) + :config + (abbrev-mode 1)) + +;; ---------------------------- Ispell And Flyspell ---------------------------- + +(use-package ispell + :defer .5 + :ensure nil ;; built-in + :config + ;; (setopt ispell-alternate-dictionary + ;; (concat user-emacs-directory "assets/english-words.txt")) + (setopt text-mode-ispell-word-completion nil) + (setopt ispell-alternate-dictionary nil) + + (setq ispell-dictionary "american") ; better for aspell + ;; use aspell rather than ispell + (setq ispell-program-name "aspell") + ;; aspell is in /usr/local/ on BSD + (cond ((eq system-type 'berkeley-unix) + (setq ispell-program-name "/usr/local/bin/aspell"))) + + ;; in aspell "-l" means --list, not --lang + (setq ispell-list-command "--list") + (setq ispell-extra-args '("--sug-mode=ultra" "-W" "3" "--lang=en_US")) + (setq ispell-local-dictionary "en_US") + (setq ispell-local-dictionary-alist + '(("en_US" "[[:alpha:]]" "[^[:alpha:]]" "['‘’]" + t ;; Many other characters + ("-d" "en_US") nil utf-8))) + ;; personal directory goes with sync'd files + (setq ispell-personal-dictionary + (concat sync-dir "aspell-personal-dictionary")) + ;; skip code blocks in org mode + (add-to-list 'ispell-skip-region-alist '("^#+BEGIN_SRC" . "^#+END_SRC"))) + +(use-package flyspell + :after (ispell abbrev) + :ensure nil ;; built-in + :config + ;; don't print message for every word when checking + (setq flyspell-issue-message-flag nil)) + +(use-package flyspell-correct + :after flyspell + :defer .5) + +;; ------------------------------ Flyspell Toggle ------------------------------ +;; easy toggling flyspell and also leverage the 'for-buffer-type' functionality. + +;; (defun flyspell-toggle () +;; "Turn Flyspell on if it is off, or off if it is on. + +;; When turning on,it uses `flyspell-on-for-buffer-type' so code-vs-text is +;; handled appropriately." +;; (interactive) +;; (if (symbol-value flyspell-mode) +;; (progn ; flyspell is on, turn it off +;; (message "Flyspell off") +;; (flyspell-mode -1)) +;; ;; else - flyspell is off, turn it on +;; (progn +;; (flyspell-on-for-buffer-type) +;; (message "Flyspell on")))) +;; (define-key global-map (kbd "C-c f") 'flyspell-toggle ) + +;; ------------------------ Flyspell On For Buffer Type ------------------------ +;; check strings and comments in prog mode; check everything in text mode + +;; (defun flyspell-on-for-buffer-type () +;; "Enable Flyspell for the major mode and check the current buffer. + +;; If flyspell is already enabled, do nothing. If the mode is derived from +;; `prog-mode', enable `flyspell-prog-mode' so only strings and comments get +;; checked. If the buffer is text based `flyspell-mode' is enabled to check +;; all text." +;; (interactive) +;; (unless flyspell-mode ; if not already on +;; (cond +;; ((derived-mode-p 'prog-mode) +;; (flyspell-prog-mode) +;; (flyspell-buffer) +;; ((derived-mode-p 'text-mode) +;; (flyspell-mode 1) +;; (flyspell-buffer)))))) + +;; (add-hook 'after-change-major-mode-hook 'flyspell-on-for-buffer-type) +;; (add-hook 'find-file-hook 'flyspell-on-for-buffer-type) + +;; ---------------------------- Flyspell Then Abbrev --------------------------- +;; Spell check the buffer and create abbrevs to avoid future misspellings. + +(setq-default abbrev-mode t) + +(defun cj/find-previous-flyspell-overlay (position) + "Locate the Flyspell overlay immediately previous to a given POSITION." + ;; sort the overlays into position order + (let ((overlay-list (sort (overlays-in (point-min) position) + (lambda (a b) + (> (overlay-start a) (overlay-start b)))))) + ;; search for previous flyspell overlay + (while (and overlay-list + (or (not (flyspell-overlay-p (car overlay-list))) + ;; check if its face has changed + (not (eq (get-char-property + (overlay-start (car overlay-list)) 'face) + 'flyspell-incorrect)))) + (setq overlay-list (cdr overlay-list))) + ;; if no previous overlay exists, return nil + (when overlay-list + ;; otherwise, return the overlay start position + (overlay-start (car overlay-list))))) + + +(defun cj/flyspell-goto-previous-misspelling (position) + "Go to the first misspelled word before the given POSITION. +Return the misspelled word if found or nil if not. Leave the point at the +beginning of the misspelled word. Setting the hook on pre-command ensures that +any started Flyspell corrections complete before running other commands in the +buffer." + (interactive "d") + (add-hook 'pre-command-hook + (function flyspell-auto-correct-previous-hook) t t) + (let* ((overlay-position (cj/find-previous-flyspell-overlay position)) + (misspelled-word (when overlay-position + (goto-char overlay-position) + (thing-at-point 'word)))) + (if misspelled-word + (downcase misspelled-word) + nil))) + +(defun cj/flyspell-then-abbrev (p) + "Call \='flyspell-correct-at-point\=' and create abbrev for future corrections. +The abbrev is created in the local dictionary unless the prefix P +argument is provided, when it's created in the global dictionary." + (interactive "P") + (unless (featurep 'files) + (require 'files)) + (setq save-abbrevs 'silently) + (flyspell-buffer) + (save-excursion + (let (misspelled-word corrected-word) + (while (setq misspelled-word + (cj/flyspell-goto-previous-misspelling (point))) + (call-interactively 'flyspell-correct-at-point) + (setq corrected-word (downcase (or (thing-at-point 'word) ""))) + (when (and misspelled-word corrected-word + (not (string= corrected-word misspelled-word))) + (message "\"%s\" now expands to \"%s\" %sally" + misspelled-word corrected-word (if p "loc" "glob")) + (define-abbrev + (if p local-abbrev-table global-abbrev-table) + misspelled-word corrected-word)) + (goto-char (point-min)))) + (message "Spell check complete."))) + +(define-key global-map (kbd "C-'") 'cj/flyspell-then-abbrev) + +(provide 'flyspell-and-abbrev) +;;; flyspell-and-abbrev.el ends here. diff --git a/modules/font-config.el b/modules/font-config.el new file mode 100644 index 00000000..ac67d6e0 --- /dev/null +++ b/modules/font-config.el @@ -0,0 +1,283 @@ +;;; font-config --- Font Defaults and Related Functionality -*- lexical-binding: t; coding: utf-8; -*- +;; author: Craig Jennings + +;;; Commentary: + +;; This module provides font configuration, including: +;; +;; 1. Font Management: +;; - Dynamic font preset switching via `fontaine' package +;; - Separate configurations for fixed-pitch and variable-pitch fonts +;; - Multiple size presets for different viewing contexts +;; - Per-frame font configuration tracking for daemon mode compatibility +;; +;; 2. Icon Support: +;; - All-the-icons integration with automatic font installation +;; - Nerd fonts support for enhanced icons in terminals and GUI +;; - Platform-specific emoji font configuration (Noto, Apple, Segoe) +;; - Emojify package for emoji rendering and insertion +;; +;; 3. Typography Enhancements: +;; - Programming ligatures via `ligature' package +;; - Mode-specific ligature rules for markdown and programming +;; - Text scaling keybindings for quick size adjustments +;; +;; 4. Utility Functions: +;; - `cj/font-installed-p': Check font availability +;; - `cj/display-available-fonts': Interactive font browser with samples +;; - Frame-aware font application for client/server setups +;; +;; Configuration Notes: +;; - Default font: FiraCode Nerd Font Mono at 110 height +;; - Variable pitch: Merriweather Light for prose-heavy modes +;; - Handles both standalone and daemon mode Emacs instances +;; - Emoji fonts selected based on OS availability +;; +;; Keybindings: +;; - M-F: Select font preset +;; - C-z F: Display available fonts +;; - C-+/C-=: Increase text scale +;; - C--/C-_: Decrease text scale +;; +;; +;;; Code: + +;; ----------------------- Font Family And Size Selection ---------------------- +;; preset your fixed and variable fonts, then apply them to text as a set + +(use-package fontaine + :demand t + :bind + ("M-F" . fontaine-set-preset) + :config + (setq fontaine-presets + '( + (default + :default-family "FiraCode Nerd Font Mono" + :default-weight regular + :default-height 110 + :fixed-pitch-family nil ;; falls back to :default-family + :fixed-pitch-weight nil ;; falls back to :default-weight + :fixed-pitch-height 1.0 + :variable-pitch-family "Merriweather" + :variable-pitch-weight light + :variable-pitch-height 1.0) + (Hack + :default-family "Hack Nerd Font Mono" + :variable-pitch-family "Hack Nerd Font Mono") + (FiraCode-Literata + :default-family "Fira Code Nerd Font" + :variable-pitch-family "Literata") + (Merriweather + :default-family "Merriweather" + :variable-pitch-family "Merriweather") + (24-point-font + :default-height 240) + (20-point-font + :default-height 200) + (16-point-font + :default-height 160) + (14-point-font + :default-height 140) + (13-point-font + :default-height 130) + (12-point-font + :default-height 120) + (11-point-font + :default-height 110) + (10-point-font + :default-height 100) + (t ;; shared fallback properties go here + :default-family "FiraCode Nerd Font Mono" + :default-weight regular + :default-height 110 + :fixed-pitch-family nil ;; falls back to :default-family + :fixed-pitch-weight nil ;; falls back to :default-weight + :fixed-pitch-height 1.0 + :fixed-pitch-serif-family nil ;; falls back to :default-family + :fixed-pitch-serif-weight nil ;; falls back to :default-weight + :fixed-pitch-serif-height 1.0 + :variable-pitch-family "Merriweather" + :variable-pitch-weight light + :variable-pitch-height 1.0 + :bold-family nil ;; use whatever the underlying face has + :bold-weight bold + :italic-family nil + :italic-slant italic + :line-spacing nil)))) + +(with-eval-after-load 'fontaine + ;; Track which frames have had fonts applied + (defvar cj/fontaine-configured-frames nil + "List of frames that have had fontaine configuration applied.") + + (defun cj/apply-font-settings-to-frame (&optional frame) + "Apply font settings to FRAME if not already configured. + +If FRAME is nil, uses the selected frame." + (let ((target-frame (or frame (selected-frame)))) + (unless (member target-frame cj/fontaine-configured-frames) + (with-selected-frame target-frame + (when (display-graphic-p target-frame) + (fontaine-set-preset 'default) + (push target-frame cj/fontaine-configured-frames)))))) + + (defun cj/cleanup-frame-list (frame) + "Remove FRAME from the configured frames list when deleted." + (setq cj/fontaine-configured-frames + (delq frame cj/fontaine-configured-frames))) + + ;; Handle daemon mode and regular mode + (if (daemonp) + (progn + ;; Apply to each new frame in daemon mode + (add-hook 'server-after-make-frame-hook #'cj/apply-font-settings-to-frame) + ;; Clean up deleted frames from tracking list + (add-hook 'delete-frame-functions #'cj/cleanup-frame-list)) + ;; Apply immediately in non-daemon mode + (when (display-graphic-p) + (cj/apply-font-settings-to-frame)))) + +;; ----------------------------- Font Install Check ---------------------------- +;; convenience function to indicate whether a font is available by name. + +;;;###autoload +(defun cj/font-installed-p (font-name) + "Check if font with FONT-NAME is available." + (if (find-font (font-spec :name font-name)) + t + nil)) + +;; ------------------------------- All The Icons ------------------------------- +;; icons made available through fonts + +(use-package all-the-icons + :demand t + :config + ;; Check for font installation after frame creation + (defun cj/maybe-install-all-the-icons-fonts (&optional _frame) + "Install all-the-icons fonts if needed and we have a GUI." + (when (and (display-graphic-p) + (not (cj/font-installed-p "all-the-icons"))) + (all-the-icons-install-fonts t) + ;; Remove this hook after successful installation + (remove-hook 'server-after-make-frame-hook #'cj/maybe-install-all-the-icons-fonts))) + + ;; Handle both daemon and non-daemon modes + (if (daemonp) + (add-hook 'server-after-make-frame-hook #'cj/maybe-install-all-the-icons-fonts) + (cj/maybe-install-all-the-icons-fonts))) + +(use-package all-the-icons-nerd-fonts + :after all-the-icons + :demand t + :config + (all-the-icons-nerd-fonts-prefer)) + +;; ----------------------------- Emoji Fonts Per OS ---------------------------- +;; Set emoji fonts in priority order (first found wins) + +(cond + ;; Prefer Noto Color Emoji (Linux) + ((member "Noto Color Emoji" (font-family-list)) + (set-fontset-font t 'symbol (font-spec :family "Noto Color Emoji") nil 'prepend)) + ;; Then Apple Color Emoji (macOS) + ((member "Apple Color Emoji" (font-family-list)) + (set-fontset-font t 'symbol (font-spec :family "Apple Color Emoji") nil 'prepend)) + ;; Finally Segoe UI Emoji (Windows) + ((member "Segoe UI Emoji" (font-family-list)) + (set-fontset-font t 'symbol (font-spec :family "Segoe UI Emoji") nil 'prepend))) + +;; ---------------------------------- Emojify ---------------------------------- +;; converts emoji identifiers into emojis; allows for easy emoji entry. + +(use-package emojify + :defer 1 + :hook ((erc-mode . emojify-mode) + (org-mode . emojify-mode)) + :custom + (emojify-download-emojis-p t) ;; don't ask, just download emojis + :bind + ("C-c E i" . emojify-insert-emoji) ;; emoji insert + ("C-c E l" . emojify-list-emojis) ;; emoji list + :config + (setq emojify-show-help nil) + (setq emojify-point-entered-behaviour 'uncover) + (setq emojify-display-style 'image) + (setq emojify-emoji-styles '(ascii unicode github)) + + ;; Disable emojify in programming and gptel modes + (defun cj/disable-emojify-mode () + "Disable emojify-mode in the current buffer." + (emojify-mode -1)) + + (add-hook 'prog-mode-hook #'cj/disable-emojify-mode) + (add-hook 'gptel-mode-hook #'cj/disable-emojify-mode)) + +;; -------------------------- Display Available Fonts -------------------------- +;; display all available fonts on the system in a side panel + +;;;###autoload +(defun cj/display-available-fonts () + "Display a list of all font faces with sample text in another read-only buffer." + (interactive) + (pop-to-buffer "*Available Fonts*" + '(display-buffer-in-side-window . ((side . right)(window-width . fit-window-to-buffer)))) + (let ((font-list (font-family-list))) + (setq font-list (cl-remove-duplicates (cl-sort font-list 'string-lessp :key 'downcase))) + (with-current-buffer "*Available Fonts*" + (erase-buffer) + (dolist (font-family font-list) + (insert (propertize (concat font-family) 'face `((:foreground "Light Blue" :weight bold)))) + (insert (concat "\n"(propertize "Regular: "))) + (insert (propertize (concat "The quick brown fox jumps over the lazy dog I 1 l ! : ; . , 0 O o [ { ( ) } ] ?") + 'face `((:family, font-family)))) + (insert (concat "\n" (propertize "Bold: "))) + (insert (propertize (concat "The quick brown fox jumps over the lazy dog I 1 l ! : ; . , 0 O o [ { ( ) } ] ?") + 'face `((:family, font-family :weight bold)))) + (insert (concat "\n" (propertize "Italic: "))) + (insert (propertize (concat "The quick brown fox jumps over the lazy dog I 1 l ! : ; . , 0 O o [ { ( ) } ] ?") + 'face `((:family, font-family :slant italic)))) + (insert (concat "\n\n")))) + (move-to-window-line 0) + (special-mode))) + +(global-set-key (kbd "C-z F") 'cj/display-available-fonts) + +;; ----------------------- Increase / Decrease Font Size ----------------------- +;; make it easy to enlarge or shrink font sizes with keybindings + +(setq text-scale-mode-step 1.08) +(global-set-key (kbd "C-+") 'text-scale-increase) +(global-set-key (kbd "C-=") 'text-scale-increase) +(global-set-key (kbd "C-_") 'text-scale-decrease) +(global-set-key (kbd "C--") 'text-scale-decrease) + +;; --------------------------------- Ligatures --------------------------------- +;; fancy programming glyphs make code easier to read + +(use-package ligature + :defer 1 + :config + ;; Enable the www ligature in every possible major mode + (ligature-set-ligatures 't '("www")) + ;; Enable traditional ligature support in eww, if `variable-pitch' face supports it + (ligature-set-ligatures 'eww-mode '("ff" "fi" "ffi")) + ;; Enable ligatures in markdown mode + (ligature-set-ligatures 'markdown-mode '(("=" (rx (+ "=") (? (| ">" "<")))) + ("-" (rx (+ "-"))))) + ;; Enable ligatures in programming modes + (ligature-set-ligatures 'prog-mode '("www" "**" "***" "**/" "*>" "*/" "\\\\" "\\\\\\" "{-" "::" + ":::" ":=" "!!" "!=" "!==" "-}" "----" "-->" "->" "->>" + "-<" "-<<" "-~" "#{" "#[" "##" "###" "####" "#(" "#?" "#_" + "#_(" ".-" ".=" ".." "..<" "..." "?=" "??" ";;" "/*" "/**" + "/=" "/==" "/>" "//" "///" "&&" "||" "||=" "|=" "|>" "^=" "$>" + "++" "+++" "+>" "=:=" "==" "===" "==>" "=>" "=>>" "<=" + "=<<" "=/=" ">-" ">=" ">=>" ">>" ">>-" ">>=" ">>>" "<*" + "<*>" "<|" "<|>" "<$" "<$>" "