diff options
Diffstat (limited to 'modules')
74 files changed, 6673 insertions, 1882 deletions
diff --git a/modules/ai-config.el b/modules/ai-config.el index 004750b6..3b89faca 100644 --- a/modules/ai-config.el +++ b/modules/ai-config.el @@ -415,5 +415,22 @@ Works for any buffer, whether it's visiting a file or not." "x" #'cj/gptel-clear-buffer) ;; clears the assistant buffer (keymap-set cj/custom-keymap "a" cj/ai-keymap) +(with-eval-after-load 'which-key + (which-key-add-key-based-replacements + "C-; a" "AI assistant menu" + "C-; a B" "switch backend" + "C-; a M" "gptel menu" + "C-; a d" "delete conversation" + "C-; a ." "add buffer" + "C-; a f" "add file" + "C-; a l" "load conversation" + "C-; a m" "change model" + "C-; a p" "change prompt" + "C-; a &" "rewrite region" + "C-; a r" "clear context" + "C-; a s" "save conversation" + "C-; a t" "toggle window" + "C-; a x" "clear buffer")) + (provide 'ai-config) ;;; ai-config.el ends here. diff --git a/modules/ai-conversations.el b/modules/ai-conversations.el index 92549176..4f97d761 100644 --- a/modules/ai-conversations.el +++ b/modules/ai-conversations.el @@ -159,7 +159,6 @@ Expect FILENAME to match _YYYYMMDD-HHMMSS.gptel." (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. @@ -188,7 +187,6 @@ Enable autosave for subsequent AI responses to the same file." (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) @@ -218,7 +216,6 @@ Enable autosave for subsequent AI responses to the same file." (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. diff --git a/modules/archived/org-gcal-config.el b/modules/archived/org-gcal-config.el new file mode 100644 index 00000000..9f43c1c8 --- /dev/null +++ b/modules/archived/org-gcal-config.el @@ -0,0 +1,213 @@ +;;; org-gcal-config.el --- Google Calendar synchronization for Org-mode -*- lexical-binding: t; coding: utf-8; -*- +;; +;; Author: Craig Jennings <c@cjennings.net> +;; +;;; Commentary: +;; +;; Bidirectional synchronization between Google Calendar and Org-mode using org-gcal. +;; - Credential management via authinfo.gpg +;; - Automatic archival of past events +;; - Automatic removal of cancelled events, but with TODOs added for visibility +;; - System timezone configuration via functions in host-environment +;; - No notifications on syncing +;; - Events are managed by Org (changes in org file push back to Google Calendar) +;; This is controlled by org-gcal-managed-newly-fetched-mode and +;; org-gcal-managed-update-existing-mode set to "org" +;; - Automatic sync timer (configurable via cj/org-gcal-sync-interval-minutes) +;; Default: 30 minutes, set to nil to disable +;; See: https://github.com/kidd/org-gcal.el?tab=readme-ov-file#sync-automatically-at-regular-times +;; - Validates existing oath2-auto.plist file or creates it to avoid the issue mentioned here: +;; https://github.com/kidd/org-gcal.el?tab=readme-ov-file#note +;; +;; Prerequisites: +;; 1. Create OAuth 2.0 credentials in Google Cloud Console +;; See: https://github.com/kidd/org-gcal.el?tab=readme-ov-file#installation +;; 2. Store credentials in ~/.authinfo.gpg with this format: +;; machine org-gcal login YOUR_CLIENT_ID password YOUR_CLIENT_SECRET +;; 3. Define `gcal-file' in user-constants (location of org file to hold sync'd events). +;; +;; Usage: +;; - Manual sync: C-; g s (or M-x org-gcal-sync) +;; - Toggle auto-sync on/off: C-; g t +;; - Restart auto-sync (e.g., after changing interval): C-; g r +;; - Clear sync lock (if sync gets stuck): C-; g c +;; +;; Note: +;; This configuration creates oauth2-auto.plist on first run to prevent sync errors. +;; Passphrase caching is enabled. +;; +;;; Code: + +(require 'host-environment) +(require 'user-constants) + +;; Forward declare org-gcal internal variables and functions +(eval-when-compile + (defvar org-gcal--sync-lock)) +(declare-function org-gcal-reload-client-id-secret "org-gcal") + +;; User configurable sync interval +(defvar cj/org-gcal-sync-interval-minutes 30 + "Interval in minutes for automatic Google Calendar sync. +Set to nil to disable automatic syncing. +Changes take effect after calling `cj/org-gcal-restart-auto-sync'.") + +;; Internal timer object +(defvar cj/org-gcal-sync-timer nil + "Timer object for automatic org-gcal sync. +Use `cj/org-gcal-start-auto-sync' and `cj/org-gcal-stop-auto-sync' to control.") + +(defun cj/org-gcal-clear-sync-lock () + "Clear the org-gcal sync lock. +Useful when a sync fails and leaves the lock in place, preventing future syncs." + (interactive) + (setq org-gcal--sync-lock nil) + (message "org-gcal sync lock cleared")) + +(defun cj/org-gcal-convert-all-to-org-managed () + "Convert all org-gcal events in current buffer to Org-managed. + +Changes all events with org-gcal-managed property from `gcal' to `org', +enabling bidirectional sync so changes push back to Google Calendar." + (interactive) + (let ((count 0)) + (save-excursion + (goto-char (point-min)) + (while (re-search-forward "^:org-gcal-managed: gcal$" nil t) + (replace-match ":org-gcal-managed: org") + (setq count (1+ count)))) + (when (> count 0) + (save-buffer)) + (message "Converted %d event(s) to Org-managed" count))) + +(defun cj/org-gcal-start-auto-sync () + "Start automatic Google Calendar sync timer. +Uses the interval specified in `cj/org-gcal-sync-interval-minutes'. +Does nothing if interval is nil or timer is already running." + (interactive) + (when (and cj/org-gcal-sync-interval-minutes + (not (and cj/org-gcal-sync-timer + (memq cj/org-gcal-sync-timer timer-list)))) + (let ((interval-seconds (* cj/org-gcal-sync-interval-minutes 60))) + (setq cj/org-gcal-sync-timer + (run-with-timer + 120 ;; Initial delay: 2 minutes after startup + interval-seconds + (lambda () + (condition-case err + (org-gcal-sync) + (error (message "org-gcal: Auto-sync failed: %s" err)))))) + (message "org-gcal: Auto-sync started (every %d minutes)" + cj/org-gcal-sync-interval-minutes)))) + +(defun cj/org-gcal-stop-auto-sync () + "Stop automatic Google Calendar sync timer." + (interactive) + (when (and cj/org-gcal-sync-timer + (memq cj/org-gcal-sync-timer timer-list)) + (cancel-timer cj/org-gcal-sync-timer) + (setq cj/org-gcal-sync-timer nil) + (message "org-gcal: Auto-sync stopped"))) + +(defun cj/org-gcal-toggle-auto-sync () + "Toggle automatic Google Calendar sync timer on/off." + (interactive) + (if (and cj/org-gcal-sync-timer + (memq cj/org-gcal-sync-timer timer-list)) + (cj/org-gcal-stop-auto-sync) + (cj/org-gcal-start-auto-sync))) + +(defun cj/org-gcal-restart-auto-sync () + "Restart automatic Google Calendar sync timer. +Useful after changing `cj/org-gcal-sync-interval-minutes'." + (interactive) + (cj/org-gcal-stop-auto-sync) + (cj/org-gcal-start-auto-sync)) + +;; Deferred library required by org-gcal +(use-package deferred + :ensure t) + +;; OAuth2 authentication library required by org-gcal +(use-package oauth2-auto + :ensure t) + +(use-package org-gcal + :vc (:url "https://github.com/cjennings/org-gcal" :rev :newest) + :defer t ;; unless idle timer is set below + + :init + ;; Configure org-gcal settings (no authinfo.gpg decryption here - deferred to :config) + ;; identify calendar to sync and it's destination + (setq org-gcal-fetch-file-alist `(("craigmartinjennings@gmail.com" . ,gcal-file))) + + (setq org-gcal-up-days 30) ;; Look 30 days back + (setq org-gcal-down-days 60) ;; Look 60 days forward + (setq org-gcal-auto-archive t) ;; auto-archive old events + (setq org-gcal-notify-p nil) ;; nil disables; t enables notifications + (setq org-gcal-remove-api-cancelled-events t) ;; auto-remove cancelled events + (setq org-gcal-update-cancelled-events-with-todo t) ;; todo cancelled events for visibility + + ;; Google Calendar is authoritative - avoids sync conflicts + (setq org-gcal-managed-newly-fetched-mode "gcal") ;; New events from GCal stay GCal-managed + (setq org-gcal-managed-update-existing-mode "gcal") ;; GCal wins on conflicts + + :config + ;; Retrieve credentials from authinfo.gpg when org-gcal is first loaded + ;; This happens on first use (e.g., C-; g s), not during daemon startup + (require 'auth-source) + (let ((credentials (car (auth-source-search :host "org-gcal" :require '(:user :secret))))) + (when credentials + (setq org-gcal-client-id (plist-get credentials :user)) + ;; The secret might be a function, so we need to handle that + (let ((secret (plist-get credentials :secret))) + (setq org-gcal-client-secret + (if (functionp secret) + (funcall secret) + secret))))) + ;; Plstore caching is now configured globally in auth-config.el + ;; to ensure it loads before org-gcal needs it + + ;; set org-gcal timezone based on system timezone + (setq org-gcal-local-timezone (cj/detect-system-timezone)) + + ;; Reload client credentials (should already be loaded by org-gcal, but ensure it's set) + (org-gcal-reload-client-id-secret) + + ;; Auto-save gcal files after sync completes + (defun cj/org-gcal-save-files-after-sync (&rest _) + "Save all org-gcal files after sync completes." + (dolist (entry org-gcal-fetch-file-alist) + (let* ((file (cdr entry)) + (buffer (get-file-buffer file))) + (when (and buffer (buffer-modified-p buffer)) + (with-current-buffer buffer + (save-buffer) + (message "Saved %s after org-gcal sync" (file-name-nondirectory file))))))) + + ;; Advise org-gcal--sync-unlock which is called when sync completes + (advice-add 'org-gcal--sync-unlock :after #'cj/org-gcal-save-files-after-sync)) + +;; Start automatic sync timer based on user configuration +;; Set cj/org-gcal-sync-interval-minutes to nil to disable +;; (cj/org-gcal-start-auto-sync) + +;; Google Calendar keymap and keybindings +(defvar-keymap cj/gcal-map + :doc "Keymap for Google Calendar operations" + "s" #'org-gcal-sync + "t" #'cj/org-gcal-toggle-auto-sync + "r" #'cj/org-gcal-restart-auto-sync + "c" #'cj/org-gcal-clear-sync-lock) +(keymap-set cj/custom-keymap "g" cj/gcal-map) + +(with-eval-after-load 'which-key + (which-key-add-key-based-replacements + "C-; g" "gcal menu" + "C-; g s" "sync" + "C-; g t" "toggle auto-sync" + "C-; g r" "restart auto-sync" + "C-; g c" "clear sync lock")) + +(provide 'org-gcal-config) +;;; org-gcal-config.el ends here diff --git a/modules/auth-config.el b/modules/auth-config.el index 6b8a8ddb..83a7e2d0 100644 --- a/modules/auth-config.el +++ b/modules/auth-config.el @@ -7,14 +7,23 @@ ;; • auth-source ;; – Forces use of your default authinfo file -;; – Disable external GPG agent in favor of Emacs’s own prompt +;; – 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 +;; – Force using the 'gpg2' executable for encryption/decryption operations + +;; • oauth2-auto cache fix (via advice) +;; – oauth2-auto version 20250624.1919 has caching bug on line 206 +;; – Function oauth2-auto--plstore-read has `or nil` disabling cache +;; – This caused GPG passphrase prompts every ~15 minutes during gcal-sync +;; – Fix: Advice to enable hash-table cache without modifying package +;; – Works across package updates +;; – Fixed 2025-11-11 ;;; Code: +(require 'system-lib) (eval-when-compile (require 'user-constants)) ;; defines authinfo-file location ;; -------------------------------- Auth Sources ------------------------------- @@ -24,9 +33,11 @@ :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 + ;; USE gpg-agent for passphrase caching (400-day cache from gpg-agent.conf) + ;; (setenv "GPG_AGENT_INFO" nil) ;; DISABLED: was preventing gpg-agent cache + (setq auth-sources `(,authinfo-file)) ;; use authinfo.gpg (see user-constants.el) + (setq auth-source-debug t) ;; echo debug info to Messages + (setq auth-source-cache-expiry 86400)) ;; cache decrypted credentials for 24 hours ;; ----------------------------- Easy PG Assistant ----------------------------- ;; Key management, cryptographic operations on regions and files, dired @@ -38,7 +49,131 @@ :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) + (setq epg-gpg-program "gpg2") ;; force use gpg2 (not gpg v.1) + + ;; Update gpg-agent with current DISPLAY environment + ;; This ensures pinentry can open GUI windows when Emacs starts + (call-process "gpg-connect-agent" nil nil nil "updatestartuptty" "/bye")) + +;; ---------------------------------- Plstore ---------------------------------- +;; Encrypted storage used by oauth2-auto for Google Calendar tokens. +;; CRITICAL: Enable passphrase caching to prevent password prompts every 10 min. + +(use-package plstore + :ensure nil ;; built-in + :demand t + :config + ;; Cache passphrase indefinitely (relies on gpg-agent for actual caching) + (setq plstore-cache-passphrase-for-symmetric-encryption t) + ;; Allow gpg-agent to cache the passphrase (400 days per gpg-agent.conf) + (setq plstore-encrypt-to nil)) ;; Use symmetric encryption, not key-based + +;; ----------------------------- oauth2-auto Cache Fix ----------------------------- +;; Fix oauth2-auto caching bug that causes repeated GPG passphrase prompts. +;; The package has `or nil` on line 206 that disables its internal cache. +;; This advice overrides the buggy function to enable caching properly. + +(defun cj/oauth2-auto--plstore-read-fixed (username provider) + "Fixed version of oauth2-auto--plstore-read that enables caching. + +This is a workaround for oauth2-auto.el bug where line 206 has: + (or nil ;(gethash id oauth2-auto--plstore-cache) +which completely disables the internal hash-table cache. + +This function re-implements the intended behavior with cache enabled." + (require 'oauth2-auto) ; Ensure package is loaded + (let ((id (oauth2-auto--compute-id username provider))) + ;; Check cache FIRST (this is what the original should do) + (or (gethash id oauth2-auto--plstore-cache) + ;; Cache miss - read from plstore and cache the result + (let ((plstore (plstore-open oauth2-auto-plstore))) + (unwind-protect + (puthash id + (cdr (plstore-get plstore id)) + oauth2-auto--plstore-cache) + (plstore-close plstore)))))) + +;; Apply the fix via advice (survives package updates) +(with-eval-after-load 'oauth2-auto + (advice-add 'oauth2-auto--plstore-read :override #'cj/oauth2-auto--plstore-read-fixed) + (cj/log-silently "✓ oauth2-auto cache fix applied via advice")) + +;; ------------------------ Authentication Reset Utility ----------------------- + +(defun cj/reset-auth-cache (&optional include-gpg-agent) + "Reset authentication caches when wrong password was entered. + +By default, only clears Emacs-side caches (auth-source, EPA file +handler) and leaves gpg-agent's long-term cache intact. This preserves +your 400-day cache for GPG and SSH passphrases. + +With prefix argument INCLUDE-GPG-AGENT (\\[universal-argument]), also +clears gpg-agent's password cache. Use this when gpg-agent itself has +cached an incorrect password. + +Clears: +1. auth-source cache (Emacs-level credential cache) +2. EPA file handler cache (encrypted file cache) +3. gpg-agent cache (only if INCLUDE-GPG-AGENT is non-nil) + +Use this when you see errors like: + - \"Bad session key\" + - \"Decryption failed\" + - GPG repeatedly using wrong cached password" + (interactive "P") + (message "Resetting authentication caches...") + + ;; Clear auth-source cache (Emacs credential cache) + (auth-source-forget-all-cached) + + ;; Clear EPA file handler cache + (when (fboundp 'epa-file-clear-cache) + (epa-file-clear-cache)) + + ;; Only clear gpg-agent cache if explicitly requested + (if include-gpg-agent + (let ((result (shell-command "echo RELOADAGENT | gpg-connect-agent"))) + (if (zerop result) + (message "✓ Emacs and gpg-agent caches cleared. Next access will prompt for password.") + (message "⚠ Warning: Failed to clear gpg-agent cache"))) + (message "✓ Emacs caches cleared. GPG/SSH passphrases preserved for session."))) + +(defun cj/kill-gpg-agent () + "Force kill gpg-agent (it will restart automatically on next use). + +This is a more aggressive reset than `cj/reset-auth-cache'. Use this +when gpg-agent is stuck or behaving incorrectly. + +The gpg-agent will automatically restart on the next GPG operation." + (interactive) + (let ((result (shell-command "gpgconf --kill gpg-agent"))) + (if (zerop result) + (message "✓ gpg-agent killed. It will restart automatically on next use.") + (message "⚠ Warning: Failed to kill gpg-agent")))) + +(defun cj/clear-oauth2-auto-cache () + "Clear the oauth2-auto in-memory token cache. + +This forces oauth2-auto to re-read tokens from oauth2-auto.plist on next +access. Useful when OAuth tokens have been manually updated or after +re-authentication. + +Note: This only clears Emacs's in-memory cache. The oauth2-auto.plist +file on disk is not modified." + (interactive) + (if (boundp 'oauth2-auto--plstore-cache) + (progn + (clrhash oauth2-auto--plstore-cache) + (message "✓ oauth2-auto token cache cleared")) + (message "⚠ oauth2-auto not loaded yet"))) + +;; Keybindings +(with-eval-after-load 'keybindings + (keymap-set cj/custom-keymap "A" #'cj/reset-auth-cache)) + +(with-eval-after-load 'which-key + (which-key-add-key-based-replacements + "C-; A" "reset auth cache")) (provide 'auth-config) ;;; auth-config.el ends here. diff --git a/modules/browser-config.el b/modules/browser-config.el index fddc02e6..52c3b8a6 100644 --- a/modules/browser-config.el +++ b/modules/browser-config.el @@ -80,19 +80,44 @@ Returns the browser plist if found, nil otherwise." cj/saved-browser-choice)) (error nil)))) -(defun cj/apply-browser-choice (browser-plist) - "Apply the browser settings from BROWSER-PLIST." - (when browser-plist +(defun cj/--do-apply-browser-choice (browser-plist) + "Apply the browser settings from BROWSER-PLIST. +Returns: \\='success if applied successfully, + \\='invalid-plist if browser-plist is nil or missing required keys." + (if (null browser-plist) + 'invalid-plist (let ((browse-fn (plist-get browser-plist :function)) (executable (plist-get browser-plist :executable)) (path (plist-get browser-plist :path)) (program-var (plist-get browser-plist :program-var))) - ;; Set the main browse-url function - (setq browse-url-browser-function browse-fn) - ;; Set the specific browser program variable if it exists - (when program-var - (set program-var (or path executable))) - (message "Default browser set to: %s" (plist-get browser-plist :name))))) + (if (null browse-fn) + 'invalid-plist + ;; Set the main browse-url function + (setq browse-url-browser-function browse-fn) + ;; Set the specific browser program variable if it exists + (when program-var + (set program-var (or path executable))) + 'success)))) + +(defun cj/apply-browser-choice (browser-plist) + "Apply the browser settings from BROWSER-PLIST." + (pcase (cj/--do-apply-browser-choice browser-plist) + ('success (message "Default browser set to: %s" (plist-get browser-plist :name))) + ('invalid-plist (message "Invalid browser configuration")))) + +(defun cj/--do-choose-browser (browser-plist) + "Save and apply BROWSER-PLIST as the default browser. +Returns: \\='success if browser was saved and applied, + \\='save-failed if save operation failed, + \\='invalid-plist if browser-plist is invalid." + (condition-case _err + (progn + (cj/save-browser-choice browser-plist) + (let ((result (cj/--do-apply-browser-choice browser-plist))) + (if (eq result 'success) + 'success + 'invalid-plist))) + (error 'save-failed))) (defun cj/choose-browser () "Interactively choose a browser from available options. @@ -107,21 +132,39 @@ Persists the choice for future sessions." (string= (plist-get b :name) choice)) browsers))) (when selected - (cj/save-browser-choice selected) - (cj/apply-browser-choice selected)))))) + (pcase (cj/--do-choose-browser selected) + ('success (message "Default browser set to: %s" (plist-get selected :name))) + ('save-failed (message "Failed to save browser choice")) + ('invalid-plist (message "Invalid browser configuration")))))))) ;; Initialize: Load saved choice or use first available browser -(defun cj/initialize-browser () - "Initialize browser configuration on startup." +(defun cj/--do-initialize-browser () + "Initialize browser configuration. +Returns: (cons \\='loaded browser-plist) if saved choice was loaded, + (cons \\='first-available browser-plist) if using first discovered browser, + (cons \\='no-browsers nil) if no browsers found." (let ((saved-choice (cj/load-browser-choice))) (if saved-choice - (cj/apply-browser-choice saved-choice) - ;; No saved choice - try to set first available browser silently + (cons 'loaded saved-choice) + ;; No saved choice - try to set first available browser (let ((browsers (cj/discover-browsers))) - (when browsers - (cj/apply-browser-choice (car browsers)) - (message "No browser configured. Using %s. Run M-x cj/choose-browser to change." - (plist-get (car browsers) :name))))))) + (if browsers + (cons 'first-available (car browsers)) + (cons 'no-browsers nil)))))) + +(defun cj/initialize-browser () + "Initialize browser configuration on startup." + (let ((result (cj/--do-initialize-browser))) + (pcase (car result) + ('loaded + (cj/--do-apply-browser-choice (cdr result))) + ('first-available + (let ((browser (cdr result))) + (cj/--do-apply-browser-choice browser) + (message "No browser configured. Using %s. Run M-x cj/choose-browser to change." + (plist-get browser :name)))) + ('no-browsers + (message "No supported browsers found"))))) ;; Run initialization (cj/initialize-browser) diff --git a/modules/calendar-sync.el b/modules/calendar-sync.el new file mode 100644 index 00000000..8f71c709 --- /dev/null +++ b/modules/calendar-sync.el @@ -0,0 +1,921 @@ +;;; calendar-sync.el --- Multi-calendar sync via .ics -*- lexical-binding: t; -*- + +;; Author: Craig Jennings <c@cjennings.net> +;; Created: 2025-11-16 + +;;; Commentary: + +;; Simple, reliable one-way sync from multiple calendars to Org mode. +;; Downloads .ics files from calendar URLs (Google, Proton, etc.) and +;; converts to Org format. No OAuth, no API complexity, just file conversion. +;; +;; Features: +;; - Multi-calendar support (sync multiple calendars to separate files) +;; - Pure Emacs Lisp .ics parser (no external dependencies) +;; - Recurring event support (RRULE expansion) +;; - Timer-based automatic sync (every 60 minutes, configurable) +;; - Self-contained in .emacs.d (no cron, portable across machines) +;; - Read-only (can't corrupt source calendars) +;; - Works with chime.el for event notifications +;; +;; Recurring Events (RRULE): +;; +;; Calendar recurring events are defined once with an RRULE +;; (recurrence rule) rather than as individual event instances. This +;; module expands recurring events into individual org entries. +;; +;; Expansion uses a rolling window approach: +;; - Past: 3 months before today +;; - Future: 12 months after today +;; +;; Every sync regenerates the entire file based on the current date, +;; so the window automatically advances as time passes. Old events +;; naturally fall off after 3 months, and new future events appear +;; as you approach them. +;; +;; Supported RRULE patterns: +;; - FREQ=DAILY: Daily events +;; - FREQ=WEEKLY;BYDAY=MO,WE,FR: Weekly on specific days +;; - FREQ=MONTHLY: Monthly events (same day each month) +;; - FREQ=YEARLY: Yearly events (anniversaries, birthdays) +;; - INTERVAL: Repeat every N periods (e.g., every 2 weeks) +;; - UNTIL: End date for recurrence +;; - COUNT: Maximum occurrences (combined with date range limit) +;; +;; Setup: +;; 1. Configure calendars in your init.el: +;; (setq calendar-sync-calendars +;; '((:name "google" +;; :url "https://calendar.google.com/calendar/ical/.../basic.ics" +;; :file gcal-file) +;; (:name "proton" +;; :url "https://calendar.proton.me/api/calendar/v1/url/.../calendar.ics" +;; :file pcal-file))) +;; +;; 2. Load and start: +;; (require 'calendar-sync) +;; (calendar-sync-start) +;; +;; 3. Add to org-agenda (optional): +;; (dolist (cal calendar-sync-calendars) +;; (add-to-list 'org-agenda-files (plist-get cal :file))) +;; +;; Usage: +;; - M-x calendar-sync-now ; Sync all or select specific calendar +;; - M-x calendar-sync-start ; Start auto-sync +;; - M-x calendar-sync-stop ; Stop auto-sync +;; - M-x calendar-sync-toggle ; Toggle auto-sync +;; - M-x calendar-sync-status ; Show sync status for all calendars + +;;; Code: + +(require 'org) +(require 'user-constants) ; For gcal-file, pcal-file paths + +;;; Configuration + +(defvar calendar-sync-calendars nil + "List of calendars to sync. +Each calendar is a plist with the following keys: + :name - Display name for the calendar (used in logs and prompts) + :url - URL to fetch .ics file from + :file - Output file path for org format + +Example: + (setq calendar-sync-calendars + \\='((:name \"google\" + :url \"https://calendar.google.com/calendar/ical/.../basic.ics\" + :file gcal-file) + (:name \"proton\" + :url \"https://calendar.proton.me/api/calendar/v1/url/.../calendar.ics\" + :file pcal-file)))") + +(defvar calendar-sync-interval-minutes 60 + "Sync interval in minutes. +Default: 60 minutes (1 hour).") + +(defvar calendar-sync-auto-start t + "Whether to automatically start calendar sync when module loads. +If non-nil, sync starts automatically when calendar-sync is loaded. +If nil, user must manually call `calendar-sync-start'.") + +(defvar calendar-sync-past-months 3 + "Number of months in the past to include when expanding recurring events. +Default: 3 months. This keeps recent history visible in org-agenda.") + +(defvar calendar-sync-future-months 12 + "Number of months in the future to include when expanding recurring events. +Default: 12 months. This provides a full year of future events.") + +;;; Internal state + +(defvar calendar-sync--timer nil + "Timer object for automatic syncing.") + +(defvar calendar-sync--calendar-states (make-hash-table :test 'equal) + "Per-calendar sync state. +Hash table mapping calendar name (string) to state plist with: + :last-sync - Time of last successful sync + :status - Symbol: ok, error, or syncing + :last-error - Error message string, or nil") + +(defvar calendar-sync--last-timezone-offset nil + "Timezone offset in seconds from UTC at last sync. +Used to detect timezone changes (e.g., when traveling).") + +(defvar calendar-sync--state-file + (expand-file-name "data/calendar-sync-state.el" user-emacs-directory) + "File to persist sync state across Emacs sessions.") + +;;; Timezone Detection + +(defun calendar-sync--current-timezone-offset () + "Get current timezone offset in seconds from UTC. +Returns negative for west of UTC, positive for east. +Example: -21600 for CST (UTC-6), -28800 for PST (UTC-8)." + (car (current-time-zone))) + +(defun calendar-sync--timezone-name () + "Get human-readable timezone name. +Returns string like 'CST' or 'PST'." + (cadr (current-time-zone))) + +(defun calendar-sync--format-timezone-offset (offset) + "Format timezone OFFSET (in seconds) as human-readable string. +Example: -21600 → 'UTC-6' or 'UTC-6:00'." + (if (null offset) + "unknown" + (let* ((hours (/ offset 3600)) + (minutes (abs (mod (/ offset 60) 60))) + (sign (if (>= hours 0) "+" "-")) + (abs-hours (abs hours))) + (if (= minutes 0) + (format "UTC%s%d" sign abs-hours) + (format "UTC%s%d:%02d" sign abs-hours minutes))))) + +(defun calendar-sync--timezone-changed-p () + "Return t if timezone has changed since last sync." + (and calendar-sync--last-timezone-offset + (not (= (calendar-sync--current-timezone-offset) + calendar-sync--last-timezone-offset)))) + +;;; State Persistence + +(defun calendar-sync--save-state () + "Save sync state to disk for persistence across sessions." + (let* ((calendar-states-alist + (let ((result '())) + (maphash (lambda (name state) + (push (cons name state) result)) + calendar-sync--calendar-states) + result)) + (state `((timezone-offset . ,calendar-sync--last-timezone-offset) + (calendar-states . ,calendar-states-alist))) + (dir (file-name-directory calendar-sync--state-file))) + (unless (file-directory-p dir) + (make-directory dir t)) + (with-temp-file calendar-sync--state-file + (prin1 state (current-buffer))))) + +(defun calendar-sync--load-state () + "Load sync state from disk." + (when (file-exists-p calendar-sync--state-file) + (condition-case err + (with-temp-buffer + (insert-file-contents calendar-sync--state-file) + (let ((state (read (current-buffer)))) + (setq calendar-sync--last-timezone-offset + (alist-get 'timezone-offset state)) + ;; Load per-calendar states + (let ((cal-states (alist-get 'calendar-states state))) + (clrhash calendar-sync--calendar-states) + (dolist (entry cal-states) + (puthash (car entry) (cdr entry) calendar-sync--calendar-states))))) + (error + (cj/log-silently "calendar-sync: Error loading state: %s" (error-message-string err)))))) + +(defun calendar-sync--get-calendar-state (calendar-name) + "Get state plist for CALENDAR-NAME, or nil if not found." + (gethash calendar-name calendar-sync--calendar-states)) + +(defun calendar-sync--set-calendar-state (calendar-name state) + "Set STATE plist for CALENDAR-NAME." + (puthash calendar-name state calendar-sync--calendar-states)) + +;;; Line Ending Normalization + +(defun calendar-sync--normalize-line-endings (content) + "Normalize line endings in CONTENT to Unix format (LF only). +Removes all carriage return characters (\\r) from CONTENT. +The iCalendar format (RFC 5545) uses CRLF line endings, but Emacs +and org-mode expect LF only. This function ensures consistent line +endings throughout the parsing pipeline. + +Returns CONTENT with all \\r characters removed." + (if (not (stringp content)) + content + (replace-regexp-in-string "\r" "" content))) + +;;; Date Utilities + +(defun calendar-sync--add-months (date months) + "Add MONTHS to DATE. +DATE is (year month day), returns new (year month day)." + (let* ((year (nth 0 date)) + (month (nth 1 date)) + (day (nth 2 date)) + (total-months (+ (* year 12) month -1 months)) + (new-year (/ total-months 12)) + (new-month (1+ (mod total-months 12)))) + (list new-year new-month day))) + +(defun calendar-sync--get-date-range () + "Get date range for event expansion as (start-time end-time). +Returns time values for -3 months and +12 months from today." + (let* ((now (decode-time)) + (today (list (nth 5 now) (nth 4 now) (nth 3 now))) + (start-date (calendar-sync--add-months today (- calendar-sync-past-months))) + (end-date (calendar-sync--add-months today calendar-sync-future-months)) + (start-time (apply #'encode-time 0 0 0 (reverse start-date))) + (end-time (apply #'encode-time 0 0 0 (reverse end-date)))) + (list start-time end-time))) + +(defun calendar-sync--date-in-range-p (date range) + "Check if DATE is within RANGE. +DATE is (year month day hour minute), RANGE is (start-time end-time)." + (let* ((year (nth 0 date)) + (month (nth 1 date)) + (day (nth 2 date)) + (date-time (encode-time 0 0 0 day month year)) + (start-time (nth 0 range)) + (end-time (nth 1 range))) + (and (time-less-p start-time date-time) + (time-less-p date-time end-time)))) + +(defun calendar-sync--weekday-to-number (weekday) + "Convert WEEKDAY string (MO, TU, etc.) to number (1-7). +Monday = 1, Sunday = 7." + (pcase weekday + ("MO" 1) + ("TU" 2) + ("WE" 3) + ("TH" 4) + ("FR" 5) + ("SA" 6) + ("SU" 7) + (_ nil))) + +(defun calendar-sync--date-weekday (date) + "Get weekday number for DATE (year month day). +Monday = 1, Sunday = 7." + (let* ((year (nth 0 date)) + (month (nth 1 date)) + (day (nth 2 date)) + (time (encode-time 0 0 0 day month year)) + (decoded (decode-time time)) + (dow (nth 6 decoded))) ; 0 = Sunday, 1 = Monday, etc. + (if (= dow 0) 7 dow))) ; Convert to 1-7 with Monday=1 + +(defun calendar-sync--add-days (date days) + "Add DAYS to DATE (year month day). +Returns new (year month day)." + (let* ((year (nth 0 date)) + (month (nth 1 date)) + (day (nth 2 date)) + (time (encode-time 0 0 0 day month year)) + (new-time (time-add time (days-to-time days))) + (decoded (decode-time new-time))) + (list (nth 5 decoded) (nth 4 decoded) (nth 3 decoded)))) + +;;; .ics Parsing + +(defun calendar-sync--split-events (ics-content) + "Split ICS-CONTENT into individual VEVENT blocks. +Returns list of strings, each containing one VEVENT block." + (let ((events '()) + (start 0)) + (while (string-match "BEGIN:VEVENT\\(.\\|\n\\)*?END:VEVENT" ics-content start) + (push (match-string 0 ics-content) events) + (setq start (match-end 0))) + (nreverse events))) + +(defun calendar-sync--get-property (event property) + "Extract PROPERTY value from EVENT string. +Handles property parameters (e.g., DTSTART;TZID=America/Chicago:value). +Handles multi-line values (lines starting with space). +Returns nil if property not found." + (when (string-match (format "^%s[^:\n]*:\\(.*\\)$" (regexp-quote property)) event) + (let ((value (match-string 1 event)) + (start (match-end 0))) + ;; Handle continuation lines (start with space or tab) + (while (and (< start (length event)) + (string-match "^\n[ \t]\\(.*\\)$" event start)) + (setq value (concat value (match-string 1 event))) + (setq start (match-end 0))) + value))) + +(defun calendar-sync--convert-utc-to-local (year month day hour minute second) + "Convert UTC datetime to local time. +Returns list (year month day hour minute) in local timezone." + (let* ((utc-time (encode-time second minute hour day month year 0)) + (local-time (decode-time utc-time))) + (list (nth 5 local-time) ; year + (nth 4 local-time) ; month + (nth 3 local-time) ; day + (nth 2 local-time) ; hour + (nth 1 local-time)))) ; minute + +(defun calendar-sync--parse-timestamp (timestamp-str) + "Parse iCal timestamp string TIMESTAMP-STR. +Returns (year month day hour minute) or (year month day) for all-day events. +Converts UTC times (ending in Z) to local time. +Returns nil if parsing fails." + (cond + ;; DateTime format: 20251116T140000Z or 20251116T140000 + ((string-match "\\([0-9]\\{4\\}\\)\\([0-9]\\{2\\}\\)\\([0-9]\\{2\\}\\)T\\([0-9]\\{2\\}\\)\\([0-9]\\{2\\}\\)\\([0-9]\\{2\\}\\)\\(Z\\)?" timestamp-str) + (let* ((year (string-to-number (match-string 1 timestamp-str))) + (month (string-to-number (match-string 2 timestamp-str))) + (day (string-to-number (match-string 3 timestamp-str))) + (hour (string-to-number (match-string 4 timestamp-str))) + (minute (string-to-number (match-string 5 timestamp-str))) + (second (string-to-number (match-string 6 timestamp-str))) + (is-utc (match-string 7 timestamp-str))) + (if is-utc + (calendar-sync--convert-utc-to-local year month day hour minute second) + (list year month day hour minute)))) + ;; Date format: 20251116 + ((string-match "\\([0-9]\\{4\\}\\)\\([0-9]\\{2\\}\\)\\([0-9]\\{2\\}\\)" timestamp-str) + (list (string-to-number (match-string 1 timestamp-str)) + (string-to-number (match-string 2 timestamp-str)) + (string-to-number (match-string 3 timestamp-str)))) + (t nil))) + +(defun calendar-sync--format-timestamp (start end) + "Format START and END timestamps as org timestamp. +START and END are lists from `calendar-sync--parse-timestamp'. +Returns string like '<2025-11-16 Sun 14:00-15:00>' or '<2025-11-16 Sun>'." + (let* ((year (nth 0 start)) + (month (nth 1 start)) + (day (nth 2 start)) + (start-hour (nth 3 start)) + (start-min (nth 4 start)) + (end-hour (and end (nth 3 end))) + (end-min (and end (nth 4 end))) + (date-str (format-time-string + "<%Y-%m-%d %a" + (encode-time 0 0 0 day month year))) + (time-str (when (and start-hour end-hour) + (format " %02d:%02d-%02d:%02d" + start-hour start-min end-hour end-min)))) + (concat date-str time-str ">"))) + +;;; RRULE Parsing and Expansion + +;;; Helper Functions + +(defun calendar-sync--date-to-time (date) + "Convert DATE (year month day) to time value for comparison. +DATE should be a list like (year month day)." + (apply #'encode-time 0 0 0 (reverse date))) + +(defun calendar-sync--before-date-p (date1 date2) + "Return t if DATE1 is before DATE2. +Both dates should be lists like (year month day)." + (time-less-p (calendar-sync--date-to-time date1) + (calendar-sync--date-to-time date2))) + +(defun calendar-sync--create-occurrence (base-event occurrence-date) + "Create an occurrence from BASE-EVENT with OCCURRENCE-DATE. +OCCURRENCE-DATE should be a list (year month day hour minute second)." + (let* ((occurrence (copy-sequence base-event)) + (end (plist-get base-event :end))) + (plist-put occurrence :start occurrence-date) + (when end + ;; Use the date from occurrence-date but keep the time from the original end + (let ((date-only (list (nth 0 occurrence-date) + (nth 1 occurrence-date) + (nth 2 occurrence-date)))) + (plist-put occurrence :end (append date-only (nthcdr 3 end))))) + occurrence)) + +(defun calendar-sync--parse-rrule (rrule-str) + "Parse RRULE string into plist. +Returns plist with :freq :interval :byday :until :count." + (let ((parts (split-string rrule-str ";")) + (result '())) + (dolist (part parts) + (when (string-match "\\([^=]+\\)=\\(.+\\)" part) + (let ((key (match-string 1 part)) + (value (match-string 2 part))) + (pcase key + ("FREQ" (setq result (plist-put result :freq (intern (downcase value))))) + ("INTERVAL" (setq result (plist-put result :interval (string-to-number value)))) + ("BYDAY" (setq result (plist-put result :byday (split-string value ",")))) + ("UNTIL" (setq result (plist-put result :until (calendar-sync--parse-timestamp value)))) + ("COUNT" (setq result (plist-put result :count (string-to-number value)))))))) + ;; Set defaults + (unless (plist-get result :interval) + (setq result (plist-put result :interval 1))) + result)) + +(defun calendar-sync--expand-daily (base-event rrule range) + "Expand daily recurring event. +BASE-EVENT is the event plist, RRULE is parsed rrule, RANGE is date range." + (let* ((start (plist-get base-event :start)) + (interval (plist-get rrule :interval)) + (until (plist-get rrule :until)) + (count (plist-get rrule :count)) + (occurrences '()) + (current-date (list (nth 0 start) (nth 1 start) (nth 2 start))) + (num-generated 0) + (range-end-time (cadr range))) + ;; For infinite recurrence (no COUNT/UNTIL), stop at range-end for performance + ;; For COUNT, generate all occurrences from start regardless of range + (while (and (or count until (time-less-p (calendar-sync--date-to-time current-date) range-end-time)) + (or (not until) (calendar-sync--before-date-p current-date until)) + (or (not count) (< num-generated count))) + (let ((occurrence-datetime (append current-date (nthcdr 3 start)))) + ;; Check UNTIL date first + (when (or (not until) (calendar-sync--before-date-p current-date until)) + ;; Check COUNT - increment BEFORE range check so COUNT is absolute from start + (when (or (not count) (< num-generated count)) + (setq num-generated (1+ num-generated)) + ;; Only add to output if within date range + (when (calendar-sync--date-in-range-p occurrence-datetime range) + (push (calendar-sync--create-occurrence base-event occurrence-datetime) + occurrences))))) + (setq current-date (calendar-sync--add-days current-date interval))) + (nreverse occurrences))) + +(defun calendar-sync--expand-weekly (base-event rrule range) + "Expand weekly recurring event. +BASE-EVENT is the event plist, RRULE is parsed rrule, RANGE is date range." + (let* ((start (plist-get base-event :start)) + (end (plist-get base-event :end)) + (interval (plist-get rrule :interval)) + (byday (plist-get rrule :byday)) + (until (plist-get rrule :until)) + (count (plist-get rrule :count)) + (occurrences '()) + (current-date (list (nth 0 start) (nth 1 start) (nth 2 start))) + (num-generated 0) + (range-end-time (cadr range)) + (max-iterations 1000) ;; Safety: prevent infinite loops + (iterations 0) + (weekdays (if byday + (mapcar #'calendar-sync--weekday-to-number byday) + (list (calendar-sync--date-weekday current-date))))) + ;; Validate interval + (when (<= interval 0) + (error "Invalid RRULE interval: %s (must be > 0)" interval)) + ;; Start from the first week + ;; For infinite recurrence (no COUNT/UNTIL), stop at range-end for performance + ;; For COUNT, generate all occurrences from start regardless of range + (while (and (< iterations max-iterations) + (or count until (time-less-p (calendar-sync--date-to-time current-date) range-end-time)) + (or (not count) (< num-generated count)) + (or (not until) (calendar-sync--before-date-p current-date until))) + (setq iterations (1+ iterations)) + ;; Generate occurrences for each weekday in this week + (dolist (weekday weekdays) + (let* ((current-weekday (calendar-sync--date-weekday current-date)) + (days-ahead (mod (- weekday current-weekday) 7)) + (occurrence-date (calendar-sync--add-days current-date days-ahead)) + (occurrence-datetime (append occurrence-date (nthcdr 3 start)))) + ;; Check UNTIL date first + (when (or (not until) (calendar-sync--before-date-p occurrence-date until)) + ;; Check COUNT - increment BEFORE range check so COUNT is absolute from start + (when (or (not count) (< num-generated count)) + (setq num-generated (1+ num-generated)) + ;; Only add to output if within date range + (when (calendar-sync--date-in-range-p occurrence-datetime range) + (push (calendar-sync--create-occurrence base-event occurrence-datetime) + occurrences)))))) + ;; Move to next interval week + (setq current-date (calendar-sync--add-days current-date (* 7 interval)))) + (when (>= iterations max-iterations) + (cj/log-silently "calendar-sync: WARNING: Hit max iterations (%d) expanding weekly event" max-iterations)) + (nreverse occurrences))) + +(defun calendar-sync--expand-monthly (base-event rrule range) + "Expand monthly recurring event. +BASE-EVENT is the event plist, RRULE is parsed rrule, RANGE is date range." + (let* ((start (plist-get base-event :start)) + (interval (plist-get rrule :interval)) + (until (plist-get rrule :until)) + (count (plist-get rrule :count)) + (occurrences '()) + (current-date (list (nth 0 start) (nth 1 start) (nth 2 start))) + (num-generated 0) + (range-end-time (cadr range))) + ;; For infinite recurrence (no COUNT/UNTIL), stop at range-end for performance + ;; For COUNT, generate all occurrences from start regardless of range + (while (and (or count until (time-less-p (calendar-sync--date-to-time current-date) range-end-time)) + (or (not until) (calendar-sync--before-date-p current-date until)) + (or (not count) (< num-generated count))) + (let ((occurrence-datetime (append current-date (nthcdr 3 start)))) + ;; Check UNTIL date first + (when (or (not until) (calendar-sync--before-date-p current-date until)) + ;; Check COUNT - increment BEFORE range check so COUNT is absolute from start + (when (or (not count) (< num-generated count)) + (setq num-generated (1+ num-generated)) + ;; Only add to output if within date range + (when (calendar-sync--date-in-range-p occurrence-datetime range) + (push (calendar-sync--create-occurrence base-event occurrence-datetime) + occurrences))))) + (setq current-date (calendar-sync--add-months current-date interval))) + (nreverse occurrences))) + +(defun calendar-sync--expand-yearly (base-event rrule range) + "Expand yearly recurring event. +BASE-EVENT is the event plist, RRULE is parsed rrule, RANGE is date range." + (let* ((start (plist-get base-event :start)) + (interval (plist-get rrule :interval)) + (until (plist-get rrule :until)) + (count (plist-get rrule :count)) + (occurrences '()) + (current-date (list (nth 0 start) (nth 1 start) (nth 2 start))) + (num-generated 0) + (range-end-time (cadr range))) + ;; For infinite recurrence (no COUNT/UNTIL), stop at range-end for performance + ;; For COUNT, generate all occurrences from start regardless of range + (while (and (or count until (time-less-p (calendar-sync--date-to-time current-date) range-end-time)) + (or (not until) (calendar-sync--before-date-p current-date until)) + (or (not count) (< num-generated count))) + (let ((occurrence-datetime (append current-date (nthcdr 3 start)))) + ;; Check UNTIL date first + (when (or (not until) (calendar-sync--before-date-p current-date until)) + ;; Check COUNT - increment BEFORE range check so COUNT is absolute from start + (when (or (not count) (< num-generated count)) + (setq num-generated (1+ num-generated)) + ;; Only add to output if within date range + (when (calendar-sync--date-in-range-p occurrence-datetime range) + (push (calendar-sync--create-occurrence base-event occurrence-datetime) + occurrences))))) + (setq current-date (calendar-sync--add-months current-date (* 12 interval)))) + (nreverse occurrences))) + +(defun calendar-sync--expand-recurring-event (event-str range) + "Expand recurring event EVENT-STR into individual occurrences within RANGE. +Returns list of event plists, or nil if not a recurring event." + (let ((rrule (calendar-sync--get-property event-str "RRULE"))) + (when rrule + (let* ((base-event (calendar-sync--parse-event event-str)) + (parsed-rrule (calendar-sync--parse-rrule rrule)) + (freq (plist-get parsed-rrule :freq))) + (when base-event + (pcase freq + ('daily (calendar-sync--expand-daily base-event parsed-rrule range)) + ('weekly (calendar-sync--expand-weekly base-event parsed-rrule range)) + ('monthly (calendar-sync--expand-monthly base-event parsed-rrule range)) + ('yearly (calendar-sync--expand-yearly base-event parsed-rrule range)) + (_ (cj/log-silently "calendar-sync: Unsupported RRULE frequency: %s" freq) + nil))))))) + +(defun calendar-sync--parse-event (event-str) + "Parse single VEVENT string EVENT-STR into plist. +Returns plist with :summary :description :location :start :end. +Returns nil if event lacks required fields (DTSTART, SUMMARY). +Skips events with RECURRENCE-ID (individual instances of recurring events)." + ;; Skip individual instances of recurring events (they're handled by RRULE expansion) + (unless (calendar-sync--get-property event-str "RECURRENCE-ID") + (let ((summary (calendar-sync--get-property event-str "SUMMARY")) + (description (calendar-sync--get-property event-str "DESCRIPTION")) + (location (calendar-sync--get-property event-str "LOCATION")) + (dtstart (calendar-sync--get-property event-str "DTSTART")) + (dtend (calendar-sync--get-property event-str "DTEND"))) + (when (and summary dtstart) + (let ((start-parsed (calendar-sync--parse-timestamp dtstart)) + (end-parsed (and dtend (calendar-sync--parse-timestamp dtend)))) + (when start-parsed + (list :summary summary + :description description + :location location + :start start-parsed + :end end-parsed))))))) + +(defun calendar-sync--event-to-org (event) + "Convert parsed EVENT plist to org entry string." + (let* ((summary (plist-get event :summary)) + (description (plist-get event :description)) + (location (plist-get event :location)) + (start (plist-get event :start)) + (end (plist-get event :end)) + (timestamp (calendar-sync--format-timestamp start end)) + (parts (list (format "* %s" summary)))) + (push timestamp parts) + (when description + (push description parts)) + (when location + (push (format "Location: %s" location) parts)) + (string-join (nreverse parts) "\n"))) + +(defun calendar-sync--event-start-time (event) + "Extract comparable start time from EVENT plist. +Returns time value suitable for comparison, or 0 if no start time." + (let ((start (plist-get event :start))) + (if start + (apply #'encode-time + 0 ; second + (or (nth 4 start) 0) ; minute + (or (nth 3 start) 0) ; hour + (nth 2 start) ; day + (nth 1 start) ; month + (nth 0 start) ; year + nil) + 0))) + +(defun calendar-sync--parse-ics (ics-content) + "Parse ICS-CONTENT and return org-formatted string. +Returns nil if parsing fails. +Events are sorted chronologically by start time. +Recurring events are expanded into individual occurrences." + (condition-case err + (let* ((range (calendar-sync--get-date-range)) + (events (calendar-sync--split-events ics-content)) + (parsed-events '()) + (max-events 5000) ; Safety limit to prevent Emacs from hanging + (events-generated 0)) + ;; Process each event + (dolist (event-str events) + (when (< events-generated max-events) + (let ((expanded (calendar-sync--expand-recurring-event event-str range))) + (if expanded + ;; Recurring event - add all occurrences + (progn + (setq parsed-events (append parsed-events expanded)) + (setq events-generated (+ events-generated (length expanded)))) + ;; Non-recurring event - parse normally + (let ((parsed (calendar-sync--parse-event event-str))) + (when (and parsed + (calendar-sync--date-in-range-p (plist-get parsed :start) range)) + (push parsed parsed-events) + (setq events-generated (1+ events-generated)))))))) + (when (>= events-generated max-events) + (cj/log-silently "calendar-sync: WARNING: Hit max events limit (%d), some events may be missing" max-events)) + (cj/log-silently "calendar-sync: Processing %d events..." (length parsed-events)) + ;; Sort and convert to org format + (let* ((sorted-events (sort parsed-events + (lambda (a b) + (time-less-p (calendar-sync--event-start-time a) + (calendar-sync--event-start-time b))))) + (org-entries (mapcar #'calendar-sync--event-to-org sorted-events))) + (if org-entries + (concat "# Calendar Events\n\n" + (string-join org-entries "\n\n") + "\n") + nil))) + (error + (setq calendar-sync--last-error (error-message-string err)) + (cj/log-silently "calendar-sync: Parse error: %s" calendar-sync--last-error) + nil))) + +;;; Sync functions + +(defun calendar-sync--fetch-ics (url callback) + "Fetch .ics file from URL asynchronously using curl. +Calls CALLBACK with the .ics content as string (normalized to Unix line endings) +or nil on error. CALLBACK signature: (lambda (content) ...). + +The fetch happens asynchronously and doesn't block Emacs. The callback is +invoked when the fetch completes, either successfully or with an error." + (condition-case err + (let ((buffer (generate-new-buffer " *calendar-sync-curl*"))) + (make-process + :name "calendar-sync-curl" + :buffer buffer + :command (list "curl" "-s" "-L" "-m" "30" url) + :sentinel + (lambda (process event) + (when (memq (process-status process) '(exit signal)) + (let ((buf (process-buffer process))) + (when (buffer-live-p buf) + (let ((content + (with-current-buffer buf + (if (and (eq (process-status process) 'exit) + (= (process-exit-status process) 0)) + (calendar-sync--normalize-line-endings (buffer-string)) + (setq calendar-sync--last-error + (format "curl failed: %s" (string-trim event))) + (cj/log-silently "calendar-sync: Fetch error: %s" calendar-sync--last-error) + nil)))) + (kill-buffer buf) + (funcall callback content)))))))) + (error + (setq calendar-sync--last-error (error-message-string err)) + (cj/log-silently "calendar-sync: Fetch error: %s" calendar-sync--last-error) + (funcall callback nil)))) + +(defun calendar-sync--write-file (content file) + "Write CONTENT to FILE. +Creates parent directories if needed." + (let ((dir (file-name-directory file))) + (unless (file-directory-p dir) + (make-directory dir t))) + (with-temp-file file + (insert content))) + +;;; Single Calendar Sync + +(defun calendar-sync--sync-calendar (calendar) + "Sync a single CALENDAR asynchronously. +CALENDAR is a plist with :name, :url, and :file keys. +Updates calendar state and saves to disk on completion." + (let ((name (plist-get calendar :name)) + (url (plist-get calendar :url)) + (file (plist-get calendar :file))) + ;; Mark as syncing + (calendar-sync--set-calendar-state name '(:status syncing)) + (cj/log-silently "calendar-sync: [%s] Syncing..." name) + (calendar-sync--fetch-ics + url + (lambda (ics-content) + (let ((org-content (and ics-content (calendar-sync--parse-ics ics-content)))) + (if org-content + (progn + (calendar-sync--write-file org-content file) + (calendar-sync--set-calendar-state + name + (list :status 'ok + :last-sync (current-time) + :last-error nil)) + (setq calendar-sync--last-timezone-offset + (calendar-sync--current-timezone-offset)) + (calendar-sync--save-state) + (message "calendar-sync: [%s] Sync complete → %s" name file)) + (calendar-sync--set-calendar-state + name + (list :status 'error + :last-sync (plist-get (calendar-sync--get-calendar-state name) :last-sync) + :last-error "Parse failed")) + (calendar-sync--save-state) + (message "calendar-sync: [%s] Sync failed (see *Messages*)" name))))))) + +(defun calendar-sync--sync-all-calendars () + "Sync all configured calendars asynchronously. +Each calendar syncs in parallel." + (if (null calendar-sync-calendars) + (message "calendar-sync: No calendars configured (set calendar-sync-calendars)") + (message "calendar-sync: Syncing %d calendar(s)..." (length calendar-sync-calendars)) + (dolist (calendar calendar-sync-calendars) + (calendar-sync--sync-calendar calendar)))) + +(defun calendar-sync--calendar-names () + "Return list of configured calendar names." + (mapcar (lambda (cal) (plist-get cal :name)) calendar-sync-calendars)) + +(defun calendar-sync--get-calendar-by-name (name) + "Find calendar plist by NAME, or nil if not found." + (cl-find-if (lambda (cal) (string= (plist-get cal :name) name)) + calendar-sync-calendars)) + +;;;###autoload +(defun calendar-sync-now (&optional calendar-name) + "Sync calendar(s) now asynchronously. +When called interactively, prompts to select a specific calendar or all. +When called non-interactively with CALENDAR-NAME, syncs that calendar. +When called non-interactively with nil, syncs all calendars." + (interactive + (list (when calendar-sync-calendars + (let ((choices (cons "all" (calendar-sync--calendar-names)))) + (completing-read "Sync calendar: " choices nil t nil nil "all"))))) + (cond + ((null calendar-sync-calendars) + (message "calendar-sync: No calendars configured (set calendar-sync-calendars)")) + ((or (null calendar-name) (string= calendar-name "all")) + (calendar-sync--sync-all-calendars)) + (t + (let ((calendar (calendar-sync--get-calendar-by-name calendar-name))) + (if calendar + (calendar-sync--sync-calendar calendar) + (message "calendar-sync: Calendar '%s' not found" calendar-name)))))) + +;;;###autoload +(defun calendar-sync-status () + "Display sync status for all configured calendars." + (interactive) + (if (null calendar-sync-calendars) + (message "calendar-sync: No calendars configured") + (let ((status-lines '())) + (dolist (calendar calendar-sync-calendars) + (let* ((name (plist-get calendar :name)) + (file (plist-get calendar :file)) + (state (calendar-sync--get-calendar-state name)) + (status (or (plist-get state :status) 'never)) + (last-sync (plist-get state :last-sync)) + (last-error (plist-get state :last-error)) + (status-str + (pcase status + ('ok (format "✓ %s" (if last-sync + (format-time-string "%Y-%m-%d %H:%M" last-sync) + "unknown"))) + ('error (format "✗ %s" (or last-error "error"))) + ('syncing "⟳ syncing...") + ('never "— never synced")))) + (push (format " %s: %s → %s" name status-str (abbreviate-file-name file)) + status-lines))) + (message "calendar-sync status:\n%s" + (string-join (nreverse status-lines) "\n"))))) + +;;; Timer management + +(defun calendar-sync--sync-timer-function () + "Function called by sync timer. +Checks for timezone changes and triggers re-sync if detected." + (when (calendar-sync--timezone-changed-p) + (let ((old-tz (calendar-sync--format-timezone-offset + calendar-sync--last-timezone-offset)) + (new-tz (calendar-sync--format-timezone-offset + (calendar-sync--current-timezone-offset)))) + (message "calendar-sync: Timezone change detected (%s → %s), re-syncing..." + old-tz new-tz))) + (calendar-sync--sync-all-calendars)) + +;;;###autoload +(defun calendar-sync-start () + "Start automatic calendar syncing. +Syncs all calendars immediately, then every `calendar-sync-interval-minutes'." + (interactive) + (when calendar-sync--timer + (cancel-timer calendar-sync--timer)) + (if (null calendar-sync-calendars) + (message "calendar-sync: No calendars configured (set calendar-sync-calendars)") + ;; Sync immediately + (calendar-sync--sync-all-calendars) + ;; Start timer for future syncs (convert minutes to seconds) + (let ((interval-seconds (* calendar-sync-interval-minutes 60))) + (setq calendar-sync--timer + (run-at-time interval-seconds + interval-seconds + #'calendar-sync--sync-timer-function))) + (message "calendar-sync: Auto-sync started (every %d minutes, %d calendars)" + calendar-sync-interval-minutes + (length calendar-sync-calendars)))) + +;;;###autoload +(defun calendar-sync-stop () + "Stop automatic calendar syncing." + (interactive) + (when calendar-sync--timer + (cancel-timer calendar-sync--timer) + (setq calendar-sync--timer nil) + (message "calendar-sync: Auto-sync stopped"))) + +;;;###autoload +(defun calendar-sync-toggle () + "Toggle automatic calendar syncing on/off." + (interactive) + (if calendar-sync--timer + (calendar-sync-stop) + (calendar-sync-start))) + +;;; Keybindings + +;; Calendar sync prefix and keymap +(defvar-keymap cj/calendar-map + :doc "Keymap for calendar synchronization operations" + "s" #'calendar-sync-now + "i" #'calendar-sync-status + "t" #'calendar-sync-toggle + "S" #'calendar-sync-start + "x" #'calendar-sync-stop) + +;; Only set up keybindings if cj/custom-keymap exists (not in test environment) +(when (boundp 'cj/custom-keymap) + (keymap-set cj/custom-keymap "g" cj/calendar-map) + + (with-eval-after-load 'which-key + (which-key-add-key-based-replacements + "C-; g" "calendar sync menu" + "C-; g s" "sync now" + "C-; g i" "sync status" + "C-; g t" "toggle auto-sync" + "C-; g S" "start auto-sync" + "C-; g x" "stop auto-sync"))) + +;;; Initialization + +;; Load saved state from previous session +(calendar-sync--load-state) + +;; Check for timezone change on startup +(when (and calendar-sync-calendars + (calendar-sync--timezone-changed-p)) + (let ((old-tz (calendar-sync--format-timezone-offset + calendar-sync--last-timezone-offset)) + (new-tz (calendar-sync--format-timezone-offset + (calendar-sync--current-timezone-offset)))) + (message "calendar-sync: Timezone changed since last session (%s → %s)" + old-tz new-tz) + (message "calendar-sync: Will sync on next timer tick") + ;; Note: We don't auto-sync here to avoid blocking Emacs startup + ;; User can manually sync or it will happen on next timer tick if auto-sync is enabled + )) + +;; Start auto-sync if enabled and calendars are configured +;; Syncs immediately then every calendar-sync-interval-minutes (default: 60 minutes) +(when (and calendar-sync-auto-start calendar-sync-calendars) + (calendar-sync-start)) + +(provide 'calendar-sync) +;;; calendar-sync.el ends here diff --git a/modules/calibredb-epub-config.el b/modules/calibredb-epub-config.el index ab9defd0..cf4b65ba 100644 --- a/modules/calibredb-epub-config.el +++ b/modules/calibredb-epub-config.el @@ -87,6 +87,10 @@ ;; ------------------------------ Nov Epub Reader ------------------------------ +(defvar cj/nov-margin-percent 25 + "Percentage of window width to use as margins on each side when reading epubs. +For example, 25 means 25% left margin + 25% right margin, with 50% for text.") + ;; Prevent magic-fallback-mode-alist from opening epub as archive-mode ;; Advise set-auto-mode to force nov-mode for .epub files before magic-fallback runs (defun cj/force-nov-mode-for-epub (orig-fun &rest args) @@ -123,7 +127,7 @@ (interactive) ;; Use Merriweather for comfortable reading with appropriate scaling ;; Darker sepia color (#E8DCC0) is easier on the eyes than pure white - (face-remap-add-relative 'variable-pitch :family "Merriweather" :height 1.8 :foreground "#E8DCC0") + (face-remap-add-relative 'variable-pitch :family "Merriweather" :height 1.0 :foreground "#E8DCC0") (face-remap-add-relative 'default :family "Merriweather" :height 180 :foreground "#E8DCC0") (face-remap-add-relative 'fixed-pitch :height 180 :foreground "#E8DCC0") ;; Make this buffer-local so other Nov buffers can choose differently @@ -136,8 +140,14 @@ ;; Enable visual-fill-column for centered text with margins (when (require 'visual-fill-column nil t) (setq-local visual-fill-column-center-text t) - ;; Set text width for comfortable reading (characters per line) - (setq-local visual-fill-column-width 100) + ;; Calculate text width based on configurable margin percentage + (let ((window (get-buffer-window (current-buffer))) + (text-width-ratio (- 1.0 (* 2 (/ cj/nov-margin-percent 100.0))))) + (if window + (setq-local visual-fill-column-width + (floor (* text-width-ratio (window-body-width window)))) + ;; Fallback if no window yet + (setq-local visual-fill-column-width 80))) (visual-fill-column-mode 1)) (nov-render-document) ;; Force visual-fill-column to recalculate after rendering diff --git a/modules/chrono-tools.el b/modules/chrono-tools.el index e68c2a50..ab3a9890 100644 --- a/modules/chrono-tools.el +++ b/modules/chrono-tools.el @@ -5,7 +5,7 @@ ;; ;; This module centralizes configuration for Emacs time-related tools: ;; -;; – world-clock: predefined city list and custom time format +;; – time-zones: interactive world clock with fuzzy search and time shifting ;; – calendar: quick navigation keybindings by day, month, and year ;; – tmr: lightweight timer setup with sounds, notifications, and history ;; @@ -13,24 +13,32 @@ (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")) +;; -------------------------------- Time Zones --------------------------------- + +(use-package time-zones + :defer + :commands time-zones + :bind ("M-C" . time-zones)) + +;; Commented out old world-clock config while testing time-zone package above +;; (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 diff --git a/modules/config-utilities.el b/modules/config-utilities.el index d1538256..2af3effa 100644 --- a/modules/config-utilities.el +++ b/modules/config-utilities.el @@ -17,12 +17,26 @@ (keymap-global-set "C-c d" cj/debug-config-keymap) (with-eval-after-load 'which-key - (which-key-add-key-based-replacements "C-c d" "config debugging utils")) + (which-key-add-key-based-replacements + "C-c d" "config debugging utils" + "C-c d p" "profiler menu" + "C-c d p s" "start profiler" + "C-c d p h" "stop profiler" + "C-c d p r" "profiler report" + "C-c d t" "toggle debug-on-error" + "C-c d b" "benchmark method" + "C-c d c" "compilation menu" + "C-c d c h" "compile home" + "C-c d c d" "delete compiled" + "C-c d c ." "compile buffer" + "C-c d i" "info menu" + "C-c d i b" "info build" + "C-c d i p" "info packages" + "C-c d i f" "info features" + "C-c d r" "reload init")) ;;; --------------------------------- Profiling --------------------------------- -(with-eval-after-load 'which-key - (which-key-add-key-based-replacements "C-c d p" "profiler menu.")) (keymap-set cj/debug-config-keymap "p s" #'profiler-start) (keymap-set cj/debug-config-keymap "p h" #'profiler-stop) (keymap-set cj/debug-config-keymap "p r" #'profiler-report) @@ -92,8 +106,6 @@ Recompile natively when supported, otherwise fall back to byte compilation." (message "Cancelled recompilation of %s" user-emacs-directory)))) (keymap-set cj/debug-config-keymap "c h" 'cj/recompile-emacs-home) -(with-eval-after-load 'which-key - (which-key-add-key-based-replacements "C-c d c" "config compilation options.")) (defun cj/delete-emacs-home-compiled-files () "Delete all compiled files recursively in \='user-emacs-directory\='." @@ -108,7 +120,6 @@ Recompile natively when supported, otherwise fall back to byte compilation." (find-lisp-find-files user-emacs-directory "")) (message "Done. Compiled files removed under %s" user-emacs-directory)) (keymap-set cj/debug-config-keymap "c d" 'cj/delete-emacs-home-compiled-files) -(keymap-set cj/debug-config-keymap "c d" 'cj/delete-emacs-home-compiled-files) (defun cj/compile-this-elisp-buffer () "Compile the current .el: prefer native (.eln), else .elc. Message if neither." @@ -215,8 +226,6 @@ Recompile natively when supported, otherwise fall back to byte compilation." (pop-to-buffer buf))) (keymap-set cj/debug-config-keymap "i b" 'cj/info-emacs-build) -(with-eval-after-load 'which-key - (which-key-add-key-based-replacements "C-c d i" "info on build/features/packages.")) (defvar cj--loaded-file-paths nil "All file paths that are loaded.") @@ -273,15 +282,6 @@ Recompile natively when supported, otherwise fall back to byte compilation." (load-file user-init-file)) (keymap-set cj/debug-config-keymap "r" 'cj/reload-init-file) -;; ----------------------------- 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.")) -(keymap-set cj/debug-config-keymap "a" 'cj/reset-auth-cache) - ;; ------------------------ Validate Org Agenda Entries ------------------------ (defun cj/validate-org-agenda-timestamps () diff --git a/modules/custom-buffer-file.el b/modules/custom-buffer-file.el new file mode 100644 index 00000000..b5740cd2 --- /dev/null +++ b/modules/custom-buffer-file.el @@ -0,0 +1,376 @@ +;;; custom-buffer-file.el --- Custom Buffer and File Operations -*- coding: utf-8; lexical-binding: t; -*- +;; +;;; Commentary: +;; This module provides custom buffer and file operations including PostScript +;; printing capabilities. +;; +;; Functions include: +;; - printing buffers or regions as PostScript to the default printer (with color support) +;; - moving/renaming/deleting buffer files +;; - diffing buffer contents with saved file version +;; - copying file paths and file:// links to the kill ring +;; - copying buffer contents (whole buffer, to top of buffer, to bottom of buffer) +;; - clearing buffer contents from point to top or bottom. +;; +;; The PostScript printing auto-detects the system print spooler (lpr or lp) +;; and prints with face/syntax highlighting. +;; +;; Keybindings under ~C-; b~: +;; - ~C-; b k~ kill buffer and window (delete window, kill/bury buffer) +;; - Copy buffer content submenu at ~C-; b c~ +;; - ~C-; b c w~ copy whole buffer +;; - ~C-; b c t~ copy from beginning to point +;; - ~C-; b c b~ copy from point to end +;; +;;; Code: + +;; cj/custom-keymap defined in keybindings.el +(eval-when-compile (defvar cj/custom-keymap)) +(eval-when-compile (require 'ps-print)) ;; for ps-print variables +(declare-function ps-print-buffer-with-faces "ps-print") +(declare-function ps-print-region-with-faces "ps-print") + +;; ------------------------- Print Buffer As Postscript ------------------------ + +(defvar cj/print-spooler-command 'auto + "Command used to send PostScript to the system print spooler. +Set to a string to force a specific command (e.g., lpr or lp). Set to `auto' to +auto-detect once per session.") + +(defvar cj/print--spooler-cache nil + "Cached spooler command detected for the current Emacs session.") + +(defun cj/print--resolve-spooler () + "Return the spooler command to use, auto-detecting and caching if needed." + (cond + ;; User-specified command + ((and (stringp cj/print-spooler-command) + (> (length cj/print-spooler-command) 0)) + (or (executable-find cj/print-spooler-command) + (user-error "Cannot print: spooler command '%s' not found in PATH" + cj/print-spooler-command)) + cj/print-spooler-command) + ;; Auto-detect once per session + ((eq cj/print-spooler-command 'auto) + (or cj/print--spooler-cache + (let ((cmd (or (and (executable-find "lpr") "lpr") + (and (executable-find "lp") "lp")))) + (unless cmd + (user-error "Cannot print: neither 'lpr' nor 'lp' found in PATH")) + (setq cj/print--spooler-cache cmd) + cmd))) + (t + (user-error "Invalid value for cj/print-spooler-command: %S" + cj/print-spooler-command)))) + +(defun cj/print-buffer-ps (&optional color) + "Print the buffer (or active region) as PostScript to the default printer. +With prefix argument COLOR, print in color and skip confirmation; otherwise +print in monochrome with confirmation prompt. +Sends directly to the system spooler with no header." + (interactive "P") + (unless (require 'ps-print nil t) + (user-error "Cannot print: ps-print library not found")) + (let* ((spooler (cj/print--resolve-spooler)) + (want-color (not (null color))) + (have-region (use-region-p)) + (skip-confirm color)) ; C-u skips confirmation + ;; Confirm unless C-u was used + (when (and (not skip-confirm) + (not (y-or-n-p (format "Send %s to printer? " + (if have-region "region" "buffer"))))) + (user-error "Printing cancelled")) + (let ((ps-lpr-command spooler) + (ps-printer-name nil) ; default system printer + (ps-lpr-switches nil) + (ps-print-color-p want-color) + (ps-use-face-background want-color) + (ps-print-header nil)) ; no headers + (if have-region + (ps-print-region-with-faces (region-beginning) (region-end)) + (ps-print-buffer-with-faces))) + (message "Sent %s to default printer via %s (%s)" + (if have-region "region" "buffer") + spooler + (if want-color "color" "monochrome")))) + +;; ------------------------- Buffer And File Operations ------------------------ + +(defun cj/--move-buffer-and-file (dir &optional ok-if-exists) + "Internal implementation: Move buffer and file to DIR. +If OK-IF-EXISTS is nil and target exists, signal an error. +If OK-IF-EXISTS is non-nil, overwrite existing file. +Returns t on success, nil if buffer not visiting a file." + (let* ((name (buffer-name)) + (filename (buffer-file-name)) + (dir (expand-file-name dir)) + (dir + (if (string-match "[/\\\\]$" dir) + (substring dir 0 -1) dir)) + (newname (concat dir "/" name))) + (if (not filename) + (progn + (message "Buffer '%s' is not visiting a file!" name) + nil) + (progn (copy-file filename newname ok-if-exists) + (delete-file filename) + (set-visited-file-name newname) + (set-buffer-modified-p nil) + t)))) + +(defun cj/move-buffer-and-file (dir) + "Move both current buffer and the file it visits to DIR. +When called interactively, prompts for confirmation if target file exists." + (interactive (list (read-directory-name "Move buffer and file (to new directory): "))) + (let* ((target (expand-file-name (buffer-name) (expand-file-name dir)))) + (condition-case _ + (cj/--move-buffer-and-file dir nil) + (file-already-exists + (if (yes-or-no-p (format "File %s exists; overwrite? " target)) + (cj/--move-buffer-and-file dir t) + (message "File not moved")))))) + +(defun cj/--rename-buffer-and-file (new-name &optional ok-if-exists) + "Internal implementation: Rename buffer and file to NEW-NAME. +NEW-NAME can be just a basename or a full path to move to different directory. +If OK-IF-EXISTS is nil and target exists, signal an error. +If OK-IF-EXISTS is non-nil, overwrite existing file. +Returns t on success, nil if buffer not visiting a file." + (let ((filename (buffer-file-name)) + (new-basename (file-name-nondirectory new-name))) + (if (not filename) + (progn + (message "Buffer '%s' is not visiting a file!" (buffer-name)) + nil) + ;; Check if a buffer with the new name already exists + (when (and (get-buffer new-basename) + (not (eq (get-buffer new-basename) (current-buffer)))) + (error "A buffer named '%s' already exists" new-basename)) + ;; Expand new-name to absolute path (preserves directory if just basename) + (let ((expanded-name (expand-file-name new-name + (file-name-directory filename)))) + (rename-file filename expanded-name ok-if-exists) + (rename-buffer new-basename) + (set-visited-file-name expanded-name) + (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. +When called interactively, prompts for confirmation if target file exists." + (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)))))) + (condition-case err + (cj/--rename-buffer-and-file new-name nil) + (file-already-exists + (if (yes-or-no-p (format "File %s exists; overwrite? " new-name)) + (cj/--rename-buffer-and-file new-name t) + (message "File not renamed"))) + (error + ;; Handle buffer-already-exists and other errors + (message "%s" (error-message-string err))))) + +(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/copy-to-bottom-of-buffer () + "Copy text from point to the end of the 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) (point-max)))) + (kill-new contents) + (message "Copied from point to end of buffer"))) + +(defun cj/copy-to-top-of-buffer () + "Copy text from the beginning of the buffer to point 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)))) + (kill-new contents) + (message "Copied from beginning of buffer to point"))) + +(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.")) + +(defun cj/copy-buffer-name () + "Copy current buffer name to kill ring." + (interactive) + (kill-new (buffer-name)) + (message "Copied: %s" (buffer-name))) + +(require 'system-lib) +(declare-function ansi-color-apply-on-region "ansi-color") + +(defun cj/--diff-with-difftastic (file1 file2 buffer) + "Run difftastic on FILE1 and FILE2, output to BUFFER. +Applies ANSI color and sets up special-mode for navigation." + (with-current-buffer buffer + (let ((inhibit-read-only t)) + (erase-buffer) + (insert (format "Difftastic diff: %s (saved) vs buffer (modified)\n\n" + (file-name-nondirectory file1))) + (call-process "difft" nil t nil + "--color" "always" + "--display" "side-by-side-show-both" + file1 file2) + (require 'ansi-color) + (ansi-color-apply-on-region (point-min) (point-max)) + (special-mode) + (goto-char (point-min))))) + +(defun cj/--diff-with-regular-diff (file1 file2 buffer) + "Run regular unified diff on FILE1 and FILE2, output to BUFFER. +Sets up diff-mode for navigation." + (with-current-buffer buffer + (let ((inhibit-read-only t)) + (erase-buffer) + (insert (format "Unified diff: %s (saved) vs buffer (modified)\n\n" + (file-name-nondirectory file1))) + (call-process "diff" nil t nil "-u" file1 file2) + (diff-mode) + (goto-char (point-min))))) + +(defun cj/diff-buffer-with-file () + "Compare the current modified buffer with the saved version. +Uses difftastic if available for syntax-aware diffing, falls back to regular diff. +Shows output in a separate buffer. +Signal an error if the buffer is not visiting a file." + (interactive) + (unless (buffer-file-name) + (user-error "Current buffer is not visiting a file")) + (let* ((file (buffer-file-name)) + (file-ext (file-name-extension file t)) ; includes the dot + (temp-file (make-temp-file "buffer-diff-" nil file-ext)) + (buffer-content (buffer-string))) ; Capture BEFORE with-temp-file! + (unwind-protect + (progn + ;; Write current buffer content to temp file + (with-temp-file temp-file + (insert buffer-content)) + ;; Check if there are any differences first + (if (zerop (call-process "diff" nil nil nil "-q" file temp-file)) + (message "No differences between buffer and file") + ;; Run diff/difftastic and display in buffer + (let* ((using-difftastic (cj/executable-exists-p "difft")) + (buffer-name (if using-difftastic + "*Diff (difftastic)*" + "*Diff (unified)*")) + (diff-buffer (get-buffer-create buffer-name))) + (if using-difftastic + (cj/--diff-with-difftastic file temp-file diff-buffer) + (cj/--diff-with-regular-diff file temp-file diff-buffer)) + (display-buffer diff-buffer)))) + ;; Clean up temp file + (when (file-exists-p temp-file) + (delete-file temp-file))))) + +;; --------------------------- Buffer And File Keymap -------------------------- + +;; Copy buffer content sub-keymap +(defvar-keymap cj/copy-buffer-content-map + :doc "Keymap for copy buffer content operations." + "w" #'cj/copy-whole-buffer + "b" #'cj/copy-to-bottom-of-buffer + "t" #'cj/copy-to-top-of-buffer) + +;; Buffer & file operations prefix and keymap +(defvar-keymap cj/buffer-and-file-map + :doc "Keymap for buffer and file operations." + "m" #'cj/move-buffer-and-file + "r" #'cj/rename-buffer-and-file + "p" #'cj/copy-path-to-buffer-file-as-kill + "d" #'cj/delete-buffer-and-file + "D" #'cj/diff-buffer-with-file + "c" cj/copy-buffer-content-map + "n" #'cj/copy-buffer-name + "l" #'cj/copy-link-to-buffer-file + "k" #'cj/kill-buffer-and-window + "P" #'cj/print-buffer-ps + "t" #'cj/clear-to-top-of-buffer + "b" #'cj/clear-to-bottom-of-buffer + "x" #'erase-buffer + "s" #'mark-whole-buffer + "S" #'write-file ;; save as + "g" #'revert-buffer) +(keymap-set cj/custom-keymap "b" cj/buffer-and-file-map) + +(with-eval-after-load 'which-key + (which-key-add-key-based-replacements + "C-; b" "buffer and file menu" + "C-; b m" "move file" + "C-; b r" "rename file" + "C-; b p" "copy file path" + "C-; b d" "delete file" + "C-; b D" "diff buffer with file" + "C-; b c" "buffer copy menu" + "C-; b c w" "copy whole buffer" + "C-; b c b" "copy to bottom" + "C-; b c t" "copy to top" + "C-; b n" "copy buffer name" + "C-; b l" "copy file link" + "C-; b k" "kill buffer and window" + "C-; b P" "print to PS" + "C-; b t" "clear to top" + "C-; b b" "clear to bottom" + "C-; b x" "erase buffer" + "C-; b s" "select whole buffer" + "C-; b S" "save as" + "C-; b g" "revert buffer")) + + +(provide 'custom-buffer-file) +;;; custom-buffer-file.el ends here. diff --git a/modules/custom-case.el b/modules/custom-case.el index 4fd9ac05..59250ddb 100644 --- a/modules/custom-case.el +++ b/modules/custom-case.el @@ -118,7 +118,11 @@ short prepositions, and all articles are considered minor words." (keymap-set cj/custom-keymap "c" cj/case-map) (with-eval-after-load 'which-key - (which-key-add-key-based-replacements "C-; c" "case change menu")) + (which-key-add-key-based-replacements + "C-; c" "case change menu" + "C-; c t" "title case" + "C-; c u" "upcase" + "C-; c l" "downcase")) (provide 'custom-case) ;;; custom-case.el ends here. diff --git a/modules/custom-comments.el b/modules/custom-comments.el index 101ba092..0d83d31b 100644 --- a/modules/custom-comments.el +++ b/modules/custom-comments.el @@ -13,11 +13,50 @@ ;; These utilities help create consistent, well-formatted code comments and section headers. ;; Bound to keymap prefix: C-; C ;; +;; Comment Style Patterns: +;; +;; inline-border: +;; ========== inline-border ========== +;; +;; simple-divider: +;; ==================================== +;; simple-divider +;; ==================================== +;; +;; padded-divider: +;; ==================================== +;; padded-divider +;; ==================================== +;; +;; box: +;; ************************************ +;; * box * +;; ************************************ +;; +;; heavy-box: +;; ************************************ +;; * * +;; * heavy-box * +;; * * +;; ************************************ +;; +;; unicode-box: +;; ┌──────────────────────────────────┐ +;; │ unicode-box │ +;; └──────────────────────────────────┘ +;; +;; block-banner: +;; /************************************ +;; * block-banner +;; ************************************/ +;; ;;; Code: (eval-when-compile (defvar cj/custom-keymap)) ;; cj/custom-keymap defined in keybindings.el (autoload 'cj/join-line-or-region "custom-line-paragraph" nil t) +;; ======================== Comment Manipulation Functions ===================== + ;; --------------------------- Delete Buffer Comments -------------------------- (defun cj/delete-buffer-comments () @@ -38,150 +77,560 @@ (orig-fill-column fill-column)) (uncomment-region beg end) (setq fill-column (- fill-column 3)) - (cj/join-line-or-region beg end) + (cj/join-line-or-region) (comment-region beg end) (setq fill-column orig-fill-column ))) ;; if no region (message "No region was selected. Select the comment lines to reformat.")) -;; ------------------------------ Comment Centered ----------------------------- +;; ======================== Comment Generation Functions ======================= + +;; ----------------------------- Inline Border --------------------------------- + +(defun cj/--comment-inline-border (cmt-start cmt-end decoration-char text length) + "Internal implementation: Generate single-line centered comment with decoration. +CMT-START and CMT-END are the comment syntax strings. +DECORATION-CHAR is the character to use for borders (string). +TEXT is the comment text (will be centered). +LENGTH is the total width of the line." + (let* ((current-column-pos (current-column)) + (text-length (length text)) + (comment-start-len (+ (length cmt-start) + (if (equal cmt-start ";") 1 0))) ; doubled semicolon + ;; Calculate available space for decoration + text + spaces + (available-width (- length current-column-pos + comment-start-len + (if (string-empty-p cmt-end) 0 (1+ (length cmt-end))) + 1)) ; space after comment-start + ;; Space for decoration on each side (excluding text and its surrounding spaces) + (space-on-each-side (/ (- available-width + text-length + (if (> text-length 0) 2 0)) ; spaces around text + 2)) + (min-space 2)) + ;; Validate we have enough space + (when (< space-on-each-side min-space) + (error "Length %d is too small for text '%s' (need at least %d more chars)" + length text (- min-space space-on-each-side))) + ;; Generate the line + (insert cmt-start) + (when (equal cmt-start ";") + (insert cmt-start)) + (insert " ") + ;; Left decoration + (dotimes (_ space-on-each-side) + (insert decoration-char)) + ;; Text with spaces + (when (> text-length 0) + (insert " " text " ")) + ;; Right decoration (handle odd-length text) + (dotimes (_ (if (= (% text-length 2) 0) + (- space-on-each-side 1) + space-on-each-side)) + (insert decoration-char)) + ;; Comment end + (when (not (string-empty-p cmt-end)) + (insert " " cmt-end)) + (newline))) + +(defun cj/comment-inline-border (&optional decoration-char) + "Insert single-line comment with TEXT centered around DECORATION-CHAR borders. +DECORATION-CHAR defaults to \"#\" if not provided. +Uses the lesser of `fill-column\\=' or 80 for line length." + (interactive) + (let* ((comment-start (if (and (boundp 'comment-start) comment-start) + comment-start + (read-string "Comment start character(s): "))) + (comment-end (if (and (boundp 'comment-end) comment-end) + comment-end + "")) + (decoration-char (or decoration-char "#")) + (text (capitalize (string-trim (read-from-minibuffer "Comment: ")))) + (length (min fill-column 80))) + (cj/--comment-inline-border comment-start comment-end decoration-char text length))) + +;; ---------------------------- Simple Divider --------------------------------- + +(defun cj/--comment-simple-divider (cmt-start cmt-end decoration-char text length) + "Internal implementation: Generate a simple divider comment. +CMT-START and CMT-END are the comment syntax strings. +DECORATION-CHAR is the character to use for the divider lines. +TEXT is the comment text. +LENGTH is the total width of each line." + (let* ((current-column-pos (current-column)) + (min-length (+ current-column-pos + (length cmt-start) + (if (equal cmt-start ";") 1 0) ; doubled semicolon + 1 ; space after comment-start + 3 ; minimum decoration chars + (if (string-empty-p cmt-end) 0 (1+ (length cmt-end)))))) + (when (< length min-length) + (error "Length %d is too small to generate comment (minimum %d)" length min-length)) + (let* ((available-width (- length current-column-pos + (length cmt-start) + (if (string-empty-p cmt-end) 0 (1+ (length cmt-end))))) + (line (make-string available-width (string-to-char decoration-char)))) + ;; Top line + (insert cmt-start) + (when (equal cmt-start ";") (insert cmt-start)) + (insert " ") + (insert line) + (when (not (string-empty-p cmt-end)) + (insert " " cmt-end)) + (newline) + + ;; Text line + (dotimes (_ current-column-pos) (insert " ")) + (insert cmt-start) + (when (equal cmt-start ";") (insert cmt-start)) + (insert " " text) + (when (not (string-empty-p cmt-end)) + (insert " " cmt-end)) + (newline) + + ;; Bottom line + (dotimes (_ current-column-pos) (insert " ")) + (insert cmt-start) + (when (equal cmt-start ";") (insert cmt-start)) + (insert " ") + (insert line) + (when (not (string-empty-p cmt-end)) + (insert " " cmt-end)) + (newline)))) + +(defun cj/comment-simple-divider () + "Insert a simple divider comment banner. +Prompts for decoration character, text, and length option." + (interactive) + (let* ((comment-start (if (and (boundp 'comment-start) comment-start) + comment-start + (read-string "Comment start character(s): "))) + (comment-end (if (and (boundp 'comment-end) comment-end) + comment-end + "")) + (decoration-char (read-string "Decoration character (default =): " nil nil "=")) + (text (read-string "Comment text: ")) + (length-option (completing-read "Length: " + '("fill-column" "half-column" "match-text") + nil t nil nil "fill-column")) + (length (cond + ((string= length-option "fill-column") fill-column) + ((string= length-option "half-column") (/ fill-column 2)) + ((string= length-option "match-text") + (+ (length comment-start) + (if (equal comment-start ";") 1 0) + 1 ; space after comment-start + (length text) + (if (string-empty-p comment-end) 0 (1+ (length comment-end)))))))) + (cj/--comment-simple-divider comment-start comment-end decoration-char text length))) + +;; ---------------------------- Padded Divider --------------------------------- + +(defun cj/--comment-padded-divider (cmt-start cmt-end decoration-char text length padding) + "Internal implementation: Generate a padded divider comment. +CMT-START and CMT-END are the comment syntax strings. +DECORATION-CHAR is the character to use for the divider lines. +TEXT is the comment text. +LENGTH is the total width of each line. +PADDING is the number of spaces before the text." + (when (< padding 0) + (error "Padding %d cannot be negative" padding)) + (let* ((current-column-pos (current-column)) + (min-length (+ current-column-pos + (length cmt-start) + (if (equal cmt-start ";") 1 0) ; doubled semicolon + 1 ; space after comment-start + 3 ; minimum decoration chars + (if (string-empty-p cmt-end) 0 (1+ (length cmt-end)))))) + (when (< length min-length) + (error "Length %d is too small to generate comment (minimum %d)" length min-length)) + (let* ((available-width (- length current-column-pos + (length cmt-start) + (if (string-empty-p cmt-end) 0 (1+ (length cmt-end))))) + (line (make-string available-width (string-to-char decoration-char)))) + ;; Top line + (insert cmt-start) + (when (equal cmt-start ";") (insert cmt-start)) + (insert " ") + (insert line) + (when (not (string-empty-p cmt-end)) + (insert " " cmt-end)) + (newline) + + ;; Text line with padding + (dotimes (_ current-column-pos) (insert " ")) + (insert cmt-start) + (when (equal cmt-start ";") (insert cmt-start)) + (insert " ") + (dotimes (_ padding) (insert " ")) + (insert text) + (when (not (string-empty-p cmt-end)) + (insert " " cmt-end)) + (newline) + + ;; Bottom line + (dotimes (_ current-column-pos) (insert " ")) + (insert cmt-start) + (when (equal cmt-start ";") (insert cmt-start)) + (insert " ") + (insert line) + (when (not (string-empty-p cmt-end)) + (insert " " cmt-end)) + (newline)))) -(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 line with the appropriate comment symbols for the current mode." +(defun cj/comment-padded-divider () + "Insert a padded divider comment banner. +Prompts for decoration character, text, padding, and length option." (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)))))) + (let* ((comment-start (if (and (boundp 'comment-start) comment-start) + comment-start + (read-string "Comment start character(s): "))) + (comment-end (if (and (boundp 'comment-end) comment-end) + comment-end + "")) + (decoration-char (read-string "Decoration character (default =): " nil nil "=")) + (text (read-string "Comment text: ")) + (padding (string-to-number (read-string "Padding spaces (default 2): " nil nil "2"))) + (length-option (completing-read "Length: " + '("fill-column" "half-column" "match-text") + nil t nil nil "fill-column")) + (length (cond + ((string= length-option "fill-column") fill-column) + ((string= length-option "half-column") (/ fill-column 2)) + ((string= length-option "match-text") + (+ (length comment-start) + (if (equal comment-start ";") 1 0) + 1 ; space after comment-start + padding + (length text) + (if (string-empty-p comment-end) 0 (1+ (length comment-end)))))))) + (cj/--comment-padded-divider comment-start comment-end decoration-char text length padding))) ;; -------------------------------- Comment Box -------------------------------- +(defun cj/--comment-box (cmt-start cmt-end decoration-char text length) + "Internal implementation: Generate a 3-line box comment with centered text. +CMT-START and CMT-END are the comment syntax strings. +DECORATION-CHAR is the character to use for borders. +TEXT is the comment text (centered). +LENGTH is the total width of each line." + (let* ((current-column-pos (current-column)) + (comment-char (if (equal cmt-start ";") ";;" cmt-start)) + (comment-end-char (if (string-empty-p cmt-end) comment-char cmt-end)) + (min-length (+ current-column-pos + (length comment-char) + 2 ; spaces around content + (length comment-end-char) + 6))) ; minimum: 3 border chars + text space + 3 border chars + (when (< length min-length) + (error "Length %d is too small to generate comment (minimum %d)" length min-length)) + (let* ((available-width (- length current-column-pos + (length comment-char) + (length comment-end-char) + 2)) ; spaces around content + (border-line (make-string available-width (string-to-char decoration-char))) + (text-length (length text)) + ;; For text line: need space for decoration + space + text + space + decoration + (text-available (- available-width 4)) ; 2 for side decorations, 2 for spaces + (padding-each-side (max 1 (/ (- text-available text-length) 2))) + (right-padding (if (= (% (- text-available text-length) 2) 0) + padding-each-side + (1+ padding-each-side)))) + ;; Top border + (insert comment-char " " border-line " " comment-end-char) + (newline) + + ;; Centered text line with side borders + (dotimes (_ current-column-pos) (insert " ")) + (insert comment-char " " decoration-char " ") + (dotimes (_ padding-each-side) (insert " ")) + (insert text) + (dotimes (_ right-padding) (insert " ")) + (insert " " decoration-char " " comment-end-char) + (newline) + + ;; Bottom border + (dotimes (_ current-column-pos) (insert " ")) + (insert comment-char " " border-line " " comment-end-char) + (newline)))) + (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." + "Insert a 3-line comment box with centered text. +Prompts for decoration character, text, and uses `fill-column' for length." + (interactive) + (let* ((comment-start (if (and (boundp 'comment-start) comment-start) + comment-start + (read-string "Comment start character(s): "))) + (comment-end (if (and (boundp 'comment-end) comment-end) + comment-end + "")) + (decoration-char (read-string "Decoration character (default -): " nil nil "-")) + (text (capitalize (string-trim (read-from-minibuffer "Comment: ")))) + (length (min fill-column 80))) + (cj/--comment-box comment-start comment-end decoration-char text length))) + +;; ------------------------------ Heavy Box ------------------------------------ + +(defun cj/--comment-heavy-box (cmt-start cmt-end decoration-char text length) + "Internal implementation: Generate a heavy box comment with blank lines. +CMT-START and CMT-END are the comment syntax strings. +DECORATION-CHAR is the character to use for borders. +TEXT is the comment text (centered). +LENGTH is the total width of each line." + (let* ((current-column-pos (current-column)) + (comment-char (if (equal cmt-start ";") ";;" cmt-start)) + (comment-end-char (if (string-empty-p cmt-end) comment-char cmt-end)) + (available-width (- length current-column-pos + (length comment-char) + (length comment-end-char) + 2)) ; spaces around content + (border-line (make-string available-width (string-to-char decoration-char))) + (text-length (length text)) + (padding-each-side (max 1 (/ (- available-width text-length) 2))) + (right-padding (if (= (% (- available-width text-length) 2) 0) + padding-each-side + (1+ padding-each-side)))) + ;; Top border + (insert comment-char " " border-line " " comment-end-char) + (newline) + + ;; Empty line with side borders + (dotimes (_ current-column-pos) (insert " ")) + (insert decoration-char) + (dotimes (_ available-width) (insert " ")) + (insert " " decoration-char) + (newline) + + ;; Centered text line + (dotimes (_ current-column-pos) (insert " ")) + (insert decoration-char " ") + (dotimes (_ padding-each-side) (insert " ")) + (insert text) + (dotimes (_ right-padding) (insert " ")) + (insert " " decoration-char) + (newline) + + ;; Empty line with side borders + (dotimes (_ current-column-pos) (insert " ")) + (insert decoration-char) + (dotimes (_ available-width) (insert " ")) + (insert " " decoration-char) + (newline) + + ;; Bottom border + (dotimes (_ current-column-pos) (insert " ")) + (insert comment-char " " border-line " " comment-end-char) + (newline))) + +(defun cj/comment-heavy-box () + "Insert a heavy box comment with blank lines around centered text. +Prompts for decoration character, text, and length option." + (interactive) + (let* ((comment-start (if (and (boundp 'comment-start) comment-start) + comment-start + (read-string "Comment start character(s): "))) + (comment-end (if (and (boundp 'comment-end) comment-end) + comment-end + "")) + (decoration-char (read-string "Decoration character (default *): " nil nil "*")) + (text (read-string "Comment text: ")) + (length-option (completing-read "Length: " + '("fill-column" "half-column" "padded-text") + nil t nil nil "fill-column")) + (length (cond + ((string= length-option "fill-column") fill-column) + ((string= length-option "half-column") (/ fill-column 2)) + ((string= length-option "padded-text") + (+ (current-column) + (length (if (equal comment-start ";") ";;" comment-start)) + 2 ; decoration char + space + 4 ; minimum padding (2 on each side) + (length text) + (if (string-empty-p comment-end) + 1 ; just the side decoration + (1+ (length comment-end)))))))) + (cj/--comment-heavy-box comment-start comment-end decoration-char text length))) + +;; ---------------------------- Unicode Box ------------------------------------ + +(defun cj/--comment-unicode-box (cmt-start cmt-end text length box-style) + "Internal implementation: Generate a unicode box comment. +CMT-START and CMT-END are the comment syntax strings. +TEXT is the comment text. +LENGTH is the total width of each line. +BOX-STYLE is either \\='single or \\='double for line style." + (let* ((current-column-pos (current-column)) + (comment-char (if (equal cmt-start ";") ";;" cmt-start)) + (min-length (+ current-column-pos + (length comment-char) + 1 ; space after comment-char + 5 ; minimum: corner + corner + padding + (if (string-empty-p cmt-end) 0 (1+ (length cmt-end)))))) + (when (< length min-length) + (error "Length %d is too small to generate comment (minimum %d)" length min-length)) + (let* ((available-width (- length current-column-pos + (length comment-char) + (if (string-empty-p cmt-end) 0 (1+ (length cmt-end))) + 3)) ; box corners and padding + (top-left (if (eq box-style 'double) "╔" "┌")) + (top-right (if (eq box-style 'double) "╗" "┐")) + (bottom-left (if (eq box-style 'double) "╚" "└")) + (bottom-right (if (eq box-style 'double) "╝" "┘")) + (horizontal (if (eq box-style 'double) "═" "─")) + (vertical (if (eq box-style 'double) "║" "│")) + (text-padding (- available-width (length text) 2))) + ;; Top line + (insert comment-char " " top-left) + (dotimes (_ available-width) (insert horizontal)) + (insert top-right) + (when (not (string-empty-p cmt-end)) + (insert " " cmt-end)) + (newline) + + ;; Text line + (dotimes (_ current-column-pos) (insert " ")) + (insert comment-char " " vertical " " text) + (dotimes (_ text-padding) (insert " ")) + (insert " " vertical) + (when (not (string-empty-p cmt-end)) + (insert " " cmt-end)) + (newline) + + ;; Bottom line + (dotimes (_ current-column-pos) (insert " ")) + (insert comment-char " " bottom-left) + (dotimes (_ available-width) (insert horizontal)) + (insert bottom-right) + (when (not (string-empty-p cmt-end)) + (insert " " cmt-end)) + (newline)))) + +(defun cj/comment-unicode-box () + "Insert a unicode box comment. +Prompts for text, box style, and length option." + (interactive) + (let* ((comment-start (if (and (boundp 'comment-start) comment-start) + comment-start + (read-string "Comment start character(s): "))) + (comment-end (if (and (boundp 'comment-end) comment-end) + comment-end + "")) + (text (read-string "Comment text: ")) + (box-style (intern (completing-read "Box style: " + '("single" "double") + nil t nil nil "single"))) + (length-option (completing-read "Length: " + '("fill-column" "half-column" "padded-text") + nil t nil nil "fill-column")) + (length (cond + ((string= length-option "fill-column") fill-column) + ((string= length-option "half-column") (/ fill-column 2)) + ((string= length-option "padded-text") + (+ (current-column) + (length (if (equal comment-start ";") ";;" comment-start)) + 5 ; box chars and spaces + (length text) + (if (string-empty-p comment-end) 0 (1+ (length comment-end)))))))) + (cj/--comment-unicode-box comment-start comment-end text length box-style))) + +;; ---------------------------- Block Banner ----------------------------------- + +(defun cj/--comment-block-banner (cmt-start cmt-end decoration-char text length) + "Internal implementation: Generate a block banner comment (JSDoc/Doxygen style). +CMT-START should be the block comment start (e.g., '/*'). +CMT-END should be the block comment end (e.g., '*/'). +DECORATION-CHAR is the character to use for the border line. +TEXT is the comment text. +LENGTH is the total width of each line." + (let* ((current-column-pos (current-column)) + (min-length (+ current-column-pos + (length cmt-start) + 3))) ; minimum: 3 decoration chars + (when (< length min-length) + (error "Length %d is too small to generate comment (minimum %d)" length min-length)) + (let* ((available-width (- length current-column-pos (length cmt-start) 1)) + (border-line (make-string available-width (string-to-char decoration-char)))) + ;; Top line + (insert cmt-start border-line) + (newline) + + ;; Text line + (dotimes (_ current-column-pos) (insert " ")) + (insert " " decoration-char " " text) + (newline) + + ;; Bottom line + (dotimes (_ current-column-pos) (insert " ")) + (insert " ") + (dotimes (_ (- available-width (length cmt-end))) + (insert decoration-char)) + (insert cmt-end) + (newline)))) + +(defun cj/comment-block-banner () + "Insert a block banner comment (JSDoc/Doxygen style). +Prompts for decoration character, text, and length option." (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))))) + (let* ((comment-start (if (and (boundp 'comment-start) comment-start + (string-match-p "/\\*" comment-start)) + comment-start + (read-string "Block comment start (e.g., /*): " nil nil "/*"))) + (comment-end (if (and (boundp 'comment-end) comment-end + (not (string-empty-p comment-end))) + comment-end + (read-string "Block comment end (e.g., */): " nil nil "*/"))) + (decoration-char (read-string "Decoration character (default *): " nil nil "*")) + (text (read-string "Comment text: ")) + (length-option (completing-read "Length: " + '("fill-column" "half-column" "match-text") + nil t nil nil "fill-column")) + (length (cond + ((string= length-option "fill-column") fill-column) + ((string= length-option "half-column") (/ fill-column 2)) + ((string= length-option "match-text") + (+ (current-column) + (length comment-start) + 2 ; space + decoration + (length text)))))) + (cj/--comment-block-banner comment-start comment-end decoration-char text length))) ;; ------------------------------- Comment Hyphen ------------------------------ (defun cj/comment-hyphen() "Insert a centered comment with `-' (hyphens) on each side. -Leverages cj/comment-centered." +Leverages cj/comment-inline-border." (interactive) - (cj/comment-centered "-")) + (cj/comment-inline-border "-")) ;; ------------------------------- Comment Keymap ------------------------------ (defvar-keymap cj/comment-map :doc "Keymap for code comment operations" "r" #'cj/comment-reformat - "c" #'cj/comment-centered + "d" #'cj/delete-buffer-comments + "c" #'cj/comment-inline-border "-" #'cj/comment-hyphen + "s" #'cj/comment-simple-divider + "p" #'cj/comment-padded-divider "b" #'cj/comment-box - "D" #'cj/delete-buffer-comments) + "h" #'cj/comment-heavy-box + "u" #'cj/comment-unicode-box + "n" #'cj/comment-block-banner) (keymap-set cj/custom-keymap "C" cj/comment-map) (with-eval-after-load 'which-key - (which-key-add-key-based-replacements "C-; C" "code comment menu")) + (which-key-add-key-based-replacements + "C-; C" "code comment menu" + "C-; C r" "reformat comment" + "C-; C d" "delete comments" + "C-; C c" "inline border" + "C-; C -" "hyphen divider" + "C-; C s" "simple divider" + "C-; C p" "padded divider" + "C-; C b" "box" + "C-; C h" "heavy box" + "C-; C u" "unicode box" + "C-; C n" "block banner")) (provide 'custom-comments) ;;; custom-comments.el ends here. diff --git a/modules/custom-datetime.el b/modules/custom-datetime.el index c195ebc2..5b06d81a 100644 --- a/modules/custom-datetime.el +++ b/modules/custom-datetime.el @@ -117,7 +117,14 @@ Use `readable-date-format' for formatting." (keymap-set cj/custom-keymap "d" cj/datetime-map) (with-eval-after-load 'which-key - (which-key-add-key-based-replacements "C-; d" "date/time insertion menu")) + (which-key-add-key-based-replacements + "C-; d" "date/time insertion menu" + "C-; d r" "readable date-time" + "C-; d s" "sortable date-time" + "C-; d t" "sortable time" + "C-; d T" "readable time" + "C-; d d" "sortable date" + "C-; d D" "readable date")) (provide 'custom-datetime) ;;; custom-datetime.el ends here. diff --git a/modules/custom-file-buffer.el b/modules/custom-file-buffer.el deleted file mode 100644 index 6ed19d73..00000000 --- a/modules/custom-file-buffer.el +++ /dev/null @@ -1,200 +0,0 @@ -;;; custom-file-buffer.el --- Custom Buffer and File Operations -*- coding: utf-8; lexical-binding: t; -*- -;; -;;; Commentary: -;; This module provides custom buffer and file operations including PostScript -;; printing capabilities. -;; -;; Functions include: -;; - printing buffers or regions as PostScript to the default printer (with color support) -;; - moving/renaming/deleting buffer files -;; - copying file paths and file:// links to the kill ring -;; - copying entire buffer contents -;; - clearing buffer contents from point to top or bottom. -;; -;; The PostScript printing auto-detects the system print spooler (lpr or lp) -;; and prints with face/syntax highlighting. Bound to keymap prefix ~C-; b~. -;; -;;; Code: - -;; cj/custom-keymap defined in keybindings.el -(eval-when-compile (defvar cj/custom-keymap)) -(eval-when-compile (require 'ps-print)) ;; for ps-print variables -(declare-function ps-print-buffer-with-faces "ps-print") -(declare-function ps-print-region-with-faces "ps-print") - -;; ------------------------- Print Buffer As Postscript ------------------------ - -(defvar cj/print-spooler-command 'auto - "Command used to send PostScript to the system print spooler. -Set to a string to force a specific command (e.g., lpr or lp). Set to `auto' to -auto-detect once per session.") - -(defvar cj/print--spooler-cache nil - "Cached spooler command detected for the current Emacs session.") - -(defun cj/print--resolve-spooler () - "Return the spooler command to use, auto-detecting and caching if needed." - (cond - ;; User-specified command - ((and (stringp cj/print-spooler-command) - (> (length cj/print-spooler-command) 0)) - (or (executable-find cj/print-spooler-command) - (user-error "Cannot print: spooler command '%s' not found in PATH" - cj/print-spooler-command)) - cj/print-spooler-command) - ;; Auto-detect once per session - ((eq cj/print-spooler-command 'auto) - (or cj/print--spooler-cache - (let ((cmd (or (and (executable-find "lpr") "lpr") - (and (executable-find "lp") "lp")))) - (unless cmd - (user-error "Cannot print: neither 'lpr' nor 'lp' found in PATH")) - (setq cj/print--spooler-cache cmd) - cmd))) - (t - (user-error "Invalid value for cj/print-spooler-command: %S" - cj/print-spooler-command)))) - -(defun cj/print-buffer-ps (&optional color) - "Print the buffer (or active region) as PostScript to the default printer. -With prefix argument COLOR, print in color; otherwise print in monochrome. -Sends directly to the system spooler with no header." - (interactive "P") - (unless (require 'ps-print nil t) - (user-error "Cannot print: ps-print library not found")) - (let* ((spooler (cj/print--resolve-spooler)) - (want-color (not (null color))) - (have-region (use-region-p))) - (let ((ps-lpr-command spooler) - (ps-printer-name nil) ; default system printer - (ps-lpr-switches nil) - (ps-print-color-p want-color) - (ps-use-face-background want-color) - (ps-print-header nil)) ; no headers - (if have-region - (ps-print-region-with-faces (region-beginning) (region-end)) - (ps-print-buffer-with-faces))) - (message "Sent %s to default printer via %s (%s)" - (if have-region "region" "buffer") - spooler - (if want-color "color" "monochrome")))) - -;; ------------------------- Buffer And File Operations ------------------------ - -(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 ((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.")) - -(defun cj/copy-buffer-name () - "Copy current buffer name to kill ring." - (interactive) - (kill-new (buffer-name)) - (message "Copied: %s" (buffer-name))) - -;; --------------------------- Buffer And File Keymap -------------------------- - -;; Buffer & file operations prefix and keymap -(defvar-keymap cj/buffer-and-file-map - :doc "Keymap for buffer and file operations." - "m" #'cj/move-buffer-and-file - "r" #'cj/rename-buffer-and-file - "p" #'cj/print-buffer-ps - "d" #'cj/delete-buffer-and-file - "c" #'cj/copy-whole-buffer - "n" #'cj/copy-buffer-name - "t" #'cj/clear-to-top-of-buffer - "b" #'cj/clear-to-bottom-of-buffer - "x" #'erase-buffer - "s" #'write-file ;; save as - - "l" #'cj/copy-link-to-buffer-file - "P" #'cj/copy-path-to-buffer-file-as-kill) -(keymap-set cj/custom-keymap "b" cj/buffer-and-file-map) - -(with-eval-after-load 'which-key - (which-key-add-key-based-replacements "C-; b" "buffer and file menu")) - - -(provide 'custom-file-buffer) -;;; custom-file-buffer.el ends here. diff --git a/modules/custom-line-paragraph.el b/modules/custom-line-paragraph.el index e66b024d..32f9aaa1 100644 --- a/modules/custom-line-paragraph.el +++ b/modules/custom-line-paragraph.el @@ -1,14 +1,13 @@ ;;; custom-line-paragraph.el --- -*- coding: utf-8; lexical-binding: t; -*- - +;; Author: Craig Jennings <c@cjennings.net> +;; ;;; Commentary: ;; -;; This module provides line and paragraph manipulation utilities. -;; These utilities enhance text editing and formatting capabilities. +;; This module provides the following line and paragraph manipulation utilities: ;; -;; Functions include: ;; - joining lines in a region or the current line with the previous one -;; - joining entire paragraphs into single lines -;; - duplicating lines or regions (with optional commenting) +;; - joining separate lines into a single paragraph +;; - duplicating lines or regions (optional commenting) ;; - removing duplicate lines ;; - removing lines containing specific text ;; - underlining text with a custom character @@ -18,6 +17,9 @@ ;;; Code: +(eval-when-compile (defvar cj/custom-keymap)) ;; defined in keybindings.el +(declare-function er/mark-paragraph "expand-region") ;; for cj/join-paragraph + (defun cj/join-line-or-region () "Join lines in the active region or join the current line with the previous one." (interactive) @@ -137,8 +139,15 @@ If the line is empty or contains only whitespace, abort with a message." (keymap-set cj/custom-keymap "l" cj/line-and-paragraph-map) (with-eval-after-load 'which-key - (which-key-add-key-based-replacements "C-; l" "line and paragraph menu") - (which-key-add-key-based-replacements "C-; l c" "duplicate and comment")) + (which-key-add-key-based-replacements + "C-; l" "line and paragraph menu" + "C-; l j" "join lines" + "C-; l J" "join paragraph" + "C-; l d" "duplicate" + "C-; l c" "duplicate and comment" + "C-; l R" "remove duplicates" + "C-; l r" "remove matching" + "C-; l u" "underscore line")) (provide 'custom-line-paragraph) ;;; custom-line-paragraph.el ends here. diff --git a/modules/custom-misc.el b/modules/custom-misc.el index 0c6d7ac8..7ba5a054 100644 --- a/modules/custom-misc.el +++ b/modules/custom-misc.el @@ -46,19 +46,27 @@ If not on a delimiter, show a message. Respects the current syntax table." (message "Point is not on a delimiter."))))) +(defun cj/--format-region (start end) + "Internal implementation: Reformat text between START and END. +START and END define the region to operate on. +Replaces tabs with spaces, reindents, and deletes trailing whitespace." + (when (> start end) + (error "Invalid region: start (%d) is greater than end (%d)" start end)) + (save-excursion + (save-restriction + (narrow-to-region start end) + (untabify (point-min) (point-max)) + (indent-region (point-min) (point-max)) + (delete-trailing-whitespace (point-min) (point-max))))) + (defun cj/format-region-or-buffer () "Reformat the region or the entire buffer. Replaces tabs with spaces, deletes trailing whitespace, and reindents." (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 (point-min) (point-max)))) - (message "Formatted %s" (if (use-region-p) "region" "buffer")))) + (end-pos (if (use-region-p) (region-end) (point-max)))) + (cj/--format-region start-pos end-pos) + (message "Formatted %s" (if (use-region-p) "region" "buffer")))) (defun cj/switch-to-previous-buffer () "Switch to previously open buffer. @@ -66,6 +74,14 @@ Repeated invocations toggle between the two most recently open buffers." (interactive) (switch-to-buffer (other-buffer (current-buffer) 1))) +(defun cj/--count-words (start end) + "Internal implementation: Count words between START and END. +START and END define the region to count. +Returns the word count as an integer." + (when (> start end) + (error "Invalid region: start (%d) is greater than end (%d)" start end)) + (count-words start end)) + (defun cj/count-words-buffer-or-region () "Count the number of words in the buffer or region. Display the result in the minibuffer." @@ -73,9 +89,57 @@ Display the result in the minibuffer." (let* ((use-region (use-region-p)) (begin (if use-region (region-beginning) (point-min))) (end (if use-region (region-end) (point-max))) - (area-type (if use-region "the region" "the buffer"))) - (message "There are %d words in %s." (count-words begin end) area-type))) + (area-type (if use-region "the region" "the buffer")) + (word-count (cj/--count-words begin end))) + (message "There are %d words in %s." word-count area-type))) +(defun cj/--count-characters (start end) + "Internal implementation: Count characters between START and END. +START and END define the region to count. +Returns the character count as an integer." + (when (> start end) + (error "Invalid region: start (%d) is greater than end (%d)" start end)) + (- end start)) + +(defun cj/count-characters-buffer-or-region () + "Count the number of characters in the buffer or region. +Display the result in the minibuffer." + (interactive) + (let* ((use-region (use-region-p)) + (begin (if use-region (region-beginning) (point-min))) + (end (if use-region (region-end) (point-max))) + (area-type (if use-region "the region" "the buffer")) + (char-count (cj/--count-characters begin end))) + (message "There are %d characters in %s." char-count area-type))) + + +(defun cj/--replace-fraction-glyphs (start end to-glyphs) + "Internal implementation: Replace fraction glyphs or text between START and END. +START and END define the region to operate on. +TO-GLYPHS when non-nil converts text (1/4) to glyphs (¼), +otherwise converts glyphs to text." + (when (> start end) + (error "Invalid region: start (%d) is greater than end (%d)" start end)) + (let ((replacements (if to-glyphs + '(("1/4" . "¼") + ("1/2" . "½") + ("3/4" . "¾") + ("1/3" . "⅓") + ("2/3" . "⅔")) + '(("¼" . "1/4") + ("½" . "1/2") + ("¾" . "3/4") + ("⅓" . "1/3") + ("⅔" . "2/3")))) + (count 0) + (end-marker (copy-marker end))) + (save-excursion + (dolist (r replacements) + (goto-char start) + (while (search-forward (car r) end-marker t) + (replace-match (cdr r)) + (setq count (1+ count))))) + count)) (defun cj/replace-fraction-glyphs (start end) "Replace common fraction glyphs between START and END. @@ -83,27 +147,10 @@ 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")))) - (count 0)) - (save-excursion - (dolist (r replacements) - (goto-char start) - (while (search-forward (car r) end t) - (replace-match (cdr r)) - (setq count (1+ count))))) - (message "Replaced %d fraction%s" count (if (= count 1) "" "s")))) + (list (region-beginning) (region-end)) + (list (point-min) (point-max)))) + (let ((count (cj/--replace-fraction-glyphs start end current-prefix-arg))) + (message "Replaced %d fraction%s" count (if (= count 1) "" "s")))) (defun cj/align-regexp-with-spaces (orig-fun &rest args) "Call ORIG-FUN with ARGS while temporarily disabling tabs for alignment. @@ -118,11 +165,23 @@ to nil." (keymap-set cj/custom-keymap ")" #'cj/jump-to-matching-paren) (keymap-set cj/custom-keymap "f" #'cj/format-region-or-buffer) -(keymap-set cj/custom-keymap "W" #'cj/count-words-buffer-or-region) +(keymap-set cj/custom-keymap "# w" #'cj/count-words-buffer-or-region) +(keymap-set cj/custom-keymap "# c" #'cj/count-characters-buffer-or-region) (keymap-set cj/custom-keymap "/" #'cj/replace-fraction-glyphs) (keymap-set cj/custom-keymap "A" #'align-regexp) (keymap-set cj/custom-keymap "SPC" #'cj/switch-to-previous-buffer) (keymap-set cj/custom-keymap "|" #'display-fill-column-indicator-mode) +(with-eval-after-load 'which-key + (which-key-add-key-based-replacements + "C-; )" "jump to paren" + "C-; f" "format buffer" + "C-; # w" "count words" + "C-; # c" "count characters" + "C-; /" "fraction glyphs" + "C-; A" "align regexp" + "C-; SPC" "prev buffer" + "C-; |" "fill column")) + (provide 'custom-misc) ;;; custom-misc.el ends here diff --git a/modules/custom-ordering.el b/modules/custom-ordering.el index 5d308604..f6972910 100644 --- a/modules/custom-ordering.el +++ b/modules/custom-ordering.el @@ -2,47 +2,197 @@ ;;; Commentary: -;; This module provides functions for converting text between different formats and sorting operations. -;; These utilities are useful for reformatting data structures and organizing text. - -;; Functions include: - -;; - converting lines to quoted comma-separated arrays (arrayify) -;; - converting arrays back to separate lines (unarrayify) -;; - alphabetically sorting words in a region -;; - splitting comma-separated text into individual lines - +;; Text transformation and sorting utilities for reformatting data structures. +;; +;; Array/list formatting: +;; - arrayify/listify - convert lines to comma-separated format (with/without quotes, brackets) +;; - unarrayify - convert arrays back to separate lines +;; +;; Line manipulation: +;; - toggle-quotes - swap double ↔ single quotes +;; - reverse-lines - reverse line order +;; - number-lines - add line numbers with custom format (supports zero-padding) +;; - alphabetize-region - sort words alphabetically +;; - comma-separated-text-to-lines - split CSV text into lines +;; +;; Convenience functions: listify, arrayify-json, arrayify-python ;; Bound to keymap prefix C-; o ;;; Code: +(require 'cl-lib) + ;; cj/custom-keymap defined in keybindings.el (eval-when-compile (defvar cj/custom-keymap)) (defvar cj/ordering-map) +(defun cj/--arrayify (start end quote &optional prefix suffix) + "Internal implementation: Convert lines to quoted, comma-separated format. +START and END define the region to operate on. +QUOTE specifies the quotation characters to surround each element. + Use \"\" for no quotes, \"\\\"\" for double quotes, \"'\" for single quotes. +PREFIX is an optional string to prepend to the result (e.g., \"[\" or \"(\"). +SUFFIX is an optional string to append to the result (e.g., \"]\" or \")\"). +Returns the transformed string without modifying the buffer." + (when (> start end) + (error "Invalid region: start (%d) is greater than end (%d)" start end)) + (let ((result (mapconcat + (lambda (x) (format "%s%s%s" quote x quote)) + (split-string (buffer-substring start end)) ", "))) + (concat (or prefix "") result (or suffix "")))) + (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)) ", "))) + (let ((insertion (cj/--arrayify start end quote))) (delete-region start end) (insert insertion))) +(defun cj/listify (start end) + "Convert lines between START and END into an unquoted, comma-separated list. +START and END identify the active region. +Example: `apple banana cherry' becomes `apple, banana, cherry'." + (interactive "r") + (let ((insertion (cj/--arrayify start end ""))) + (delete-region start end) + (insert insertion))) + +(defun cj/arrayify-json (start end) + "Convert lines between START and END into a JSON-style array. +START and END identify the active region. +Example: `apple banana cherry' becomes `[\"apple\", \"banana\", \"cherry\"]'." + (interactive "r") + (let ((insertion (cj/--arrayify start end "\"" "[" "]"))) + (delete-region start end) + (insert insertion))) + +(defun cj/arrayify-python (start end) + "Convert lines between START and END into a Python-style list. +START and END identify the active region. +Example: `apple banana cherry' becomes `[\"apple\", \"banana\", \"cherry\"]'." + (interactive "r") + (let ((insertion (cj/--arrayify start end "\"" "[" "]"))) + (delete-region start end) + (insert insertion))) + +(defun cj/--unarrayify (start end) + "Internal implementation: Convert comma-separated array to lines. +START and END define the region to operate on. +Removes quotes (both single and double) and splits by ', '. +Returns the transformed string without modifying the buffer." + (when (> start end) + (error "Invalid region: start (%d) is greater than end (%d)" start end)) + (mapconcat + (lambda (x) (replace-regexp-in-string "[\"']" "" x)) + (split-string (buffer-substring start end) ", ") "\n")) + (defun cj/unarrayify (start end) "Convert quoted comma-separated strings between START and END to 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"))) + (let ((insertion (cj/--unarrayify start end))) (delete-region start end) (insert insertion))) +(defun cj/--toggle-quotes (start end) + "Internal implementation: Toggle between double and single quotes. +START and END define the region to operate on. +Swaps all double quotes with single quotes and vice versa. +Returns the transformed string without modifying the buffer." + (when (> start end) + (error "Invalid region: start (%d) is greater than end (%d)" start end)) + (let ((text (buffer-substring start end))) + (with-temp-buffer + (insert text) + (goto-char (point-min)) + ;; Use a placeholder to avoid double-swapping + (while (search-forward "\"" nil t) + (replace-match "\001" nil t)) + (goto-char (point-min)) + (while (search-forward "'" nil t) + (replace-match "\"" nil t)) + (goto-char (point-min)) + (while (search-forward "\001" nil t) + (replace-match "'" nil t)) + (buffer-string)))) + +(defun cj/toggle-quotes (start end) + "Toggle between double and single quotes in region between START and END. +START and END identify the active region." + (interactive "r") + (let ((insertion (cj/--toggle-quotes start end))) + (delete-region start end) + (insert insertion))) + +(defun cj/--reverse-lines (start end) + "Internal implementation: Reverse the order of lines in region. +START and END define the region to operate on. +Returns the transformed string without modifying the buffer." + (when (> start end) + (error "Invalid region: start (%d) is greater than end (%d)" start end)) + (let ((lines (split-string (buffer-substring start end) "\n"))) + (mapconcat #'identity (nreverse lines) "\n"))) + +(defun cj/reverse-lines (start end) + "Reverse the order of lines in region between START and END. +START and END identify the active region." + (interactive "r") + (let ((insertion (cj/--reverse-lines start end))) + (delete-region start end) + (insert insertion))) + +(defun cj/--number-lines (start end format-string zero-pad) + "Internal implementation: Number lines in region with custom format. +START and END define the region to operate on. +FORMAT-STRING is the format for each line, with N as placeholder for number. + Example: \"N. \" produces \"1. \", \"2. \", etc. + Example: \"[N] \" produces \"[1] \", \"[2] \", etc. +ZERO-PAD when non-nil pads numbers with zeros for alignment. + Example with 100 lines: \"001\", \"002\", ..., \"100\". +Returns the transformed string without modifying the buffer." + (when (> start end) + (error "Invalid region: start (%d) is greater than end (%d)" start end)) + (let* ((lines (split-string (buffer-substring start end) "\n")) + (line-count (length lines)) + (width (if zero-pad (length (number-to-string line-count)) 1)) + (format-spec (if zero-pad (format "%%0%dd" width) "%d"))) + (mapconcat + (lambda (pair) + (let* ((num (car pair)) + (line (cdr pair)) + (num-str (format format-spec num))) + (concat (replace-regexp-in-string "N" num-str format-string) line))) + (cl-loop for line in lines + for i from 1 + collect (cons i line)) + "\n"))) + +(defun cj/number-lines (start end format-string zero-pad) + "Number lines in region between START and END with custom format. +START and END identify the active region. +FORMAT-STRING is the format for each line, with N as placeholder for number. + Example: \"N. \" produces \"1. \", \"2. \", etc. +ZERO-PAD when non-nil (prefix argument) pads numbers with zeros." + (interactive "r\nMFormat string (use N for number): \nP") + (let ((insertion (cj/--number-lines start end format-string zero-pad))) + (delete-region start end) + (insert insertion))) + +(defun cj/--alphabetize-region (start end) + "Internal implementation: Alphabetize words in region. +START and END define the region to operate on. +Splits by whitespace and commas, sorts alphabetically, joins with ', '. +Returns the transformed string without modifying the buffer." + (when (> start end) + (error "Invalid region: start (%d) is greater than end (%d)" start end)) + (let ((string (buffer-substring-no-properties start end))) + (mapconcat #'identity + (sort (split-string string "[[:space:],]+" t) + #'string-lessp) + ", "))) + (defun cj/alphabetize-region () "Alphabetize words in the active region and replace the original text. Produce a comma-separated list as the result." @@ -51,14 +201,26 @@ Produce a comma-separated list as the result." (user-error "No region selected")) (let ((start (region-beginning)) (end (region-end)) - (string (buffer-substring-no-properties (region-beginning) (region-end)))) + (insertion (cj/--alphabetize-region (region-beginning) (region-end)))) (delete-region start end) (goto-char start) - (insert - (mapconcat #'identity - (sort (split-string string "[[:space:],]+" t) - #'string-lessp) - ", ")))) + (insert insertion))) + +(defun cj/--comma-separated-text-to-lines (start end) + "Internal implementation: Convert comma-separated text to lines. +START and END define the region to operate on. +Replaces commas with newlines and removes trailing whitespace from each line. +Returns the transformed string without modifying the buffer." + (when (> start end) + (error "Invalid region: start (%d) is greater than end (%d)" start end)) + (let ((text (buffer-substring-no-properties start end))) + (with-temp-buffer + (insert text) + (goto-char (point-min)) + (while (search-forward "," nil t) + (replace-match "\n" nil t)) + (delete-trailing-whitespace) + (buffer-string)))) (defun cj/comma-separated-text-to-lines () "Break up comma-separated text in active region so each item is on own line." @@ -68,15 +230,7 @@ Produce a comma-separated list as the result." (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))) - + (text (cj/--comma-separated-text-to-lines (region-beginning) (region-end)))) (delete-region beg end) (goto-char beg) (insert text))) @@ -88,12 +242,29 @@ Produce a comma-separated list as the result." :doc "Keymap for text ordering and sorting operations" "a" #'cj/arrayify "u" #'cj/unarrayify + "l" #'cj/listify + "j" #'cj/arrayify-json + "p" #'cj/arrayify-python + "q" #'cj/toggle-quotes + "r" #'cj/reverse-lines + "n" #'cj/number-lines "A" #'cj/alphabetize-region - "l" #'cj/comma-separated-text-to-lines) + "L" #'cj/comma-separated-text-to-lines + "o" #'cj/org-sort-by-todo-and-priority) (keymap-set cj/custom-keymap "o" cj/ordering-map) (with-eval-after-load 'which-key - (which-key-add-key-based-replacements "C-; o" "ordering/sorting menu")) + (which-key-add-key-based-replacements + "C-; o" "ordering/sorting menu" + "C-; o l" "listify" + "C-; o j" "JSON array" + "C-; o p" "Python list" + "C-; o q" "toggle quotes" + "C-; o r" "reverse lines" + "C-; o n" "number lines" + "C-; o A" "alphabetize" + "C-; o L" "comma to lines" + "C-; o o" "org: sort by TODO+priority")) (provide 'custom-ordering) ;;; custom-ordering.el ends here. diff --git a/modules/custom-text-enclose.el b/modules/custom-text-enclose.el index 514419cd..e93e6dea 100644 --- a/modules/custom-text-enclose.el +++ b/modules/custom-text-enclose.el @@ -2,82 +2,285 @@ ;;; Commentary: -;; This module provides functions to surround words or regions with custom strings, and to append or prepend text to lines. +;; Text enclosure utilities for wrapping and line manipulation. +;; +;; Wrapping functions: +;; - surround-word-or-region - wrap text with same delimiter on both sides +;; - wrap-word-or-region - wrap with different opening/closing delimiters +;; - unwrap-word-or-region - remove surrounding delimiters +;; +;; Line manipulation: +;; - append-to-lines - add suffix to each line +;; - prepend-to-lines - add prefix to each line +;; - indent-lines - add leading whitespace (spaces or tabs) +;; - dedent-lines - remove leading whitespace +;; +;; Most functions work on region or entire buffer when no region is active. +;; +;; Bound to keymap prefix C-; s -;; It includes three main functions: -;; - surround word or region with a user-specified string -;; - append text to the end of lines -;; - prepend text to the beginning of lines +;;; Code: -;; All functions work on both the active region and the entire buffer when no region is selected. +;; cj/custom-keymap defined in keybindings.el +(eval-when-compile (defvar cj/custom-keymap)) -;; Bound to keymap prefix C-; s +(defun cj/--surround (text surround-string) + "Internal implementation: Surround TEXT with SURROUND-STRING. +TEXT is the string to be surrounded. +SURROUND-STRING is prepended and appended to TEXT. +Returns the surrounded text without modifying the buffer." + (concat surround-string text surround-string)) -;;; Code: +(defun cj/--wrap (text opening closing) + "Internal implementation: Wrap TEXT with OPENING and CLOSING strings. +TEXT is the string to be wrapped. +OPENING is prepended to TEXT. +CLOSING is appended to TEXT. +Returns the wrapped text without modifying the buffer." + (concat opening text closing)) (defun cj/surround-word-or-region () - "Surround the word at point or active region with a string read from the minibuffer." + "Surround the word at point or active region with a string. +The surround string is 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.")))))) + (if regionp + (let ((beg (region-beginning)) + (end (region-end)) + (text (buffer-substring (region-beginning) (region-end)))) + (delete-region beg end) + (goto-char beg) + (insert (cj/--surround text str))) + (if (thing-at-point 'word) + (let* ((bounds (bounds-of-thing-at-point 'word)) + (text (buffer-substring (car bounds) (cdr bounds)))) + (delete-region (car bounds) (cdr bounds)) + (goto-char (car bounds)) + (insert (cj/--surround text str))) + (message "Can't insert around. No word at point and no region selected."))))) + +(defun cj/wrap-word-or-region () + "Wrap the word at point or active region with different opening/closing strings. +The opening and closing strings are read from the minibuffer." + (interactive) + (let ((opening (read-string "Opening: ")) + (closing (read-string "Closing: ")) + (regionp (use-region-p))) + (if regionp + (let ((beg (region-beginning)) + (end (region-end)) + (text (buffer-substring (region-beginning) (region-end)))) + (delete-region beg end) + (goto-char beg) + (insert (cj/--wrap text opening closing))) + (if (thing-at-point 'word) + (let* ((bounds (bounds-of-thing-at-point 'word)) + (text (buffer-substring (car bounds) (cdr bounds)))) + (delete-region (car bounds) (cdr bounds)) + (goto-char (car bounds)) + (insert (cj/--wrap text opening closing))) + (message "Can't wrap. No word at point and no region selected."))))) + +(defun cj/--unwrap (text opening closing) + "Internal implementation: Remove OPENING and CLOSING from TEXT if present. +TEXT is the string to unwrap. +OPENING is checked at the start of TEXT. +CLOSING is checked at the end of TEXT. +Returns the unwrapped text if both delimiters present, otherwise unchanged." + (if (and (string-prefix-p opening text) + (string-suffix-p closing text) + (>= (length text) (+ (length opening) (length closing)))) + (substring text (length opening) (- (length text) (length closing))) + text)) + +(defun cj/unwrap-word-or-region () + "Remove surrounding delimiters from word at point or active region. +The opening and closing strings are read from the minibuffer." + (interactive) + (let ((opening (read-string "Opening to remove: ")) + (closing (read-string "Closing to remove: ")) + (regionp (use-region-p))) + (if regionp + (let ((beg (region-beginning)) + (end (region-end)) + (text (buffer-substring (region-beginning) (region-end)))) + (delete-region beg end) + (goto-char beg) + (insert (cj/--unwrap text opening closing))) + (if (thing-at-point 'word) + (let* ((bounds (bounds-of-thing-at-point 'word)) + (text (buffer-substring (car bounds) (cdr bounds)))) + (delete-region (car bounds) (cdr bounds)) + (goto-char (car bounds)) + (insert (cj/--unwrap text opening closing))) + (message "Can't unwrap. No word at point and no region selected."))))) + +(defun cj/--append-to-lines (text suffix) + "Internal implementation: Append SUFFIX to each line in TEXT. +TEXT is the string containing one or more lines. +SUFFIX is appended to the end of each line. +Returns the transformed string without modifying the buffer." + (let* ((lines (split-string text "\n")) + (has-trailing-newline (string-suffix-p "\n" text)) + ;; If has trailing newline, last element will be empty string - exclude it + (lines-to-process (if (and has-trailing-newline + (not (null lines)) + (string-empty-p (car (last lines)))) + (butlast lines) + lines))) + (concat + (mapconcat (lambda (line) (concat line suffix)) lines-to-process "\n") + (if has-trailing-newline "\n" "")))) (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))))) + (let* ((start-pos (if (use-region-p) + (region-beginning) + (point-min))) + (end-pos (if (use-region-p) + (region-end) + (point-max))) + (text (buffer-substring start-pos end-pos)) + (insertion (cj/--append-to-lines text str))) + (delete-region start-pos end-pos) + (goto-char start-pos) + (insert insertion))) + +(defun cj/--prepend-to-lines (text prefix) + "Internal implementation: Prepend PREFIX to each line in TEXT. +TEXT is the string containing one or more lines. +PREFIX is prepended to the beginning of each line. +Returns the transformed string without modifying the buffer." + (let* ((lines (split-string text "\n")) + (has-trailing-newline (string-suffix-p "\n" text)) + ;; If has trailing newline, last element will be empty string - exclude it + (lines-to-process (if (and has-trailing-newline + (not (null lines)) + (string-empty-p (car (last lines)))) + (butlast lines) + lines))) + (concat + (mapconcat (lambda (line) (concat prefix line)) lines-to-process "\n") + (if has-trailing-newline "\n" "")))) (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 + (let* ((start-pos (if (use-region-p) + (region-beginning) + (point-min))) + (end-pos (if (use-region-p) + (region-end) + (point-max))) + (text (buffer-substring start-pos end-pos)) + (insertion (cj/--prepend-to-lines text str))) + (delete-region start-pos end-pos) + (goto-char start-pos) + (insert insertion))) + +(defun cj/--indent-lines (text count use-tabs) + "Internal implementation: Indent each line in TEXT by COUNT characters. +TEXT is the string containing one or more lines. +COUNT is the number of indentation characters to add. +USE-TABS when non-nil uses tabs instead of spaces for indentation. +Returns the indented text without modifying the buffer." + (let ((indent-string (if use-tabs + (make-string count ?\t) + (make-string count ?\s)))) + (cj/--prepend-to-lines text indent-string))) + +(defun cj/indent-lines-in-region-or-buffer (count use-tabs) + "Indent each line in region or buffer by COUNT characters. +COUNT is the number of characters to indent (default 4). +USE-TABS when non-nil (prefix argument) uses tabs instead of spaces." + (interactive "p\nP") + (let* ((start-pos (if (use-region-p) + (region-beginning) + (point-min))) + (end-pos (if (use-region-p) + (region-end) + (point-max))) + (text (buffer-substring start-pos end-pos)) + (insertion (cj/--indent-lines text count use-tabs))) + (delete-region start-pos end-pos) + (goto-char start-pos) + (insert insertion))) + +(defun cj/--dedent-lines (text count) + "Internal implementation: Remove up to COUNT leading characters from each line. +TEXT is the string containing one or more lines. +COUNT is the maximum number of leading whitespace characters to remove. +Removes spaces and tabs, but only up to COUNT characters per line. +Returns the dedented text without modifying the buffer." + (let* ((lines (split-string text "\n")) + (has-trailing-newline (string-suffix-p "\n" text)) + (lines-to-process (if (and has-trailing-newline + (not (null lines)) + (string-empty-p (car (last lines)))) + (butlast lines) + lines)) + (dedented-lines + (mapcar + (lambda (line) + (let ((removed 0) + (pos 0) + (len (length line))) + (while (and (< removed count) + (< pos len) + (memq (aref line pos) '(?\s ?\t))) + (setq removed (1+ removed)) + (setq pos (1+ pos))) + (substring line pos))) + lines-to-process))) + (concat + (mapconcat #'identity dedented-lines "\n") + (if has-trailing-newline "\n" "")))) + +(defun cj/dedent-lines-in-region-or-buffer (count) + "Remove up to COUNT leading whitespace characters from each line. +COUNT is the number of characters to remove (default 4). +Works on region if active, otherwise entire buffer." + (interactive "p") + (let* ((start-pos (if (use-region-p) + (region-beginning) + (point-min))) + (end-pos (if (use-region-p) + (region-end) + (point-max))) + (text (buffer-substring start-pos end-pos)) + (insertion (cj/--dedent-lines text count))) + (delete-region start-pos end-pos) + (goto-char start-pos) + (insert insertion))) + +;; Text enclosure keymap (defvar-keymap cj/enclose-map - :doc "Keymap for enclosing text: surrounding, appending, and prepending" + :doc "Keymap for text enclosure: wrapping, line manipulation, and indentation" "s" #'cj/surround-word-or-region + "w" #'cj/wrap-word-or-region + "u" #'cj/unwrap-word-or-region "a" #'cj/append-to-lines-in-region-or-buffer - "p" #'cj/prepend-to-lines-in-region-or-buffer) + "p" #'cj/prepend-to-lines-in-region-or-buffer + "i" #'cj/indent-lines-in-region-or-buffer + "d" #'cj/dedent-lines-in-region-or-buffer + "I" #'change-inner + "O" #'change-outer) (keymap-set cj/custom-keymap "s" cj/enclose-map) (with-eval-after-load 'which-key - (which-key-add-key-based-replacements "C-; s" "text enclose menu")) + (which-key-add-key-based-replacements + "C-; s" "text enclose menu" + "C-; s s" "surround text" + "C-; s w" "wrap text" + "C-; s u" "unwrap text" + "C-; s a" "append to lines" + "C-; s p" "prepend to lines" + "C-; s i" "indent lines" + "C-; s d" "dedent lines" + "C-; s I" "change inner" + "C-; s O" "change outer")) (provide 'custom-text-enclose) ;;; custom-text-enclose.el ends here. diff --git a/modules/custom-whitespace.el b/modules/custom-whitespace.el index a69d6138..d5f8d80c 100644 --- a/modules/custom-whitespace.el +++ b/modules/custom-whitespace.el @@ -17,14 +17,32 @@ ;;; Code: +(eval-when-compile (defvar cj/custom-keymap)) ;; cj/custom-keymap defined in keybindings.el ;;; ---------------------- Whitespace Operations And Keymap --------------------- +;; ------------------- Remove Leading/Trailing Whitespace --------------------- + +(defun cj/--remove-leading-trailing-whitespace (start end) + "Internal implementation: Remove leading and trailing whitespace. +START and END define the region to operate on. +Removes leading whitespace (^[ \\t]+) and trailing whitespace ([ \\t]+$). +Preserves interior whitespace." + (when (> start end) + (error "Invalid region: start (%d) is greater than end (%d)" start end)) + (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/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. +- 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)) @@ -33,36 +51,90 @@ When called interactively: (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 "")))))) + (cj/--remove-leading-trailing-whitespace start end))) + +;; ----------------------- Collapse Whitespace --------------------------------- + +(defun cj/--collapse-whitespace (start end) + "Internal implementation: Collapse whitespace to single spaces. +START and END define the region to operate on. +Converts tabs to spaces, removes leading/trailing whitespace, +and collapses multiple spaces to single space. +Preserves newlines and line structure." + (when (> start end) + (error "Invalid region: start (%d) is greater than end (%d)" start end)) + (save-excursion + (save-restriction + (narrow-to-region start 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 (but not newlines) + (goto-char (point-min)) + (while (re-search-forward "^[ \t]+\\|[ \t]+$" nil t) + (replace-match "" nil nil)) + ;; Ensure only one space between words (but preserve newlines) + (goto-char (point-min)) + (while (re-search-forward "[ \t]\\{2,\\}" nil t) + (replace-match " " nil nil))))) (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." +Ensure there is exactly one space between words and remove leading and +trailing whitespace." (interactive) + (let* ((region-active (use-region-p)) + (beg (if region-active (region-beginning) (line-beginning-position))) + (end (if region-active (region-end) (line-end-position)))) + (cj/--collapse-whitespace beg end))) + +;; --------------------- Ensure Single Blank Line ------------------------------ + +(defun cj/--ensure-single-blank-line (start end) + "Internal implementation: Collapse consecutive blank lines to one. +START and END define the region to operate on. +Replaces runs of 2+ blank lines with exactly one blank line. +A blank line is defined as a line containing only whitespace." + (when (> start end) + (error "Invalid region: start (%d) is greater than end (%d)" start end)) (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)))))) + (save-restriction + (narrow-to-region start end) + (goto-char (point-min)) + ;; Match 2+ consecutive blank lines (lines with only whitespace) + ;; Pattern: Match sequences of blank lines (newline + optional space + newline) + ;; but preserve leading whitespace on the following content line + ;; Match: newline, then 1+ (optional whitespace + newline), capturing the last one + (while (re-search-forward "\n\\(?:[[:space:]]*\n\\)+" nil t) + (replace-match "\n\n"))))) + +(defun cj/ensure-single-blank-line (start end) + "Collapse consecutive blank lines to exactly one blank line. +START and END define the region to operate on. +Operates on the active region when one exists. +Prompt before operating on the whole buffer when no region is selected." + (interactive + (if (use-region-p) + (list (region-beginning) (region-end)) + (if (yes-or-no-p "Ensure single blank lines in entire buffer? ") + (list (point-min) (point-max)) + (user-error "Aborted")))) + (cj/--ensure-single-blank-line start end)) + +;; ------------------------ Delete Blank Lines --------------------------------- + +(defun cj/--delete-blank-lines (start end) + "Internal implementation: Delete blank lines between START and END. +Blank lines are lines containing only whitespace or nothing. +Uses the regexp ^[[:space:]]*$ to match blank lines." + (when (> start end) + (error "Invalid region: start (%d) is greater than end (%d)" start end)) + (save-excursion + (save-restriction + (widen) + ;; Regexp "^[[:space:]]*$" matches lines of zero or more spaces/tabs/newlines. + (flush-lines "^[[:space:]]*$" start end)))) (defun cj/delete-blank-lines-region-or-buffer (start end) "Delete blank lines between START and END. @@ -73,32 +145,62 @@ 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))) + ;; 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")))) + (cj/--delete-blank-lines start end) ;; Return nil (Emacs conventions). Point is already restored. nil) +;; ------------------------- Delete All Whitespace ----------------------------- + +(defun cj/--delete-all-whitespace (start end) + "Internal implementation: Delete all whitespace from region. +START and END define the region to operate on. +Removes all spaces, tabs, newlines, and carriage returns." + (when (> start end) + (error "Invalid region: start (%d) is greater than end (%d)" start end)) + (save-excursion + (save-restriction + (narrow-to-region start end) + (goto-char (point-min)) + (while (re-search-forward "[ \t\n\r]+" nil t) + (replace-match ""))))) + +(defun cj/delete-all-whitespace (start end) + "Delete all whitespace between START and END. +Removes all spaces, tabs, newlines, and carriage returns. +Operates on the active region." + (interactive "*r") + (if (use-region-p) + (cj/--delete-all-whitespace start end) + (message "No region; nothing to delete."))) + +;; ------------------------- Hyphenate Whitespace ------------------------------ + +(defun cj/--hyphenate-whitespace (start end) + "Internal implementation: Replace whitespace runs with hyphens. +START and END define the region to operate on. +Replaces all runs of spaces, tabs, newlines, and carriage returns with hyphens." + (when (> start end) + (error "Invalid region: start (%d) is greater than end (%d)" start end)) + (save-excursion + (save-restriction + (narrow-to-region start end) + (goto-char (point-min)) + (while (re-search-forward "[ \t\n\r]+" nil t) + (replace-match "-"))))) + (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."))) + (cj/--hyphenate-whitespace start end) + (message "No region; nothing to hyphenate."))) ;; Whitespace operations prefix and keymap @@ -107,11 +209,23 @@ Operate on the active region designated by START and END." "r" #'cj/remove-leading-trailing-whitespace "c" #'cj/collapse-whitespace-line-or-region "l" #'cj/delete-blank-lines-region-or-buffer - "-" #'cj/hyphenate-whitespace-in-region) + "1" #'cj/ensure-single-blank-line + "d" #'cj/delete-all-whitespace + "-" #'cj/hyphenate-whitespace-in-region + "t" #'untabify + "T" #'tabify) (keymap-set cj/custom-keymap "w" cj/whitespace-map) (with-eval-after-load 'which-key - (which-key-add-key-based-replacements "C-; w" "whitespace menu")) + (which-key-add-key-based-replacements + "C-; w" "whitespace menu" + "C-; w c" "collapse whitespace" + "C-; w l" "delete blank lines" + "C-; w 1" "single blank line" + "C-; w d" "delete all whitespace" + "C-; w -" "hyphenate whitespace" + "C-; w t" "untabify" + "C-; w T" "tabify")) (provide 'custom-whitespace) ;;; custom-whitespace.el ends here. diff --git a/modules/dashboard-config.el b/modules/dashboard-config.el index 44e87d5a..918acdf2 100644 --- a/modules/dashboard-config.el +++ b/modules/dashboard-config.el @@ -64,7 +64,7 @@ ;; a useful startup screen for Emacs (use-package dashboard - :defer t + :demand t :hook (emacs-startup . cj/dashboard-only) :bind ("<f1>" . cj/dashboard-only) :custom @@ -75,7 +75,7 @@ (bookmarks . dashboard-insert-bookmarks))) (dashboard-items '((projects . 5) - (bookmarks . 15))) + (bookmarks . 10))) (dashboard-startupify-list '(dashboard-insert-banner @@ -83,7 +83,7 @@ dashboard-insert-newline dashboard-insert-newline dashboard-insert-navigator - dashboard-insert-init-info + ;; dashboard-insert-init-info ; Disabled: package count and startup time dashboard-insert-newline dashboard-insert-newline dashboard-insert-items @@ -109,37 +109,78 @@ ;; == navigation (setq dashboard-set-navigator t) (setq dashboard-navigator-buttons - `(((,(nerd-icons-faicon "nf-fa-envelope") + `(;; Row 1 + ((,(nerd-icons-faicon "nf-fa-code") + "Code" "Switch Project" + (lambda (&rest _) (projectile-switch-project)) + nil " " "") + + (,(nerd-icons-faicon "nf-fa-envelope") "Email" "Mu4e Email Client" - (lambda (&rest _) (mu4e))) + (lambda (&rest _) (mu4e)) + nil " " "") - (,(nerd-icons-faicon "nf-fae-book_open_o") - "Ebooks" "Calibre Ebook Reader" - (lambda (&rest _) (calibredb))) + (,(nerd-icons-mdicon "nf-md-calendar") + "Agenda" "Main Org Agenda" + (lambda (&rest _) (cj/main-agenda-display)) + nil " " "") (,(nerd-icons-mdicon "nf-md-school") "Flashcards" "Org-Drill" - (lambda (&rest _) (cj/drill-start))) + (lambda (&rest _) (cj/drill-start)) + nil " " "") + + (,(nerd-icons-faicon "nf-fae-book_open_o") + "Books" "Calibre Ebook Reader" + (lambda (&rest _) (calibredb)) + nil " " "")) - (,(nerd-icons-faicon "nf-fa-rss_square") - "Feeds" "Elfeed Feed Reader" - (lambda (&rest _) (cj/elfeed-open))) + ;; Row 2 + ((,(nerd-icons-faicon "nf-fa-rss_square") + "RSS/Feeds" "Elfeed Feed Reader" + (lambda (&rest _) (cj/elfeed-open)) + nil " " "") (,(nerd-icons-faicon "nf-fa-comments") "IRC" "Emacs Relay Chat" - (lambda (&rest _) (cj/erc-switch-to-buffer-with-completion))) + (lambda (&rest _) (cj/erc-switch-to-buffer-with-completion)) + nil " " "") + + (,(nerd-icons-devicon "nf-dev-terminal") + "Terminal" "Launch VTerm" + (lambda (&rest _) (vterm)) + nil " " "") ;; (,(nerd-icons-faicon "nf-fae-telegram") ;; "Telegram" "Telega Chat Client" - ;; (lambda (&rest _) (telega))) + ;; (lambda (&rest _) (telega)) + ;; nil " " "") (,(nerd-icons-faicon "nf-fa-folder_o") - "Files" "Dirvish File Manager" - (lambda (&rest _) (dirvish user-home-dir)))))) + "Directory/Files" "Dirvish File Manager" + (lambda (&rest _) (dirvish user-home-dir)) + nil " " "")))) ;; == content (setq dashboard-show-shortcuts nil) ;; don't show dashboard item abbreviations ) ;; end use-package dashboard +;; ------------------------ Dashboard Keybindings ------------------------------ + +(with-eval-after-load 'dashboard + ;; Disable 'q' to quit dashboard + (define-key dashboard-mode-map (kbd "q") nil) + + ;; Dashboard launcher keybindings + (define-key dashboard-mode-map (kbd "e") (lambda () (interactive) (mu4e))) + (define-key dashboard-mode-map (kbd "c") (lambda () (interactive) (projectile-switch-project))) + (define-key dashboard-mode-map (kbd "a") (lambda () (interactive) (cj/main-agenda-display))) + (define-key dashboard-mode-map (kbd "b") (lambda () (interactive) (calibredb))) + (define-key dashboard-mode-map (kbd "f") (lambda () (interactive) (cj/drill-start))) + (define-key dashboard-mode-map (kbd "r") (lambda () (interactive) (cj/elfeed-open))) + (define-key dashboard-mode-map (kbd "i") (lambda () (interactive) (cj/erc-switch-to-buffer-with-completion))) + (define-key dashboard-mode-map (kbd "t") (lambda () (interactive) (vterm))) + (define-key dashboard-mode-map (kbd "d") (lambda () (interactive) (dirvish user-home-dir)))) + (provide 'dashboard-config) ;;; dashboard-config.el ends here. diff --git a/modules/diff-config.el b/modules/diff-config.el index 382b2250..45c2a778 100644 --- a/modules/diff-config.el +++ b/modules/diff-config.el @@ -48,6 +48,14 @@ (add-hook 'ediff-mode-hook #'cj/ediff-hook) (add-hook 'ediff-after-quit-hook-internal #'winner-undo)) +;; which-key labels +(with-eval-after-load 'which-key + (which-key-add-key-based-replacements + "C-c D" "ediff menu" + "C-c D f" "ediff files" + "C-c D b" "ediff buffers" + "C-c D r" "ediff revision" + "C-c D D" "ediff directories")) (provide 'diff-config) ;;; diff-config.el ends here diff --git a/modules/dirvish-config.el b/modules/dirvish-config.el index e35cc528..5577b9f1 100644 --- a/modules/dirvish-config.el +++ b/modules/dirvish-config.el @@ -8,13 +8,16 @@ ;; ediff, playlist creation, path copying, and external file manager integration. ;; ;; Key Bindings: +;; - d: Delete marked files (dired-do-delete) +;; - D: Duplicate file at point (adds "-copy" before extension) ;; - g: Quick access menu (jump to predefined directories) +;; - G: Search with deadgrep in current directory ;; - f: Open system file manager in current directory ;; - o/O: Open file with xdg-open/custom command -;; - l: Copy file path (project-relative or home-relative) -;; - L: Copy absolute file path -;; - P: Create M3U playlist from marked audio files -;; - M-D: DWIM menu (context actions for files) +;; - l: Copy org-link with relative file path (project-relative or home-relative) +;; - p: Copy absolute file path +;; - P: Copy relative file path (project-relative or home-relative) +;; - M-S-d (Meta-Shift-d): DWIM shell commands menu ;; - TAB: Toggle subtree expansion ;; - F11: Toggle sidebar view @@ -23,6 +26,9 @@ (eval-when-compile (require 'user-constants)) (eval-when-compile (require 'system-utils)) +;; mark files in dirvish, attach in mu4e +(add-hook 'dired-mode-hook 'turn-on-gnus-dired-mode) + ;;; ----------------------------- Dired Ediff Files ----------------------------- (defun cj/dired-ediff-files () @@ -114,9 +120,9 @@ Filters for audio files, prompts for the playlist name, and saves the resulting (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 + (setq dired-clean-confirm-killing-deleted-buffers nil) ;; 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 @@ -145,6 +151,36 @@ Filters for audio files, prompts for the playlist name, and saves the resulting (dired-mark 1)) (forward-line 1)))) +;;; ------------------------ Dirvish Duplicate File Copy ------------------------ + +(defun cj/dirvish-duplicate-file () + "Duplicate the file at point with '-copy' suffix before the extension. +Examples: + report.pdf → report-copy.pdf + script.el → script-copy.el + README → README-copy" + (interactive) + (let* ((file (dired-get-filename nil t)) + (dir (file-name-directory file)) + (base (file-name-base file)) + (ext (file-name-extension file t)) ; includes the dot + (new-name (concat base "-copy" ext)) + (new-path (expand-file-name new-name dir))) + (unless file + (user-error "No file at point")) + (when (file-directory-p file) + (user-error "Cannot duplicate directories, only files")) + + ;; Check if target already exists + (when (file-exists-p new-path) + (unless (y-or-n-p (format "File '%s' already exists. Overwrite? " new-name)) + (user-error "Cancelled"))) + + ;; Copy the file + (copy-file file new-path t) + (revert-buffer) + (message "Duplicated: %s → %s" (file-name-nondirectory file) new-name))) + ;;; ----------------------- Dirvish Open File Manager Here ---------------------- (defun cj/dirvish-open-file-manager-here () @@ -193,12 +229,14 @@ regardless of what file or subdirectory the point is on." ("dr" ,(concat org-dir "/drill/") "drill files") ("dt" ,(concat dl-dir "/torrents/complete/") "torrents") ("dx" "~/documents/" "documents") + ("db" "~/documents/dropbox/" "dropbox") ("gd" "~/documents/google-drive/" "google-drive") - ("lx" "~/lectures/" "lectures") + ("lx" "~/archive/lectures/" "lectures") ("mb" "/media/backup/" "backup directory") ("mx" "~/music/" "music") - ("pD" "~/projects/documents/" "project documents") - ("pd" "~/projects/danneel/" "project danneel") + ("pdx" "~/projects/documents/" "project documents") + ("pdl" "~/projects/danneel/" "project danneel") + ("pc" "~/projects/clipper/" "project clipper") ("pl" "~/projects/elibrary/" "project elibrary") ("pf" "~/projects/finances/" "project finances") ("pjr" "~/projects/jr-estate/" "project jr-estate") @@ -211,8 +249,8 @@ regardless of what file or subdirectory the point is on." ("sx" ,sync-dir "sync directory") ("so" ,(concat sync-dir "/org/") "sync/org directory") ("sr" ,(concat sync-dir "/recordings/") "sync/recordings directory") - ("sv" ,(concat sync-dir "/videos/") "sync/videos directory") - ("tg" ,(concat sync-dir "/text.games/") "text games") + ("spv" ,(concat sync-dir "/phone/videos/") "sync/phone/videos directory") + ("tg" ,(concat org-dir "/text.games/") "text games") ("vr" ,video-recordings-dir "video recordings directory") ("vx" ,videos-dir "videos"))) :config @@ -276,9 +314,8 @@ regardless of what file or subdirectory the point is on." ("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 - ("L" . (lambda () (interactive) (cj/dired-copy-path-as-kill nil t))) ;; copy absolute path ("h" . cj/dirvish-open-html-in-eww) ;; it does what it says it does + ("l" . (lambda () (interactive) (cj/dired-copy-path-as-kill t nil))) ;; copy as org-link, relative path ("M" . cj/dired-mark-all-visible-files) ("M-e" . dirvish-emerge-menu) ("M-l" . dirvish-ls-switches-menu) @@ -286,13 +323,15 @@ regardless of what file or subdirectory the point is on." ("M-p" . dirvish-peek-toggle) ("M-s" . dirvish-setup-menu) ("TAB" . dirvish-subtree-toggle) - ("d" . dired-flag-file-deletion) + ("d" . dired-do-delete) + ("D" . cj/dirvish-duplicate-file) ("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 + ("p" . (lambda () (interactive) (cj/dired-copy-path-as-kill nil t))) + ("P" . (lambda () (interactive) (cj/dired-copy-path-as-kill))) ("r" . dirvish-rsync) - ("P" . cj/dired-create-playlist-from-marked) ("s" . dirvish-quicksort) ("v" . dirvish-vc-menu) ("y" . dirvish-yank-menu))) @@ -390,5 +429,6 @@ Returns nil if not in a project." (t nil))) + (provide 'dirvish-config) ;;; dirvish-config.el ends here. diff --git a/modules/dwim-shell-config.el b/modules/dwim-shell-config.el index a05646b2..1881f791 100644 --- a/modules/dwim-shell-config.el +++ b/modules/dwim-shell-config.el @@ -90,16 +90,10 @@ (require 'cl-lib) - -;; Bind menu to dired (after dwim-shell-command loads) -(with-eval-after-load 'dwim-shell-command - (with-eval-after-load 'dired - (keymap-set dired-mode-map "M-D" #'dwim-shell-commands-menu))) - ;; ----------------------------- Dwim Shell Command ---------------------------- (use-package dwim-shell-command - :after (dired dirvish) + :demand t :bind (("<remap> <shell-command>" . dwim-shell-command) :map dired-mode-map ("<remap> <dired-do-async-shell-command>" . dwim-shell-command) @@ -606,10 +600,14 @@ in process lists or command history." (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 '<<f>>' -vn -acodec copy '<<fne>>.m4a'" - :utils "ffmpeg")) + (let ((bitrate (completing-read "Audio bitrate: " + '("64k" "96k" "128k" "192k") + nil t))) + (dwim-shell-command-on-marked-files + "Extract audio" + (format "ffmpeg -i '<<f>>' -vn -c:a aac -b:a %s '<<fne>>.m4a'" bitrate) + :utils "ffmpeg" + :extensions '("mp4" "mkv" "webm" "avi" "mov" "flv" "wmv" "m4v" "mpg" "mpeg" "ogv" "3gp" "ts")))) (defun cj/dwim-shell-commands-normalize-audio-volume () "Normalize audio volume in file(s)." @@ -809,7 +807,13 @@ gpg: decryption failed: No pinentry" 'dwim-shell-command-history)) (command (alist-get selected command-alist nil nil #'string=))) (when command - (call-interactively command))))) + (call-interactively command)))) + + ;; Bind menu to keymaps after function is defined + (with-eval-after-load 'dired + (keymap-set dired-mode-map "M-D" #'dwim-shell-commands-menu)) + (with-eval-after-load 'dirvish + (keymap-set dirvish-mode-map "M-D" #'dwim-shell-commands-menu))) (provide 'dwim-shell-config) ;;; dwim-shell-config.el ends here. diff --git a/modules/elfeed-config.el b/modules/elfeed-config.el index 46520be2..52c5b8f1 100644 --- a/modules/elfeed-config.el +++ b/modules/elfeed-config.el @@ -15,7 +15,7 @@ ;;; Code: (require 'user-constants) -(require 'system-utils) +(require 'system-lib) (require 'media-utils) ;; ------------------------------- Elfeed Config ------------------------------- diff --git a/modules/erc-config.el b/modules/erc-config.el index 1c189fa3..e7efb33f 100644 --- a/modules/erc-config.el +++ b/modules/erc-config.el @@ -183,7 +183,14 @@ Auto-adds # prefix if missing. Offers completion from configured channels." (keymap-set cj/custom-keymap "E" cj/erc-keymap) (with-eval-after-load 'which-key - (which-key-add-key-based-replacements "C-; E" "ERC chat menu")) + (which-key-add-key-based-replacements + "C-; E" "ERC chat menu" + "C-; E C" "connect server" + "C-; E c" "join channel" + "C-; E b" "switch buffer" + "C-; E l" "list servers" + "C-; E q" "quit channel" + "C-; E Q" "quit server")) ;; Main ERC configuration (use-package erc diff --git a/modules/eshell-vterm-config.el b/modules/eshell-vterm-config.el index 4f2d14df..5799c7c3 100644 --- a/modules/eshell-vterm-config.el +++ b/modules/eshell-vterm-config.el @@ -47,6 +47,9 @@ (setq eshell-prefer-lisp-functions nil) (setq eshell-destroy-buffer-when-process-dies t) + ;; no pagers required + (setenv "PAGER" "cat") + (setq eshell-prompt-function (lambda () (concat @@ -54,7 +57,7 @@ " " (propertize (user-login-name) 'face '(:foreground "gray")) " " - (propertize (system-name) 'face '(:foreground "gray")) + (propertize (system-name) 'face '(:foreground "gray")) ":" (propertize (abbreviate-file-name (eshell/pwd)) 'face '(:foreground "gray")) "\n" @@ -81,7 +84,6 @@ (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") @@ -111,7 +113,13 @@ (find-file (car files)) ;; Multiple files (dolist (file files) - (find-file file)))) + (find-file file)))) + +(defun eshell/clear () + "Clear the eshell buffer." + (let ((inhibit-read-only t)) + (erase-buffer) + (eshell-send-input))) (defun eshell/find-using-dired (file-pattern) "Find a file FILE-PATTERN' using 'find-name-dired'." @@ -125,7 +133,6 @@ (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 2) (eshell-toggle-run-command nil) diff --git a/modules/external-open.el b/modules/external-open.el index 41d842fb..8c4db810 100644 --- a/modules/external-open.el +++ b/modules/external-open.el @@ -111,6 +111,11 @@ (keymap-global-set "C-c x o" #'cj/open-this-file-with) +(with-eval-after-load 'which-key + (which-key-add-key-based-replacements + "C-c x" "external open menu" + "C-c x o" "open file with")) + ;; -------------------- Open Files With Default File Handler ------------------- (defun cj/find-file-auto (orig-fun &rest args) diff --git a/modules/flycheck-config.el b/modules/flycheck-config.el index d7f1ad39..e2e8abe9 100644 --- a/modules/flycheck-config.el +++ b/modules/flycheck-config.el @@ -6,30 +6,30 @@ ;; 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-; ?” +;; - 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 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). +;; - It registers LanguageTool for comprehensive grammar checking of prose files +;; (text-mode, markdown-mode, gfm-mode, org-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. +;; Note: Grammar checking is on-demand only to avoid performance issues. +;; Hitting "C-; ?" 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. +;; - Enables LanguageTool checker +;; - Triggers an immediate check +;; - Displays errors in the *Flycheck errors* buffer -;; OS Dependencies: -;; proselint (in the Arch AUR) +;; Installation: +;; On Arch Linux: +;; sudo pacman -S languagetool +;; +;; The wrapper script at scripts/languagetool-flycheck formats LanguageTool's +;; JSON output into flycheck-compatible format. It requires Python 3. ;;; Code: @@ -62,20 +62,20 @@ ;; 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) + ;; Define LanguageTool checker for comprehensive grammar checking + (flycheck-define-checker languagetool + "A grammar checker using LanguageTool. +Uses a wrapper script to format output for flycheck." + :command ("~/.emacs.d/scripts/languagetool-flycheck" + 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) + (add-to-list 'flycheck-checkers 'languagetool) (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) @@ -85,14 +85,19 @@ Runs flycheck-prose-on-demand if in an org-buffer." (switch-to-buffer-other-window "*Flycheck errors*")) (defun cj/flycheck-prose-on-demand () - "Enable Flycheck+Proselint in this buffer, run it, and show errors." + "Enable Flycheck with LanguageTool 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) + ;; ensure LanguageTool is valid for current mode + (flycheck-add-mode 'languagetool major-mode) + ;; select LanguageTool as the checker + (setq-local flycheck-checker 'languagetool) ;; trigger immediate check (flycheck-buffer))) +(with-eval-after-load 'which-key + (which-key-add-key-based-replacements "C-; ?" "list errors")) + (provide 'flycheck-config) ;;; flycheck-config.el ends here diff --git a/modules/flyspell-and-abbrev.el b/modules/flyspell-and-abbrev.el index 12e0d348..e29ad6e9 100644 --- a/modules/flyspell-and-abbrev.el +++ b/modules/flyspell-and-abbrev.el @@ -111,7 +111,6 @@ ;; ------------------------------ Flyspell Toggle ------------------------------ ;; easy toggling flyspell and also leverage the 'for-buffer-type' functionality. -;;;###autoload (defun cj/flyspell-toggle () "Turn Flyspell on if it is off, or off if it is on. @@ -198,7 +197,6 @@ buffer." (downcase misspelled-word) nil))) -;;;###autoload (defun cj/flyspell-then-abbrev (p) "Find and correct the previous misspelled word, creating an abbrev. @@ -236,10 +234,21 @@ Press C-' repeatedly to step through misspellings one at a time." ;; -------------------------------- Keybindings -------------------------------- ;; Global keybindings for spell checking commands -;; With autoload cookies, these will lazy-load the file when pressed -;;;###autoload (keymap-set global-map "C-c f" #'cj/flyspell-toggle) -;;;###autoload (keymap-set global-map "C-'" #'cj/flyspell-then-abbrev) +;; Set global keybindings +(keymap-set global-map "C-c f" #'cj/flyspell-toggle) +(keymap-set global-map "C-'" #'cj/flyspell-then-abbrev) + +;; Override org-mode's C-' binding (org-cycle-agenda-files) +;; Org-mode binds C-' globally, but we want our spell check binding instead +(with-eval-after-load 'org + (keymap-set org-mode-map "C-'" #'cj/flyspell-then-abbrev)) + +;; which-key labels +(with-eval-after-load 'which-key + (which-key-add-key-based-replacements + "C-c f" "flyspell toggle" + "C-'" "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 index 1541f55f..25026efc 100644 --- a/modules/font-config.el +++ b/modules/font-config.el @@ -53,26 +53,33 @@ (setq fontaine-presets '( (default - :default-family "FiraCode Nerd Font Mono" + :default-family "Berkeley 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-family "Lexend" + :variable-pitch-weight regular :variable-pitch-height 1.0) + (FiraCode + :default-family "FiraCode Nerd Font Mono" + :variable-pitch-family "Merriweather" + :variable-pitch-weight light) (Hack :default-family "Hack Nerd Font Mono" :variable-pitch-family "Hack Nerd Font Mono") + (BerkeleyMono + :default-family "Berkeley Mono" + :variable-pitch-family "Charis SIL") (FiraCode-Literata :default-family "Fira Code Nerd Font" :variable-pitch-family "Literata") (EBook - :default-family "Merriweather" + :default-family "Lexend" :default-weight regular :default-height 200 - :variable-pitch-family "Merriweather") + :variable-pitch-family "Lexend") (24-point-font :default-height 240) (20-point-font @@ -142,7 +149,6 @@ If FRAME is nil, uses the selected 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)) @@ -224,7 +230,6 @@ If FRAME is nil, uses the selected frame." ;; -------------------------- 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) @@ -286,5 +291,12 @@ If FRAME is nil, uses the selected frame." "<~" "<~~" "</" "</>" "~@" "~-" "~>" "~~" "~~>" "%%")) (global-ligature-mode t)) +;; which-key labels +(with-eval-after-load 'which-key + (which-key-add-key-based-replacements + "C-c E" "emojify menu" + "C-c E i" "insert emoji" + "C-c E l" "list emojis")) + (provide 'font-config) ;;; font-config.el ends here diff --git a/modules/host-environment.el b/modules/host-environment.el index 6900a8df..3cec5df1 100644 --- a/modules/host-environment.el +++ b/modules/host-environment.el @@ -112,7 +112,7 @@ Tries multiple methods in order of reliability: (when (string-match ".*/zoneinfo/\\(.+\\)" target) (match-string 1 target)))) - ;; Default to nil - lets org-gcal use its default + ;; Default to nil if detection fails nil)) (provide 'host-environment) diff --git a/modules/jumper.el b/modules/jumper.el index e1025472..67d930aa 100644 --- a/modules/jumper.el +++ b/modules/jumper.el @@ -10,24 +10,76 @@ ;; Jumper provides a simple way to store and jump between locations ;; in your codebase without needing to remember register assignments. +;; +;; PURPOSE: +;; +;; When working on large codebases, you often need to jump between +;; multiple related locations: a function definition, its tests, its +;; callers, configuration files, etc. Emacs registers are perfect for +;; this, but require you to remember which register you assigned to +;; which location. Jumper automates register management, letting you +;; focus on your work instead of bookkeeping. +;; +;; WORKFLOW: +;; +;; 1. Navigate to an important location in your code +;; 2. Press M-SPC SPC to store it (automatically assigned to register 0) +;; 3. Continue working, storing more locations as needed (registers 1-9) +;; 4. Press M-SPC j to jump back to any stored location +;; 5. Select from the list using completion (shows file, line, context) +;; 6. Press M-SPC d to remove locations you no longer need +;; +;; RECOMMENDED USAGE: +;; +;; Store locations temporarily while working on a feature: +;; - Store the main function you're implementing +;; - Store the test file where you're writing tests +;; - Store the caller that needs updating +;; - Store the documentation that needs changes +;; - Jump between them freely as you work +;; - Clear them when done with the feature +;; +;; SPECIAL BEHAVIORS: +;; +;; - Duplicate prevention: Storing the same location twice shows a message +;; instead of wasting a register slot. +;; +;; - Single location toggle: When only one location is stored, M-SPC j +;; toggles between that location and your current position. Perfect for +;; rapid back-and-forth between two related files. +;; +;; - Last location tracking: The last position before each jump is saved +;; in register 'z', allowing quick "undo" of navigation. +;; +;; - Smart selection: With multiple locations, completing-read shows +;; helpful context: "[0] filename.el:42 - function definition..." +;; +;; KEYBINDINGS: +;; +;; M-SPC SPC Store current location in next available register +;; M-SPC j Jump to a stored location (with completion) +;; M-SPC d Delete a stored location from the list +;; +;; CONFIGURATION: +;; +;; You can customize the prefix key and maximum locations: +;; +;; (setq jumper-prefix-key "C-c j") ; Change prefix key +;; (setq jumper-max-locations 20) ; Store up to 20 locations +;; +;; Note: Changing jumper-max-locations requires restarting Emacs or +;; manually reinitializing jumper--registers. ;;; Code: -(defgroup jumper nil - "Quick navigation between stored locations." - :group 'convenience) +(require 'cl-lib) -(defcustom jumper-prefix-key "M-SPC" +(defvar jumper-prefix-key "M-SPC" "Prefix key for jumper commands. +Note that using M-SPC will override the default binding to just-one-space.") -Note that using M-SPC will override the default binding to just-one-space." - :type 'string - :group 'jumper) - -(defcustom jumper-max-locations 10 - "Maximum number of locations to store." - :type 'integer - :group 'jumper) +(defvar jumper-max-locations 10 + "Maximum number of locations to store.") ;; Internal variables (defvar jumper--registers (make-vector jumper-max-locations nil) @@ -50,12 +102,10 @@ Note that using M-SPC will override the default binding to just-one-space." "Check if current location is already stored." (let ((key (jumper--location-key)) (found nil)) - (dotimes (i - jumper--next-index found) + (dotimes (i jumper--next-index found) (let* ((reg (aref jumper--registers i)) - (pos (get-register reg)) - (marker (and pos (registerv-data pos)))) - (when marker + (marker (get-register reg))) + (when (and marker (markerp marker)) (save-current-buffer (set-buffer (marker-buffer marker)) (save-excursion @@ -70,9 +120,8 @@ Note that using M-SPC will override the default binding to just-one-space." (defun jumper--format-location (index) "Format location at INDEX for display." (let* ((reg (aref jumper--registers index)) - (pos (get-register reg)) - (marker (and pos (registerv-data pos)))) - (when marker + (marker (get-register reg))) + (when (and marker (markerp marker)) (save-current-buffer (set-buffer (marker-buffer marker)) (save-excursion @@ -86,49 +135,83 @@ Note that using M-SPC will override the default binding to just-one-space." (min (+ (line-beginning-position) 40) (line-end-position))))))))) +(defun jumper--do-store-location () + "Store current location in the next free register. +Returns: \\='already-exists if location is already stored, + \\='no-space if all registers are full, + register character if successfully stored." + (cond + ((jumper--location-exists-p) 'already-exists) + ((not (jumper--register-available-p)) 'no-space) + (t + (let ((reg (+ ?0 jumper--next-index))) + (point-to-register reg) + (aset jumper--registers jumper--next-index reg) + (setq jumper--next-index (1+ jumper--next-index)) + reg)))) + (defun jumper-store-location () "Store current location in the next free register." (interactive) - (if (jumper--location-exists-p) - (message "Location already stored") - (if (jumper--register-available-p) - (let ((reg (+ ?0 jumper--next-index))) - (point-to-register reg) - (aset jumper--registers jumper--next-index reg) - (setq jumper--next-index (1+ jumper--next-index)) - (message "Location stored in register %c" reg)) - (message "Sorry - all jump locations are filled!")))) + (pcase (jumper--do-store-location) + ('already-exists (message "Location already stored")) + ('no-space (message "Sorry - all jump locations are filled!")) + (reg (message "Location stored in register %c" reg)))) + +(defun jumper--do-jump-to-location (target-idx) + "Jump to location at TARGET-IDX. +TARGET-IDX: -1 for last location, 0-9 for stored locations, nil for toggle. +Returns: \\='no-locations if no locations stored, + \\='already-there if at the only location (toggle case), + \\='jumped if successfully jumped." + (cond + ((= jumper--next-index 0) 'no-locations) + ;; Toggle behavior when target-idx is nil and only 1 location + ((and (null target-idx) (= jumper--next-index 1)) + (if (jumper--location-exists-p) + 'already-there + (let ((reg (aref jumper--registers 0))) + (point-to-register jumper--last-location-register) + (jump-to-register reg) + 'jumped))) + ;; Jump to specific target + (t + (if (= target-idx -1) + ;; Jumping to last location - don't overwrite it + (jump-to-register jumper--last-location-register) + ;; Jumping to stored location - save current for "last" + (progn + (point-to-register jumper--last-location-register) + (jump-to-register (aref jumper--registers target-idx)))) + 'jumped))) (defun jumper-jump-to-location () "Jump to a stored location." (interactive) - (if (= jumper--next-index 0) - (message "No locations stored") - (if (= jumper--next-index 1) - ;; Special case for one location - toggle behavior - (let ((reg (aref jumper--registers 0))) - (if (jumper--location-exists-p) - (message "You're already at the stored location") - (point-to-register jumper--last-location-register) - (jump-to-register reg) - (message "Jumped to location"))) - ;; Multiple locations - use completing-read - (let* ((locations - (cl-loop for i from 0 below jumper--next-index - for fmt = (jumper--format-location i) - when fmt collect (cons fmt i))) - ;; Add last location if available - (last-pos (get-register jumper--last-location-register)) - (locations (if last-pos - (cons (cons "[z] Last location" -1) locations) - locations)) - (choice (completing-read "Jump to: " locations nil t)) - (idx (cdr (assoc choice locations)))) - (point-to-register jumper--last-location-register) - (if (= idx -1) - (jump-to-register jumper--last-location-register) - (jump-to-register (aref jumper--registers idx))) - (message "Jumped to location"))))) + (cond + ;; No locations + ((= jumper--next-index 0) + (message "No locations stored")) + ;; Single location - toggle + ((= jumper--next-index 1) + (pcase (jumper--do-jump-to-location nil) + ('already-there (message "You're already at the stored location")) + ('jumped (message "Jumped to location")))) + ;; Multiple locations - prompt user + (t + (let* ((locations + (cl-loop for i from 0 below jumper--next-index + for fmt = (jumper--format-location i) + when fmt collect (cons fmt i))) + ;; Add last location if available + (last-pos (get-register jumper--last-location-register)) + (locations (if last-pos + (cons (cons "[z] Last location" -1) locations) + locations)) + (choice (completing-read "Jump to: " locations nil t)) + (idx (cdr (assoc choice locations)))) + (jumper--do-jump-to-location idx) + (message "Jumped to location"))))) (defun jumper--reorder-registers (removed-idx) "Reorder registers after removing the one at REMOVED-IDX." @@ -139,32 +222,40 @@ Note that using M-SPC will override the default binding to just-one-space." (aset jumper--registers i next-reg)))) (setq jumper--next-index (1- jumper--next-index))) +(defun jumper--do-remove-location (index) + "Remove location at INDEX. +Returns: \\='no-locations if no locations stored, + \\='cancelled if index is -1, + t if successfully removed." + (cond + ((= jumper--next-index 0) 'no-locations) + ((= index -1) 'cancelled) + (t + (jumper--reorder-registers index) + t))) + (defun jumper-remove-location () "Remove a stored location." (interactive) (if (= jumper--next-index 0) - (message "No locations stored") - (let* ((locations - (cl-loop for i from 0 below jumper--next-index - for fmt = (jumper--format-location i) - when fmt collect (cons fmt i))) - (locations (cons (cons "Cancel" -1) locations)) - (choice (completing-read "Remove location: " locations nil t)) - (idx (cdr (assoc choice locations)))) - (if (= idx -1) - (message "Operation cancelled") - (jumper--reorder-registers idx) - (message "Location removed"))))) - -(defvar jumper-map - (let ((map (make-sparse-keymap))) - (define-key map (kbd "SPC") #'jumper-store-location) - (define-key map (kbd "j") #'jumper-jump-to-location) - (define-key map (kbd "d") #'jumper-remove-location) - map) - "Keymap for jumper commands.") - -;;;###autoload + (message "No locations stored") + (let* ((locations + (cl-loop for i from 0 below jumper--next-index + for fmt = (jumper--format-location i) + when fmt collect (cons fmt i))) + (locations (cons (cons "Cancel" -1) locations)) + (choice (completing-read "Remove location: " locations nil t)) + (idx (cdr (assoc choice locations)))) + (pcase (jumper--do-remove-location idx) + ('cancelled (message "Operation cancelled")) + ('t (message "Location removed")))))) + +(defvar-keymap jumper-map + :doc "Keymap for jumper commands" + "SPC" #'jumper-store-location + "j" #'jumper-jump-to-location + "d" #'jumper-remove-location) + (defun jumper-setup-keys () "Setup default keybindings for jumper." (interactive) @@ -173,5 +264,13 @@ Note that using M-SPC will override the default binding to just-one-space." ;; Call jumper-setup-keys when the package is loaded (jumper-setup-keys) +;; which-key integration +(with-eval-after-load 'which-key + (which-key-add-key-based-replacements + "M-SPC" "jumper menu" + "M-SPC SPC" "store location" + "M-SPC j" "jump to location" + "M-SPC d" "remove location")) + (provide 'jumper) ;;; jumper.el ends here. diff --git a/modules/keybindings.el b/modules/keybindings.el index 1f8867ef..1eff621c 100644 --- a/modules/keybindings.el +++ b/modules/keybindings.el @@ -68,12 +68,22 @@ Errors if VAR is unbound, not a non-empty string, or the file does not exist." ;; Bind it under the prefix map. (keymap-set cj/jump-map key fn)))) -;; Bind the prefix globally (user-reserved prefix). -(keymap-global-set "C-c j" cj/jump-map) +;; Bind the prefix to custom keymap +(keymap-set cj/custom-keymap "j" cj/jump-map) -;; nicer prefix label in which-key +;; which-key labels (with-eval-after-load 'which-key - (which-key-add-key-based-replacements "C-c j" "Jump to common files.")) + (which-key-add-key-based-replacements + "C-; j" "jump to files menu" + "C-; j r" "jump to reference" + "C-; j s" "jump to schedule" + "C-; j i" "jump to inbox" + "C-; j c" "jump to contacts" + "C-; j m" "jump to macros" + "C-; j n" "jump to reading notes" + "C-; j w" "jump to webclipped" + "C-; j g" "jump to gcal" + "C-; j I" "jump to emacs init")) ;; ---------------------------- Keybinding Discovery --------------------------- diff --git a/modules/lipsum-generator.el b/modules/lipsum-generator.el index b328b989..11ed8caa 100644 --- a/modules/lipsum-generator.el +++ b/modules/lipsum-generator.el @@ -129,25 +129,21 @@ Defaults to 'liber-primus.txt' in the modules directory." (when candidates (nth (random (length candidates)) candidates)))) -;;;###autoload (defvar cj/lipsum-chain (cj/markov-chain-create) "Global Markov chain for lipsum generation.") -;;;###autoload (defun cj/lipsum-reset () "Reset the global lipsum Markov chain." (interactive) (setq cj/lipsum-chain (cj/markov-chain-create)) (message "cj/lipsum-chain reset.")) -;;;###autoload (defun cj/lipsum-learn-region (beg end) "Learn text from region." (interactive "r") (cj/markov-learn cj/lipsum-chain (buffer-substring-no-properties beg end)) (message "Learned from region.")) -;;;###autoload (defun cj/lipsum-learn-buffer () "Learn from entire buffer." (interactive) @@ -155,7 +151,6 @@ Defaults to 'liber-primus.txt' in the modules directory." (buffer-substring-no-properties (point-min) (point-max))) (message "Learned from buffer.")) -;;;###autoload (defun cj/lipsum-learn-file (file) "Learn from FILE containing plain text." (interactive "fTrain from file: ") @@ -164,12 +159,10 @@ Defaults to 'liber-primus.txt' in the modules directory." (cj/markov-learn cj/lipsum-chain (buffer-string))) (message "Learned from file: %s" file)) -;;;###autoload (defun cj/lipsum (n) "Return N words of lorem ipsum." (cj/markov-generate cj/lipsum-chain n '("Lorem" "ipsum"))) -;;;###autoload (defun cj/lipsum-insert (n) "Insert N words of lorem ipsum at point." (interactive "nNumber of words: ") @@ -181,7 +174,6 @@ Defaults to 'liber-primus.txt' in the modules directory." (defconst cj/lipsum-title-max 8) (defconst cj/lipsum-title-small 3) -;;;###autoload (defun cj/lipsum-title () "Generate a pseudo-Latin title." (interactive) @@ -205,7 +197,6 @@ Defaults to 'liber-primus.txt' in the modules directory." ;;; Paragraphs -;;;###autoload (defun cj/lipsum-paragraphs (count &optional min max) "Insert COUNT paragraphs of lipsum. Each paragraph has a random length between MIN and MAX words. diff --git a/modules/lorem-generator.el b/modules/lorem-optimum.el index 6148dfdc..6ccca55f 100644 --- a/modules/lorem-generator.el +++ b/modules/lorem-optimum.el @@ -1,4 +1,4 @@ -;;; lorem-generator.el --- Fake Latin Text Generator -*- coding: utf-8; lexical-binding: t; -*- +;;; lorem-optimum.el --- Fake Latin Text Generator -*- coding: utf-8; lexical-binding: t; -*- ;; ;; Author: Craig Jennings ;; Version: 0.5 @@ -24,6 +24,19 @@ (require 'cl-lib) +;;; Configuration + +(defvar cj/lipsum-training-file "assets/liber-primus.txt" + "Default training file name (relative to `user-emacs-directory`).") + +(defvar cj/lipsum-default-file + (expand-file-name cj/lipsum-training-file user-emacs-directory) + "Default training file for cj-lipsum. + +This should be a plain UTF-8 text file with hundreds of Latin words +or sentences. By default it points to the file specified in +`cj/lipsum-training-file` relative to `user-emacs-directory`.") + (cl-defstruct (cj/markov-chain (:constructor cj/markov-chain-create)) "An order-two Markov chain." @@ -31,25 +44,45 @@ (keys nil)) (defun cj/markov-tokenize (text) - "Split TEXT into tokens: words and punctuation separately." - (let ((case-fold-search nil)) - (split-string text "\\b" t "[[:space:]\n]+"))) - + "Split TEXT into tokens: words and punctuation separately. +Returns a list of words and punctuation marks as separate tokens." + (let ((tokens '()) + (pos 0) + (len (length text))) + (while (< pos len) + (cond + ;; Skip whitespace + ((string-match-p "[[:space:]]" (substring text pos (1+ pos))) + (setq pos (1+ pos))) + ;; Match word (sequence of alphanumeric characters) + ((string-match "\\`\\([[:alnum:]]+\\)" (substring text pos)) + (let ((word (match-string 1 (substring text pos)))) + (push word tokens) + (setq pos (+ pos (length word))))) + ;; Match punctuation (single character) + ((string-match "\\`\\([[:punct:]]\\)" (substring text pos)) + (let ((punct (match-string 1 (substring text pos)))) + (push punct tokens) + (setq pos (+ pos (length punct))))) + ;; Skip any other character + (t (setq pos (1+ pos))))) + (nreverse tokens))) (defun cj/markov-learn (chain text) "Add TEXT into the Markov CHAIN with tokenized input." - (let* ((words (cj/markov-tokenize text)) + (let* ((word-list (cj/markov-tokenize text)) + ;; Convert to vector for O(1) access instead of O(n) with nth + (words (vconcat word-list)) (len (length words))) (cl-loop for i from 0 to (- len 3) - for a = (nth i words) - for b = (nth (1+ i) words) - for c = (nth (+ i 2) words) + for a = (aref words i) + for b = (aref words (1+ i)) + for c = (aref words (+ i 2)) do (let* ((bigram (list a b)) (nexts (gethash bigram (cj/markov-chain-map chain)))) (puthash bigram (cons c nexts) (cj/markov-chain-map chain))))) - (setf (cj/markov-chain-keys chain) - (cl-loop for k being the hash-keys of (cj/markov-chain-map chain) - collect k))) + ;; Invalidate cached keys after learning new data + (setf (cj/markov-chain-keys chain) nil)) (defun cj/markov-fix-capitalization (sentence) "Capitalize the first word and the first word after .!? in SENTENCE." @@ -94,7 +127,7 @@ (defun cj/markov-generate (chain n &optional start) "Generate a sentence of N tokens from CHAIN." - (when (cj/markov-chain-keys chain) + (when (> (hash-table-count (cj/markov-chain-map chain)) 0) (let* ((state (or (and start (gethash start (cj/markov-chain-map chain)) start) @@ -116,33 +149,37 @@ (cj/markov-join-tokens tokens)))) (defun cj/markov-random-key (chain) - (nth (random (length (cj/markov-chain-keys chain))) - (cj/markov-chain-keys chain))) + "Return a random bigram key from CHAIN. +Builds and caches the keys list lazily if not already cached." + (unless (cj/markov-chain-keys chain) + ;; Lazily build keys list only when needed + (setf (cj/markov-chain-keys chain) + (cl-loop for k being the hash-keys of (cj/markov-chain-map chain) + collect k))) + (let ((keys (cj/markov-chain-keys chain))) + (when keys + (nth (random (length keys)) keys)))) (defun cj/markov-next-word (chain bigram) (let ((candidates (gethash bigram (cj/markov-chain-map chain)))) (when candidates (nth (random (length candidates)) candidates)))) -;;;###autoload (defvar cj/lipsum-chain (cj/markov-chain-create) "Global Markov chain for lipsum generation.") -;;;###autoload (defun cj/lipsum-reset () "Reset the global lipsum Markov chain." (interactive) (setq cj/lipsum-chain (cj/markov-chain-create)) (message "cj/lipsum-chain reset.")) -;;;###autoload (defun cj/lipsum-learn-region (beg end) "Learn text from region." (interactive "r") (cj/markov-learn cj/lipsum-chain (buffer-substring-no-properties beg end)) (message "Learned from region.")) -;;;###autoload (defun cj/lipsum-learn-buffer () "Learn from entire buffer." (interactive) @@ -150,7 +187,6 @@ (buffer-substring-no-properties (point-min) (point-max))) (message "Learned from buffer.")) -;;;###autoload (defun cj/lipsum-learn-file (file) "Learn from FILE containing plain text." (interactive "fTrain from file: ") @@ -159,12 +195,10 @@ (cj/markov-learn cj/lipsum-chain (buffer-string))) (message "Learned from file: %s" file)) -;;;###autoload (defun cj/lipsum (n) "Return N words of lorem ipsum." (cj/markov-generate cj/lipsum-chain n '("Lorem" "ipsum"))) -;;;###autoload (defun cj/lipsum-insert (n) "Insert N words of lorem ipsum at point." (interactive "nNumber of words: ") @@ -176,7 +210,6 @@ (defconst cj/lipsum-title-max 8) (defconst cj/lipsum-title-small 3) -;;;###autoload (defun cj/lipsum-title () "Generate a pseudo-Latin title." (interactive) @@ -190,6 +223,7 @@ (or (cj/markov-next-word cj/lipsum-chain state) (cadr (cj/markov-random-key cj/lipsum-chain)))))) collect (replace-regexp-in-string "^[[:punct:]]+\\|[[:punct:]]+$" "" w)))) + ;; Filter empty strings from generated words (setq words (cl-remove-if #'string-empty-p words)) (mapconcat (lambda (word idx) @@ -200,7 +234,6 @@ ;;; Paragraphs -;;;###autoload (defun cj/lipsum-paragraphs (count &optional min max) "Insert COUNT paragraphs of lipsum. @@ -213,23 +246,6 @@ Defaults: MIN=30, MAX=80." (let ((len (+ min (random (1+ (- max min)))))) (insert (cj/lipsum len) "\n\n"))))) -;;; Customization - -(defgroup cj-lipsum nil - "Pseudo-Latin lorem ipsum text generator." - :prefix "cj/lipsum-" - :group 'text) - -(defcustom cj/lipsum-default-file - (expand-file-name "latin.txt" - (file-name-directory (or load-file-name buffer-file-name))) - "Default training file for cj-lipsum. - -This should be a plain UTF-8 text file with hundreds of Latin words -or sentences. By default it points to the bundled `latin.txt`." - :type 'file - :group 'cj-lipsum) - ;;; Initialization: train on default file (defun cj/lipsum--init () "Initialize cj-lipsum by learning from `cj/lipsum-default-file`." @@ -240,5 +256,5 @@ or sentences. By default it points to the bundled `latin.txt`." (cj/lipsum--init) -(provide 'lorem-generator) -;;; lorem-generator.el ends here. +(provide 'lorem-optimum) +;;; lorem-optimum.el ends here. diff --git a/modules/mail-config.el b/modules/mail-config.el index c65e5342..170711bb 100644 --- a/modules/mail-config.el +++ b/modules/mail-config.el @@ -82,7 +82,10 @@ Prompts user for the action when executing." (setq mu4e-maildir mail-dir) ;; same as above (for newer mu4e) (setq mu4e-sent-messages-behavior 'delete) ;; don't save to "Sent", IMAP does this already (setq mu4e-show-images t) ;; show embedded images - (setq mu4e-update-interval nil) ;; disallow automatic checking for new emails + ;; (setq mu4e-update-interval 600) ;; check for new mail every 10 minutes (600 seconds) + ;; TEMPORARILY DISABLED: Causing password prompts that interrupt work + (setq mu4e-hide-index-messages t) ;; don't show indexing messages buffer + (setq mu4e-headers-from-or-to-prefix '("" . "➜ ")) ;; Format=flowed for better plain text email handling ;; This will be automatically disabled when org-msg is active @@ -283,9 +286,9 @@ Prompts user for the action when executing." ;; user composes org mode; recipient receives html (use-package org-msg - :ensure nil ;; loading locally for fixes + ;; :vc (:url "https://github.com/cjennings/org-msg" :rev :newest) + :load-path "/home/cjennings/code/org-msg" :defer 1 - :load-path "~/code/org-msg/" :after (org mu4e) :preface (defvar-keymap cj/email-map @@ -294,7 +297,10 @@ Prompts user for the action when executing." "d" #'org-msg-attach-delete) (keymap-set cj/custom-keymap "e" cj/email-map) (with-eval-after-load 'which-key - (which-key-add-key-based-replacements "C-; e" "email menu")) + (which-key-add-key-based-replacements + "C-; e" "email menu" + "C-; e a" "attach file" + "C-; e d" "delete attachment")) :bind ;; more intuitive keybinding for attachments (:map org-msg-edit-mode-map @@ -342,5 +348,9 @@ Prompts user for the action when executing." (advice-add #'mu4e-compose-wide-reply :after (lambda (&rest _) (org-msg-edit-mode))) +;; which-key labels +(with-eval-after-load 'which-key + (which-key-add-key-based-replacements "C-c m" "mu4e email")) + (provide 'mail-config) ;;; mail-config.el ends here diff --git a/modules/media-utils.el b/modules/media-utils.el index e4eccb5e..db66a71f 100644 --- a/modules/media-utils.el +++ b/modules/media-utils.el @@ -25,8 +25,9 @@ ;; ;;; Code: -;; Declare functions and variables from other modules -(declare-function cj/log-silently "system-utils" (format-string &rest args)) +(require 'system-lib) + +;; Declare variables from other modules (defvar videos-dir) ;; from user-constants.el ;; ------------------------ Default Media Configurations ----------------------- diff --git a/modules/modeline-config.el b/modules/modeline-config.el index 0a247732..6573671a 100644 --- a/modules/modeline-config.el +++ b/modules/modeline-config.el @@ -3,73 +3,176 @@ ;;; Commentary: -;; Doom modeline configuration with performance optimizations. - -;; Settings prioritize speed while keeping essential information including: -;; - relative file paths from project root -;; - column number and percentage position -;; - buffer modification indicators -;; - and major mode with icon. - -;; Disabled features for performance: -;; - minor modes display -;; - word count -;; - encoding info -;; - LSP information - -;; Performance tuning includes: -;; - 0.75 second refresh rate -;; - 1MB process output chunks -;; - nerd-icons (faster than all-the-icons) -;; - simplified checker format -;; - limited VCS info length +;; Simple, minimal modeline using only built-in Emacs functionality. +;; No external packages = no buffer issues, no native-comp errors. + +;; Features: +;; - Buffer status (modified, read-only) +;; - Buffer name +;; - Major mode +;; - Version control status +;; - Line and column position +;; - Buffer percentage ;;; Code: -;; ------------------------------- Doom Modeline ------------------------------- - -(use-package doom-modeline - :hook (after-init . doom-modeline-mode) - :custom - ;; Performance optimizations - (doom-modeline-buffer-file-name-style 'relative-from-project) ;; Faster than 'file-name - (doom-modeline-icon t) - (doom-modeline-major-mode-icon t) - (doom-modeline-major-mode-color-icon t) - (doom-modeline-buffer-state-icon t) - (doom-modeline-buffer-modification-icon t) - (doom-modeline-unicode-fallback nil) - (doom-modeline-minor-modes nil) ;; Hide minor modes as requested - (doom-modeline-enable-word-count nil) ;; Faster without word count - (doom-modeline-continuous-word-count-modes nil) - (doom-modeline-buffer-encoding nil) ;; Hide encoding for speed - (doom-modeline-indent-info nil) ;; Hide indent info for speed - (doom-modeline-checker-simple-format t) ;; Simpler checker format for speed - (doom-modeline-number-limit 99) ;; Lower number limit for better performance - (doom-modeline-vcs-max-length 12) ;; Limit VCS info length for speed - (doom-modeline-persp-name nil) ;; Disable perspective name for speed - (doom-modeline-display-default-persp-name nil) - (doom-modeline-persp-icon nil) - (doom-modeline-lsp nil) ;; Disable LSP info for speed - - ;; UI Preferences - (doom-modeline-height 25) - (doom-modeline-bar-width 3) - (doom-modeline-window-width-limit 0.25) - (doom-modeline-project-detection 'projectile) ;; Use projectile if available, nil is faster - - ;; Use nerd-icons instead of all-the-icons - (doom-modeline-icon-preference 'nerd-icons) - - ;; Enable elements you specifically requested - (doom-modeline-column-number t) ;; Show column number - (doom-modeline-percent-position t) ;; Show percentage position - (doom-modeline-buffer-name t) ;; Show buffer name - (doom-modeline-buffer-file-name t) ;; Show file name - :config - (setq read-process-output-max (* 1024 1024)) ;; 1MB process read size for better performance - (setq doom-modeline-refresh-rate 0.75)) ;; Update rate in seconds +;; Use buffer status colors from user-constants +(require 'user-constants) + +;; -------------------------- Modeline Configuration -------------------------- + +;; Use Emacs 30's built-in right-alignment +;; Use 'window instead of 'right-margin so centered text modes (nov-mode, etc.) +;; don't push modeline elements inward +(setq mode-line-right-align-edge 'window) + +;; String truncation length for narrow windows +(defcustom cj/modeline-string-truncate-length 12 + "String length after which truncation happens in narrow windows." + :type 'natnum + :group 'modeline) + +;; -------------------------- Helper Functions --------------------------------- + +(defun cj/modeline-window-narrow-p () + "Return non-nil if window is narrow (less than 100 chars wide)." + (< (window-total-width) 100)) + +(defun cj/modeline-string-truncate-p (str) + "Return non-nil if STR should be truncated." + (and (stringp str) + (not (string-empty-p str)) + (cj/modeline-window-narrow-p) + (> (length str) cj/modeline-string-truncate-length) + (not (one-window-p :no-minibuffer)))) + +(defun cj/modeline-string-cut-middle (str) + "Truncate STR in the middle if appropriate, else return STR. +Example: `my-very-long-name.el' → `my-ver...me.el'" + (if (cj/modeline-string-truncate-p str) + (let ((half (floor cj/modeline-string-truncate-length 2))) + (concat (substring str 0 half) "..." (substring str (- half)))) + str)) + +;; -------------------------- Modeline Segments -------------------------------- + +(defvar-local cj/modeline-buffer-name + '(:eval (let* ((state (cond + (buffer-read-only 'read-only) + (overwrite-mode 'overwrite) + ((buffer-modified-p) 'modified) + (t 'unmodified))) + (color (alist-get state cj/buffer-status-colors)) + (name (buffer-name)) + (truncated-name (cj/modeline-string-cut-middle name))) + (propertize truncated-name + 'face `(:foreground ,color) + 'mouse-face 'mode-line-highlight + 'help-echo (concat + name "\n" + (or (buffer-file-name) + (format "No file. Directory: %s" default-directory))) + 'local-map (let ((map (make-sparse-keymap))) + (define-key map [mode-line mouse-1] 'previous-buffer) + (define-key map [mode-line mouse-3] 'next-buffer) + map)))) + "Buffer name colored by modification and read-only status. +White = unmodified, Green = modified, Red = read-only, Gold = overwrite. +Truncates in narrow windows. Click to switch buffers.") + +(defvar-local cj/modeline-position + '("L:" (:eval (format-mode-line "%l")) " C:" (:eval (format-mode-line "%c"))) + "Line and column position as L:line C:col. +Uses built-in cached values for performance.") + +(defvar cj/modeline-vc-faces + '((added . vc-locally-added-state) + (edited . vc-edited-state) + (removed . vc-removed-state) + (missing . vc-missing-state) + (conflict . vc-conflict-state) + (locked . vc-locked-state) + (up-to-date . vc-up-to-date-state)) + "VC state to face mapping.") + +(defvar-local cj/modeline-vc-branch + '(:eval (when (mode-line-window-selected-p) ; Only show in active window + (when-let* ((file (or buffer-file-name default-directory)) + (backend (vc-backend file))) + (when-let* ((branch (vc-working-revision file backend))) + ;; For Git, try to get symbolic branch name + (when (eq backend 'Git) + (require 'vc-git) + (when-let* ((symbolic (vc-git--symbolic-ref file))) + (setq branch symbolic))) + ;; Get VC state for face + (let* ((state (vc-state file backend)) + (face (alist-get state cj/modeline-vc-faces 'vc-up-to-date-state)) + (truncated-branch (cj/modeline-string-cut-middle branch))) + (concat + (propertize (char-to-string #xE0A0) 'face 'shadow) ; Git branch symbol + " " + (propertize truncated-branch + 'face face + 'mouse-face 'mode-line-highlight + 'help-echo (format "Branch: %s\nState: %s\nmouse-1: vc-diff\nmouse-3: vc-root-diff" branch state) + 'local-map (let ((map (make-sparse-keymap))) + (define-key map [mode-line mouse-1] 'vc-diff) + (define-key map [mode-line mouse-3] 'vc-root-diff) + map)))))))) + "Git branch with symbol and colored by VC state. +Shows only in active window. Truncates in narrow windows. +Click to show diffs with `vc-diff' or `vc-root-diff'.") + +(defvar-local cj/modeline-major-mode + '(:eval (let ((mode-str (format-mode-line mode-name)) ; Convert to string + (mode-sym major-mode)) + (propertize mode-str + 'mouse-face 'mode-line-highlight + 'help-echo (if-let* ((parent (get mode-sym 'derived-mode-parent))) + (format "Major mode: %s\nDerived from: %s\nmouse-1: describe-mode" mode-sym parent) + (format "Major mode: %s\nmouse-1: describe-mode" mode-sym)) + 'local-map (let ((map (make-sparse-keymap))) + (define-key map [mode-line mouse-1] 'describe-mode) + map)))) + "Major mode name only (no minor modes). +Click to show help with `describe-mode'.") + +(defvar-local cj/modeline-misc-info + '(:eval (when (mode-line-window-selected-p) + mode-line-misc-info)) + "Misc info (chime notifications, etc). +Shows only in active window.") + +;; -------------------------- Modeline Assembly -------------------------------- + +(setq-default mode-line-format + '("%e" ; Error message if out of memory + ;; LEFT SIDE + " " + cj/modeline-major-mode + " " + cj/modeline-buffer-name + " " + cj/modeline-position + ;; RIGHT SIDE (using Emacs 30 built-in right-align) + ;; Order: leftmost to rightmost as they appear in the list + mode-line-format-right-align + (:eval (when (fboundp 'cj/recording-modeline-indicator) + (cj/recording-modeline-indicator))) + cj/modeline-vc-branch + " " + cj/modeline-misc-info + " ")) +;; Mark all segments as risky-local-variable (required for :eval forms) +(dolist (construct '(cj/modeline-buffer-name + cj/modeline-position + cj/modeline-vc-branch + cj/modeline-vc-faces + cj/modeline-major-mode + cj/modeline-misc-info)) + (put construct 'risky-local-variable t)) (provide 'modeline-config) ;;; modeline-config.el ends here diff --git a/modules/mousetrap-mode.el b/modules/mousetrap-mode.el index fa9ee6dd..7ee91d3b 100644 --- a/modules/mousetrap-mode.el +++ b/modules/mousetrap-mode.el @@ -2,65 +2,211 @@ ;; ;;; Commentary: ;; Mouse Trap Mode is a minor mode for Emacs that disables most mouse and -;; trackpad events to prevent accidental text modifications. Hitting the trackpad and -;; finding my text is being inserted in an unintended place is quite annoying, -;; especially when you're overcaffeinated. +;; trackpad events to prevent accidental text modifications. Hitting the +;; trackpad and finding my text is being inserted in an unintended place is +;; quite annoying, especially when you're overcaffeinated. ;; -;; The mode unbinds almost every mouse event, including clicks, drags, and wheel -;; movements, with various modifiers like Control, Meta, and Shift. +;; The mode uses a profile-based architecture to selectively enable/disable +;; mouse events based on the current major mode. Profiles define which +;; event categories are allowed (scrolling, clicks, drags, etc.), and modes +;; are mapped to profiles. +;; +;; The keymap is built dynamically when the mode is toggled, so you can +;; change profiles or mode mappings and re-enable the mode without reloading +;; your Emacs configuration. ;; ;; Inspired by this blog post from Malabarba ;; https://endlessparentheses.com/disable-mouse-only-inside-emacs.html ;; ;;; Code: +(require 'cl-lib) + ;; ------------------------------ Mouse Trap Mode ------------------------------ -(defvar mouse-trap-mode-map - (let* ((prefixes '("" "C-" "M-" "S-" "C-M-" "C-S-" "M-S-" "C-M-S-")) ; modifiers - (buttons (number-sequence 1 5)) ; mouse-1..5 - (types '("mouse" "down-mouse" "drag-mouse" - "double-mouse" "triple-mouse")) - (wheel '("wheel-up" "wheel-down" "wheel-left" "wheel-right")) - (map (make-sparse-keymap))) - ;; clicks, drags, double, triple - (dolist (type types) - (dolist (pref prefixes) - (dolist (n buttons) - (define-key map (kbd (format "<%s%s-%d>" pref type n)) #'ignore)))) - ;; wheel - (dolist (evt wheel) - (dolist (pref prefixes) - (define-key map (kbd (format "<%s%s>" pref evt)) #'ignore))) - map) - "Keymap for `mouse-trap-mode'. Unbinds almost every mouse event. - -Disabling mouse prevents accidental mouse moves modifying text.") +;;; Event Categories + +(defvar mouse-trap--event-categories + '((primary-click . ((types . ("mouse" "down-mouse")) + (buttons . (1)))) + (secondary-click . ((types . ("mouse" "down-mouse")) + (buttons . (2 3)))) + (drags . ((types . ("drag-mouse")) + (buttons . (1 2 3 4 5)))) + (multi-clicks . ((types . ("double-mouse" "triple-mouse")) + (buttons . (1 2 3 4 5)))) + (scroll . ((wheel . ("wheel-up" "wheel-down" "wheel-left" "wheel-right"))))) + "Event category definitions for mouse-trap-mode. + +Each category maps to a set of event types and buttons (or wheel events). +Categories can be combined in profiles to allow specific interaction patterns.") + +;;; Profiles + +(defvar mouse-trap-profiles + '((disabled . ()) + (scroll-only . (scroll)) + (primary-click . (primary-click)) + (scroll+primary . (scroll primary-click)) + (read-only . (scroll primary-click secondary-click)) + (interactive . (scroll primary-click secondary-click drags)) + (full . (scroll primary-click secondary-click drags multi-clicks))) + "Mouse interaction profiles for different use cases. + +Each profile specifies which event categories are allowed. +Available categories: primary-click, secondary-click, drags, multi-clicks, scroll. + +Profiles: + - disabled: Block all mouse events + - scroll-only: Only allow scrolling + - primary-click: Only allow left click + - scroll+primary: Allow scrolling and left click + - read-only: Scrolling and clicking for reading/browsing + - interactive: Add dragging for text selection + - full: Allow all mouse events") + +(defvar mouse-trap-mode-profiles + '((dashboard-mode . scroll+primary) + (pdf-view-mode . full) + (nov-mode . full)) + "Map major modes to mouse-trap profiles. + +Modes not listed here will use `mouse-trap-default-profile'. +When checking, the mode hierarchy is respected via `derived-mode-p'.") + +(defvar mouse-trap-default-profile 'disabled + "Default profile to use when current major mode is not in `mouse-trap-mode-profiles'.") + +;;; Keymap Builder + +(defun mouse-trap--get-profile-for-mode () + "Return the profile for the current major mode. + +Checks `mouse-trap-mode-profiles' for an exact match with `major-mode', +then checks parent modes via `derived-mode-p'. Falls back to +`mouse-trap-default-profile' if no match." + ;; First check for exact match with current major-mode + (or (alist-get major-mode mouse-trap-mode-profiles) + ;; Then check parent modes + (cl-loop for (mode . profile) in mouse-trap-mode-profiles + when (and (not (eq mode major-mode)) + (derived-mode-p mode)) + return profile) + ;; Finally use default + mouse-trap-default-profile)) + +(defun mouse-trap--build-keymap () + "Build a keymap based on current major mode's profile. + +Returns a keymap that binds mouse events to `ignore' for all events +NOT allowed by the current profile. This function is called each time +the mode is toggled, allowing dynamic behavior without reloading config." + (let* ((profile-name (mouse-trap--get-profile-for-mode)) + (allowed-categories (alist-get profile-name mouse-trap-profiles)) + (prefixes '("" "C-" "M-" "S-" "C-M-" "C-S-" "M-S-" "C-M-S-")) + (map (make-sparse-keymap))) + + ;; For each event category, disable it if not in allowed list + (dolist (category-entry mouse-trap--event-categories) + (let ((category (car category-entry)) + (spec (cdr category-entry))) + (unless (memq category allowed-categories) + ;; This category is NOT allowed - bind its events to ignore + (cond + ;; Scroll events (wheel) + ((alist-get 'wheel spec) + (dolist (evt (alist-get 'wheel spec)) + (dolist (pref prefixes) + (define-key map (kbd (format "<%s%s>" pref evt)) #'ignore)))) + + ;; Click/drag events (types + buttons) + ((and (alist-get 'types spec) (alist-get 'buttons spec)) + (dolist (type (alist-get 'types spec)) + (dolist (button (alist-get 'buttons spec)) + (dolist (pref prefixes) + (define-key map (kbd (format "<%s%s-%d>" pref type button)) #'ignore))))))))) + map)) + +;;; Minor Mode Definition + +(defvar-local mouse-trap-mode-map nil + "Keymap for `mouse-trap-mode'. Built dynamically per buffer.") + +(defvar mouse-trap--lighter-keymap + (let ((map (make-sparse-keymap))) + (define-key map [mode-line mouse-1] + (lambda (event) + (interactive "e") + (with-selected-window (posn-window (event-start event)) + (mouse-trap-mode (if mouse-trap-mode -1 1))))) + map) + "Keymap for the mouse-trap-mode lighter. +Allows clicking the lighter to toggle the mode.") + +(defun mouse-trap--lighter-string () + "Generate the mode-line lighter string for mouse-trap-mode. +Returns a propertized string that shows 🪤 when mode is on, 🐭 when off. +The string is clickable to toggle the mode." + (propertize (if mouse-trap-mode " 🪤" " 🐭") + 'mouse-face 'mode-line-highlight + 'help-echo "mouse-1: Toggle mousetrap mode" + 'local-map mouse-trap--lighter-keymap)) (define-minor-mode mouse-trap-mode - "Buffer-locally disable most mouse and trackpad events. + "Buffer-locally disable mouse and trackpad events based on major mode. + +Mouse-trap-mode uses a profile-based system to selectively enable or +disable mouse events. Each major mode can be mapped to a profile, and +profiles define which event categories are allowed. + +Available event categories: + - primary-click: Left mouse button + - secondary-click: Middle and right mouse buttons + - drags: Drag selections + - multi-clicks: Double and triple clicks + - scroll: Mouse wheel / trackpad scrolling -When active, <mouse-*>, <down-mouse-*>, <drag-mouse-*>, -<double-mouse-*>, <triple-mouse-*>, and wheel events are bound to `ignore', -with or without C-, M-, S- modifiers." - :lighter " 🐭" - :keymap mouse-trap-mode-map - :group 'convenience) +The keymap is built dynamically when the mode is toggled, so you can +change `mouse-trap-mode-profiles' or `mouse-trap-profiles' and re-enable +the mode without reloading your configuration. + +See `mouse-trap-profiles' for available profiles and +`mouse-trap-mode-profiles' for mode mappings." + :lighter nil ; We use mode-line-misc-info instead + :group 'convenience + ;; Build keymap dynamically when mode is activated + (if mouse-trap-mode + (progn + (setq mouse-trap-mode-map (mouse-trap--build-keymap)) + ;; Add dynamic lighter to mode-line-misc-info (always visible) + (unless (member '(:eval (mouse-trap--lighter-string)) mode-line-misc-info) + (push '(:eval (mouse-trap--lighter-string)) mode-line-misc-info))) + ;; When disabling, clear the keymap + (setq mouse-trap-mode-map nil) + ;; Note: We keep the lighter in mode-line-misc-info so it shows 🐭 when disabled + )) (defvar mouse-trap-excluded-modes - '(nov-mode pdf-view-mode dashboard-mode image-mode eww-mode Info-mode dired-mode) - "Major modes where `mouse-trap-mode' should not be enabled.") + '(image-mode eww-mode Info-mode dired-mode) + "Major modes where `mouse-trap-mode' should not be auto-enabled. + +These modes are excluded from automatic activation via hooks, but you +can still manually enable mouse-trap-mode in these buffers if desired.") (defun mouse-trap-maybe-enable () "Enable `mouse-trap-mode' unless in an excluded mode." (unless (apply #'derived-mode-p mouse-trap-excluded-modes) (mouse-trap-mode 1))) -;; Enable in text and prog modes +;; Enable in text, prog, and special modes (add-hook 'text-mode-hook #'mouse-trap-maybe-enable) (add-hook 'prog-mode-hook #'mouse-trap-maybe-enable) +(add-hook 'special-mode-hook #'mouse-trap-maybe-enable) (keymap-global-set "C-c M" #'mouse-trap-mode) +(with-eval-after-load 'which-key + (which-key-add-key-based-replacements "C-c M" "mouse trap mode")) + (provide 'mousetrap-mode) ;;; mousetrap-mode.el ends here. diff --git a/modules/music-config.el b/modules/music-config.el index 90feb7eb..f60ff36a 100644 --- a/modules/music-config.el +++ b/modules/music-config.el @@ -1,8 +1,8 @@ -;;; music-config.el --- EMMS configuration with MPD integration -*- coding: utf-8; lexical-binding: t; -*- +;;; music-config.el --- EMMS configuration with MPV backend -*- coding: utf-8; lexical-binding: t; -*- ;; ;;; Commentary: ;; -;; Comprehensive music management in Emacs via EMMS with MPD backend. +;; Comprehensive music management in Emacs via EMMS with MPV backend. ;; Focus: simple, modular helpers; consistent error handling; streamlined UX. ;; ;; Highlights: @@ -10,17 +10,18 @@ ;; - Recursive directory add ;; - Dired/Dirvish integration (add selection) ;; - M3U playlist save/load/edit/reload -;; - Radio station M3U creation +;; - Radio station M3U creation (streaming URLs supported) ;; - Playlist window toggling -;; - MPD as player +;; - MPV as player (no daemon required) ;; ;;; Code: (require 'subr-x) +(require 'user-constants) ;;; Settings (no Customize) -(defvar cj/music-root (expand-file-name "~/music") +(defvar cj/music-root music-dir "Root directory of your music collection.") (defvar cj/music-m3u-root cj/music-root @@ -44,14 +45,16 @@ (defun cj/music--valid-file-p (file) "Return non-nil if FILE has an accepted music extension (case-insensitive)." - (when-let ((ext (file-name-extension file))) - (member (downcase ext) cj/music-file-extensions))) + (when (and file (stringp file)) + (when-let ((ext (file-name-extension file))) + (member (downcase ext) cj/music-file-extensions)))) (defun cj/music--valid-directory-p (dir) "Return non-nil if DIR is a non-hidden directory." - (and (file-directory-p dir) - (not (string-prefix-p "." (file-name-nondirectory - (directory-file-name dir)))))) + (when (and dir (stringp dir) (not (string-empty-p dir))) + (and (file-directory-p dir) + (not (string-prefix-p "." (file-name-nondirectory + (directory-file-name dir))))))) (defun cj/music--collect-entries-recursive (root) "Return sorted relative paths of all subdirs and music files under ROOT. @@ -105,7 +108,7 @@ Directories are suffixed with /; files are plain. Hidden dirs/files skipped." (let ((line (string-trim (match-string 0)))) (unless (string-empty-p line) (push (if (or (file-name-absolute-p line) - (string-match-p "\`\(https?\|mms\)://" line)) + (string-match-p "\\`\\(https?\\|mms\\)://" line)) line (expand-file-name line dir)) tracks)))) @@ -189,6 +192,64 @@ Directories (trailing /) are added recursively; files added singly." ;;; Commands: playlist management (load/save/clear/reload/edit) +(defun cj/music--append-track-to-m3u-file (track-path m3u-file) + "Append TRACK-PATH to M3U-FILE. Signals error on failure. +Pure function for testing - no user interaction. +TRACK-PATH should be an absolute path. +M3U-FILE should be an existing, writable M3U file path." + (unless (file-exists-p m3u-file) + (error "M3U file does not exist: %s" m3u-file)) + (unless (file-writable-p m3u-file) + (error "M3U file is not writable: %s" m3u-file)) + + ;; Convert absolute path to relative path from music root + (let ((relative-path (if (file-name-absolute-p track-path) + (file-relative-name track-path cj/music-root) + track-path))) + ;; Determine if we need a leading newline + (let ((needs-prefix-newline nil) + (file-size (file-attribute-size (file-attributes m3u-file)))) + (when (> file-size 0) + ;; Read the last character of the file to check if it ends with newline + (with-temp-buffer + (insert-file-contents m3u-file nil (max 0 (1- file-size)) file-size) + (setq needs-prefix-newline (not (= (char-after (point-min)) ?\n))))) + + ;; Append the track with proper newline handling + (with-temp-buffer + (when needs-prefix-newline + (insert "\n")) + (insert relative-path "\n") + (write-region (point-min) (point-max) m3u-file t 0)))) + t) + + +(defun cj/music-append-track-to-playlist () + "Append track at point to a selected M3U playlist file. +Prompts for M3U file selection with completion. Allows cancellation." + (interactive) + (unless (derived-mode-p 'emms-playlist-mode) + (user-error "This command must be run in the EMMS playlist buffer")) + (let ((track (emms-playlist-track-at (point)))) + (unless track + (user-error "No track at point")) + (let* ((track-path (emms-track-name track)) + (m3u-files (cj/music--get-m3u-files))) + (when (null m3u-files) + (user-error "No M3U files found in %s" cj/music-m3u-root)) + (let* ((choices (append (mapcar #'car m3u-files) '("(Cancel)"))) + (choice (completing-read "Append track to playlist: " choices nil t))) + (if (string= choice "(Cancel)") + (message "Cancelled") + (let ((m3u-file (cdr (assoc choice m3u-files)))) + (condition-case err + (progn + (cj/music--append-track-to-m3u-file track-path m3u-file) + (message "Added '%s' to %s" + (file-name-nondirectory track-path) + choice)) + (error (message "Failed to append track: %s" (error-message-string err)))))))))) + (defun cj/music-playlist-load () "Load an M3U playlist from cj/music-m3u-root. @@ -346,9 +407,7 @@ Dirs added recursively." ((file-directory-p file) (cj/music-add-directory-recursive file)) ((cj/music--valid-file-p file) (emms-add-file file)) (t (message "Skipping non-music file: %s" file)))) - (message "Added %d item(s) to playlist" (length files)))) - - (keymap-set dirvish-mode-map "p" #'cj/music-add-dired-selection)) + (message "Added %d item(s) to playlist" (length files))))) ;;; EMMS setup and keybindings @@ -361,12 +420,25 @@ Dirs added recursively." "r" #'cj/music-create-radio-station "SPC" #'emms-pause "s" #'emms-stop - "p" #'emms-playlist-mode-go + "n" #'emms-next + "p" #'emms-previous + "g" #'emms-playlist-mode-go "x" #'emms-shuffle) (keymap-set cj/custom-keymap "m" cj/music-map) (with-eval-after-load 'which-key - (which-key-add-key-based-replacements "C-; m" "music menu")) + (which-key-add-key-based-replacements + "C-; m" "music menu" + "C-; m m" "toggle playlist" + "C-; m M" "show playlist" + "C-; m a" "add music" + "C-; m r" "create radio" + "C-; m SPC" "pause" + "C-; m s" "stop" + "C-; m n" "next track" + "C-; m p" "previous track" + "C-; m g" "goto playlist" + "C-; m x" "shuffle")) (use-package emms :defer t @@ -376,7 +448,7 @@ Dirs added recursively." :commands (emms-mode-line-mode) :config (require 'emms-setup) - (require 'emms-player-mpd) + (require 'emms-player-mpv) (require 'emms-playlist-mode) (require 'emms-source-file) (require 'emms-source-playlist) @@ -385,8 +457,8 @@ Dirs added recursively." (setq emms-source-file-default-directory cj/music-root) (setq emms-playlist-default-major-mode 'emms-playlist-mode) - ;; Use only MPD as player - MUST be set before emms-all - (setq emms-player-list '(emms-player-mpd)) + ;; Use MPV as player - MUST be set before emms-all + (setq emms-player-list '(emms-player-mpv)) ;; Now initialize EMMS (emms-all) @@ -395,22 +467,18 @@ Dirs added recursively." (emms-playing-time-disable-display) (emms-mode-line-mode -1) - ;; MPD configuration - (setq emms-player-mpd-server-name "localhost") - (setq emms-player-mpd-server-port "6600") - (setq emms-player-mpd-music-directory cj/music-root) - (condition-case err - (emms-player-mpd-connect) - (error (message "Failed to connect to MPD: %s" err))) - - ;; note setopt as variable is customizeable - ;; MPD can play both local files and stream URLs - (setopt emms-player-mpd-supported-regexp - (rx (or - ;; Stream URLs - (seq bos (or "http" "https" "mms") "://") - ;; Local music files by extension - (regexp (apply #'emms-player-simple-regexp cj/music-file-extensions))))) + ;; MPV configuration + ;; MPV supports both local files and stream URLs + (setq emms-player-mpv-parameters + '("--quiet" "--no-video" "--audio-display=no")) + + ;; Update supported file types for mpv player + (setq emms-player-mpv-regexp + (rx (or + ;; Stream URLs + (seq bos (or "http" "https" "mms") "://") + ;; Local music files by extension + (seq "." (or "aac" "flac" "m4a" "mp3" "ogg" "opus" "wav") eos)))) ;; Keep cj/music-playlist-file in sync if playlist is cleared (defun cj/music--after-playlist-clear (&rest _) @@ -428,10 +496,15 @@ Dirs added recursively." ("p" . emms-playlist-mode-go) ("SPC" . emms-pause) ("s" . emms-stop) + ("n" . emms-next) + ("P" . emms-previous) + ("f" . emms-seek-forward) + ("b" . emms-seek-backward) ("x" . emms-shuffle) ("q" . emms-playlist-mode-bury-buffer) ("a" . cj/music-fuzzy-select-and-add) ;; Manipulation + ("A" . cj/music-append-track-to-playlist) ("C" . cj/music-playlist-clear) ("L" . cj/music-playlist-load) ("E" . cj/music-playlist-edit) @@ -442,7 +515,7 @@ Dirs added recursively." ("C-<down>" . emms-playlist-mode-shift-track-down) ;; Radio ("r" . cj/music-create-radio-station) - ;; Volume (MPD) + ;; Volume (MPV) ("-" . emms-volume-lower) ("=" . emms-volume-raise))) diff --git a/modules/org-agenda-config-debug.el b/modules/org-agenda-config-debug.el new file mode 100644 index 00000000..a9c713a1 --- /dev/null +++ b/modules/org-agenda-config-debug.el @@ -0,0 +1,63 @@ +;;; org-agenda-config-debug.el --- Debug functions for org-agenda-config -*- lexical-binding: t; coding: utf-8; -*- +;; author: Craig Jennings <c@cjennings.net> +;; +;;; Commentary: +;; +;; This file contains debug functions for org-agenda-config.el. +;; It is only loaded when cj/debug-modules includes 'org-agenda or is t. +;; +;; Enable with: (setq cj/debug-modules '(org-agenda)) +;; or: (setq cj/debug-modules t) +;; +;; Available debug functions: +;; - cj/org-agenda-debug-dump-files - Show all org-agenda-files with status +;; - cj/org-agenda-debug-rebuild-timing - Measure rebuild performance +;; +;;; Code: + +(require 'user-constants) +(require 'system-lib) + +;; ---------------------------- Debug Functions -------------------------------- + +;;;###autoload +(defun cj/org-agenda-debug-dump-files () + "Dump all org-agenda-files to *Messages* buffer with status. +Shows which files exist, which are missing, and their sizes." + (interactive) + (cj/log-silently "=== Org Agenda Debug: Files ===") + (cj/log-silently "Total files: %d" (length org-agenda-files)) + (cj/log-silently "") + (dolist (file org-agenda-files) + (if (file-exists-p file) + (let ((size (file-attribute-size (file-attributes file))) + (mtime (format-time-string "%Y-%m-%d %H:%M:%S" + (file-attribute-modification-time + (file-attributes file))))) + (cj/log-silently "✓ %s" file) + (cj/log-silently " Size: %d bytes, Modified: %s" size mtime)) + (cj/log-silently "✗ %s [MISSING]" file))) + (cj/log-silently "") + (cj/log-silently "=== End Org Agenda Debug ===") + (message "Org Agenda: Dumped %d files to *Messages* buffer" (length org-agenda-files))) + +;;;###autoload +(defun cj/org-agenda-debug-rebuild-timing () + "Measure and report timing for rebuilding org-agenda-files. +Runs cj/build-org-agenda-list and reports detailed timing." + (interactive) + (cj/log-silently "=== Org Agenda Debug: Rebuild Timing ===") + (let ((start-time (current-time))) + (cj/build-org-agenda-list) + (let ((elapsed (float-time (time-subtract (current-time) start-time)))) + (cj/log-silently "Rebuild completed in %.3f seconds" elapsed) + (cj/log-silently "Files found: %d" (length org-agenda-files)) + (cj/log-silently "Average time per file: %.4f seconds" + (if (> (length org-agenda-files) 0) + (/ elapsed (float (length org-agenda-files))) + 0.0)))) + (cj/log-silently "=== End Org Agenda Debug ===") + (message "Org Agenda: Timing info dumped to *Messages* buffer")) + +(provide 'org-agenda-config-debug) +;;; org-agenda-config-debug.el ends here diff --git a/modules/org-agenda-config.el b/modules/org-agenda-config.el index c7aac99b..4be4db9e 100644 --- a/modules/org-agenda-config.el +++ b/modules/org-agenda-config.el @@ -3,6 +3,14 @@ ;; ;;; Commentary: ;; +;; Performance: +;; - Caches agenda file list to avoid scanning projects directory on every view +;; - Cache builds asynchronously 10 seconds after Emacs startup (non-blocking) +;; - First agenda view uses cache if ready, otherwise builds synchronously +;; - Subsequent views are instant (cached) +;; - Cache auto-refreshes after 1 hour +;; - Manual refresh: M-x cj/org-agenda-refresh-files (e.g., after adding projects) +;; ;; Agenda views are tied to the F8 (fate) key. ;; ;; "We are what we repeatedly do. @@ -31,10 +39,20 @@ ;;; Code: (require 'user-constants) +(require 'system-lib) + +;; Load debug functions if enabled +(when (or (eq cj/debug-modules t) + (memq 'org-agenda cj/debug-modules)) + (require 'org-agenda-config-debug + (expand-file-name "org-agenda-config-debug.el" + (file-name-directory load-file-name)) + t)) (use-package org-agenda :ensure nil ;; built-in :after (org) + :demand t :config (setq org-agenda-prefix-format '((agenda . " %i %-25:c%?-12t% s") (timeline . " % s") @@ -57,10 +75,24 @@ (add-hook 'org-agenda-mode-hook (lambda () (local-set-key (kbd "s-<right>") #'org-agenda-todo-nextset) (local-set-key (kbd "s-<left>") - #'org-agenda-todo-previousset))) + #'org-agenda-todo-previousset)))) + +;; ------------------------ Org Agenda File List Cache ------------------------- +;; Cache agenda file list to avoid expensive directory scanning on every view + +(defvar cj/org-agenda-files-cache nil + "Cached agenda files list to avoid expensive directory scanning. +Set to nil to invalidate cache.") + +(defvar cj/org-agenda-files-cache-time nil + "Time when agenda files cache was last built.") + +(defvar cj/org-agenda-files-cache-ttl 3600 + "Time-to-live for agenda files cache in seconds (default: 1 hour).") - ;; build org-agenda-list for the first time after emacs init completes. - (add-hook 'emacs-startup-hook #'cj/build-org-agenda-list)) +(defvar cj/org-agenda-files-building nil + "Non-nil when agenda files are being built asynchronously. +Prevents duplicate builds if user opens agenda before async build completes.") ;; ------------------------ Add Files To Org Agenda List ----------------------- ;; finds files named 'todo.org' (case insensitive) and adds them to @@ -68,7 +100,6 @@ (defun cj/add-files-to-org-agenda-files-list (directory) "Search for files named \\='todo.org\\=' add them to org-project-files. - DIRECTORY is a string of the path to begin the search." (interactive "D") (setq org-agenda-files @@ -77,35 +108,74 @@ DIRECTORY is a string of the path to begin the search." org-agenda-files))) ;; ---------------------------- Rebuild Org Agenda --------------------------- -;; builds the org agenda list from all agenda targets. +;; builds the org agenda list from all agenda targets with caching. ;; agenda targets is the schedule, contacts, project todos, ;; inbox, and org roam projects. -(defun cj/build-org-agenda-list () - "Rebuilds the org agenda list without checking org-roam for projects. - -Begins with the inbox-file, schedule-file, and contacts-file. -Then adds all todo.org files from projects-dir and code-dir. -Reports elapsed time in the messages buffer." +(defun cj/build-org-agenda-list (&optional force-rebuild) + "Build org-agenda-files list with caching. + +When FORCE-REBUILD is non-nil, bypass cache and rebuild from scratch. +Otherwise, returns cached list if available and not expired. + +This function scans projects-dir for todo.org files, so caching +improves performance from several seconds to instant." + (interactive "P") + ;; Check if we can use cache + (let ((cache-valid (and cj/org-agenda-files-cache + cj/org-agenda-files-cache-time + (not force-rebuild) + (< (- (float-time) cj/org-agenda-files-cache-time) + cj/org-agenda-files-cache-ttl)))) + (if cache-valid + ;; Use cached file list (instant) + (progn + (setq org-agenda-files cj/org-agenda-files-cache) + ;; Always show cache-hit message (interactive or background) + (cj/log-silently "Using cached agenda files (%d files)" + (length org-agenda-files))) + ;; Check if async build is in progress + (when cj/org-agenda-files-building + (cj/log-silently "Waiting for background agenda build to complete...")) + ;; Rebuild from scratch (slow - scans projects directory) + (unwind-protect + (progn + (setq cj/org-agenda-files-building t) + (let ((start-time (current-time))) + ;; Reset org-agenda-files to base files + (setq org-agenda-files (list inbox-file schedule-file gcal-file pcal-file)) + + ;; Check all projects for scheduled tasks + (cj/add-files-to-org-agenda-files-list projects-dir) + + ;; Update cache + (setq cj/org-agenda-files-cache org-agenda-files) + (setq cj/org-agenda-files-cache-time (float-time)) + + ;; Always show completion message (interactive or background) + (cj/log-silently "Built agenda files: %d files in %.3f sec" + (length org-agenda-files) + (- (float-time) (float-time start-time))))) + ;; Always clear the building flag, even if build fails + (setq cj/org-agenda-files-building nil))))) + +;; Build cache asynchronously after startup to avoid blocking Emacs +(run-with-idle-timer + 10 ; Wait 10 seconds after Emacs is idle + nil ; Don't repeat + (lambda () + (cj/log-silently "Building org-agenda files cache in background...") + (cj/build-org-agenda-list))) + +(defun cj/org-agenda-refresh-files () + "Force rebuild of agenda files cache. + +Use this after adding new projects or todo.org files. +Bypasses cache and scans directories from scratch." (interactive) - (let ((start-time (current-time))) - ;; reset org-agenda-files to inbox, schedule, and gcal - (setq org-agenda-files (list inbox-file schedule-file gcal-file)) - - ;; check all projects for scheduled tasks - (cj/add-files-to-org-agenda-files-list projects-dir) - - (message "Rebuilt org-agenda-files in %.3f sec" - (float-time (time-subtract (current-time) start-time))))) - -;; Run the above once after Emacs startup when idle for 1 second -;; makes regenerating the list much faster -(add-hook 'emacs-startup-hook - (lambda () - (run-with-idle-timer 1 nil #'cj/build-org-agenda-list))) + (cj/build-org-agenda-list 'force-rebuild)) (defun cj/todo-list-all-agenda-files () "Displays an \\='org-agenda\\=' todo list. - The contents of the agenda will be built from org-project-files and org-roam files that have project in their filetag." (interactive) @@ -118,7 +188,6 @@ files that have project in their filetag." (defun cj/todo-list-from-this-buffer () "Displays an \\='org-agenda\\=' todo list built from the current buffer. - If the current buffer isn't an org buffer, inform the user." (interactive) (if (eq major-mode 'org-mode) @@ -153,7 +222,6 @@ If the current buffer isn't an org buffer, inform the user." (defun cj/org-agenda-skip-subtree-if-not-overdue () "Skip an agenda subtree if it is not an overdue deadline or scheduled task. - An entry is considered overdue if it has a scheduled or deadline date strictly before today, is not marked as done, and is not a habit." (let* ((subtree-end (save-excursion (org-end-of-subtree t))) @@ -176,7 +244,6 @@ before today, is not marked as done, and is not a habit." (defun cj/org-skip-subtree-if-priority (priority) "Skip an agenda subtree if it has a priority of PRIORITY. - PRIORITY may be one of the characters ?A, ?B, or ?C." (let ((subtree-end (save-excursion (org-end-of-subtree t))) (pri-value (* 1000 (- org-lowest-priority priority))) @@ -187,7 +254,6 @@ PRIORITY may be one of the characters ?A, ?B, or ?C." (defun cj/org-skip-subtree-if-keyword (keywords) "Skip an agenda subtree if it has a TODO keyword in KEYWORDS. - KEYWORDS must be a list of strings." (let ((subtree-end (save-excursion (org-end-of-subtree t)))) (if (member (org-get-todo-state) keywords) @@ -224,12 +290,10 @@ KEYWORDS must be a list of strings." (defun cj/main-agenda-display () "Display the main daily org-agenda view. - This uses all org-agenda targets and presents three sections: - All unfinished priority A tasks - Today's schedule, including habits with consistency graphs - All priority B and C unscheduled/undeadlined tasks - The agenda is rebuilt from all sources before display, including: - inbox-file and schedule-file - Org-roam nodes tagged as \"Project\" @@ -244,7 +308,6 @@ The agenda is rebuilt from all sources before display, including: (defun cj/add-timestamp-to-org-entry (s) "Add an event with time S to appear underneath the line-at-point. - This allows a line to show in an agenda without being scheduled or a deadline." (interactive "sTime: ") (defvar cj/timeformat "%Y-%m-%d %a") @@ -253,7 +316,6 @@ This allows a line to show in an agenda without being scheduled or a deadline." (open-line 1) (forward-line 1) (insert (concat "<" (format-time-string cj/timeformat (current-time)) " " s ">" )))) -;;(global-set-key (kbd "M-t") #'cj/add-timestamp-to-org-entry) ;; --------------------------- Notifications / Alerts -------------------------- ;; send libnotify notifications for agenda items @@ -265,39 +327,61 @@ This allows a line to show in an agenda without being scheduled or a deadline." ;; Install CHIME from GitHub using use-package :vc (Emacs 29+) (use-package chime - :vc (:url "https://github.com/cjennings/chime.el" :rev :newest) - :after (alert org-agenda) :demand t + ;; :vc (:url "https://github.com/cjennings/chime.el" :rev :newest) ;; using latest on github + :after alert ; Removed org-agenda - chime.el requires it internally + :ensure nil ;; using local version + :load-path "~/code/chime.el" + :init + ;; Initialize org-agenda-files with base files before chime loads + ;; The full list will be built asynchronously later + (setq org-agenda-files (list inbox-file schedule-file gcal-file pcal-file)) + + ;; Debug mode (keep set to nil, but available for troubleshooting) + (setq chime-debug nil) :bind ("C-c A" . chime-check) :config - ;; Notification times: 5 minutes before and at event time (0 minutes) - ;; This gives two notifications per event without any after-event notifications - (setq chime-alert-time '(5 0)) + ;; Polling interval: check every minute + (setq chime-check-interval 60) - ;; Modeline display: show upcoming events within 60 minutes - (setq chime-modeline-lookahead 120) - (setq chime-modeline-format " ⏰ %s") + ;; Alert intervals: 5 minutes before and at event time + ;; All notifications use medium urgency + (setq chime-alert-intervals '((5 . medium) (0 . medium))) - ;; Chime sound: plays when notifications appear - (setq chime-play-sound t) - ;; Uses bundled chime.wav by default + ;; Day-wide events: notify at 9 AM for birthdays/all-day events + (setq chime-day-wide-time "09:00") - ;; Notification settings - (setq chime-notification-title "Reminder") - (setq chime-alert-severity 'medium) + ;; Modeline display: show upcoming events within 6 hours + (setq chime-modeline-lookahead-minutes (* 6 60)) + + ;; Tooltip settings: show up to 10 upcoming events within 6 days + (setq chime-modeline-tooltip-max-events 20) + (setq chime-tooltip-lookahead-hours (* 7 24)) + + ;; Modeline content: show title and countdown only (omit event time) + (setq chime-notification-text-format "%t %u") - ;; Don't filter by TODO keywords - notify for all events with timestamps - (setq chime-keyword-whitelist nil) - (setq chime-keyword-blacklist nil) + ;; Time-until format: compact style like " in 10m" or " in 1h 37m" + (setq chime-time-left-format-short " in %mm ") ; Under 1 hour: " in 10m" + (setq chime-time-left-format-long " in %hh %mm ") ; 1 hour+: " in 1h 37m" + (setq chime-time-left-format-at-event "now") + + ;; Title truncation: limit long event titles to 25 characters + (setq chime-max-title-length 25) + + ;; Notification title + (setq chime-notification-title "Reminder") - ;; Only notify for non-done items (default behavior) - (setq chime-predicate-blacklist - '(chime-done-keywords-predicate)) + ;; Calendar URL + (setq chime-calendar-url "https://calendar.google.com/calendar/u/0/r") - ;; Enable chime-mode automatically + ;; Enable chime-mode (chime-mode 1)) +;; which-key labels +(with-eval-after-load 'which-key + (which-key-add-key-based-replacements "C-c A" "chime check")) (provide 'org-agenda-config) ;;; org-agenda-config.el ends here diff --git a/modules/org-capture-config.el b/modules/org-capture-config.el index f41d0228..5d569002 100644 --- a/modules/org-capture-config.el +++ b/modules/org-capture-config.el @@ -84,10 +84,6 @@ Intended to be called within an org capture template." '(("t" "Task" entry (file+headline inbox-file "Inbox") "* TODO %?" :prepend t) - ("a" "Appointment" entry (file gcal-file) - "* %?\n:PROPERTIES:\n:calendar-id:craigmartinjennings@gmail.com\n:END:\n:org-gcal:\n%^T--%^T\n:END:\n\n" - :jump-to-captured t) - ("e" "Event" entry (file+headline schedule-file "Scheduled Events") "* %?%:description SCHEDULED: %^t%(cj/org-capture-event-content) diff --git a/modules/org-config.el b/modules/org-config.el index 0249973f..a4f98310 100644 --- a/modules/org-config.el +++ b/modules/org-config.el @@ -6,102 +6,6 @@ ;;; Code: - -;; ---------------------------------- Org Mode --------------------------------- - -(use-package org - :defer t - :ensure nil ;; use the built-in package - :pin manual ;; never upgrade from the version built-into Emacs - :init - (defvar-keymap cj/org-table-map - :doc "org table operations.") - (keymap-global-set "C-c t" cj/org-table-map) - :bind - ("C-c c" . org-capture) - ("C-c a" . org-agenda) - (:map org-mode-map - ("C-c I" . org-table-field-info) ;; was C-c ? - ("C-\\" . org-match-sparse-tree) - ("C-c t" . org-set-tags-command) - ("C-c l" . org-store-link) - ("C-c C-l" . org-insert-link) - ("s-<up>" . org-priority-up) - ("s-<down>" . org-priority-down) - ("C-c N" . org-narrow-to-subtree) - ("C-c >" . cj/org-narrow-forward) - ("C-c <" . cj/org-narrow-backwards) - ("<f5>" . org-reveal) - ("C-c <ESC>" . widen)) - (:map cj/org-table-map - ("r i" . org-table-insert-row) - ("r d" . org-table-kill-row) - ("c i" . org-table-insert-column) - ("c d" . org-table-delete-column)) - - ;; backward and forward day are ',' and '.' - ;; shift & meta moves by week or year - ;; C-. jumps to today - ;; original keybindings blocked by windmove keys - ;; these are consistent with plain-old calendar mode - (:map org-read-date-minibuffer-local-map - ("," . (lambda () (interactive) - (org-eval-in-calendar '(calendar-backward-day 1)))) - ("." . (lambda () (interactive) - (org-eval-in-calendar '(calendar-forward-day 1)))) - ("<" . (lambda () (interactive) - (org-eval-in-calendar '(calendar-backward-month 1)))) - (">" . (lambda () (interactive) - (org-eval-in-calendar '(calendar-forward-month 1)))) - ("M-," . (lambda () (interactive) - (org-eval-in-calendar '(calendar-backward-year 1)))) - ("M-." . (lambda () (interactive) - (org-eval-in-calendar '(calendar-forward-year 1))))) - - :init - ;; windmove's keybindings conflict with org-agenda-todo-nextset/previousset keybindings - ;; solution: map the super key so that - ;; - super up/down increases and decreases the priority - ;; - super left/right changes the todo state - (setq org-replace-disputed-keys t) - (setq org-disputed-keys - '(([(shift left)] . [(super left)]) - ([(shift right)] . [(super right)]) - ([(shift up)] . [(super up)]) - ([(shift down)] . [(super down)]) - ([(control shift right)] . [(meta shift +)]) - ([(control shift left)] . [(meta shift -)]))) - - (defun cj/org-narrow-forward () - "Narrow to the next subtree at the same level." - (interactive) - (widen) - (org-forward-heading-same-level 1) - (org-narrow-to-subtree)) - - (defun cj/org-narrow-backwards () - "Narrow to the previous subtree at the same level." - (interactive) - (widen) - (org-backward-heading-same-level 1) - (org-narrow-to-subtree)) - - :hook - (org-mode . turn-on-visual-line-mode) - (org-mode . (lambda () (setq-local tab-width 8))) - - :config - ;; Load org-protocol for org-protocol:// URL handling - (require 'org-protocol nil t) - - ;; Set archive location (must be done after org loads) - (setq org-archive-location - (concat org-dir "/archives/archive.org::datetree/")) - - (cj/org-general-settings) - (cj/org-appearance-settings) - (cj/org-todo-settings)) - ;; ---------------------------- Org General Settings --------------------------- (defun cj/org-general-settings () @@ -164,11 +68,11 @@ (set-face-attribute 'org-link nil :underline t) (setq org-ellipsis " ▾") ;; change ellipses to down arrow - (setq org-hide-emphasis-markers t) ;; remove emphasis markers to keep the screen clean + (setq org-hide-emphasis-markers t) ;; hide emphasis markers (org-appear shows them when editing) (setq org-hide-leading-stars t) ;; hide leading stars, just show one per line (setq org-pretty-entities t) ;; render special symbols (setq org-pretty-entities-include-sub-superscripts nil) ;; ...except superscripts and subscripts - (setq org-fontify-emphasized-text nil) ;; ...and don't render bold and italic markup + (setq org-fontify-emphasized-text t) ;; render bold and italic markup (setq org-fontify-whole-heading-line t) ;; fontify the whole line for headings (for face-backgrounds) (add-hook 'org-mode-hook 'prettify-symbols-mode)) @@ -213,6 +117,106 @@ ;; inherit parents properties (sadly not schedules or deadlines) (setq org-use-property-inheritance t)) +;; ---------------------------------- Org Mode --------------------------------- + +(use-package org + :defer t + :ensure nil ;; use the built-in package + :pin manual ;; never upgrade from the version built-into Emacs + :init + (defvar-keymap cj/org-table-map + :doc "org table operations.") + (keymap-set cj/custom-keymap "T" cj/org-table-map) + + (defvar-keymap cj/org-map + :doc "General org-mode operations and utilities.") + (keymap-set cj/custom-keymap "O" cj/org-map) + :bind + ("C-c c" . org-capture) + ("C-c a" . org-agenda) + (:map org-mode-map + ("C-c I" . org-table-field-info) ;; was C-c ? + ("C-\\" . org-match-sparse-tree) + ("C-c t" . org-set-tags-command) + ("C-c l" . org-store-link) + ("C-c C-l" . org-insert-link) + ("s-<up>" . org-priority-up) + ("s-<down>" . org-priority-down) + ("C-c N" . org-narrow-to-subtree) + ("C-c >" . cj/org-narrow-forward) + ("C-c <" . cj/org-narrow-backwards) + ("<f5>" . org-reveal) + ("C-c <ESC>" . widen) + ("C-c C-a" . cj/org-appear-toggle)) + (:map cj/org-table-map + ("r i" . org-table-insert-row) + ("r d" . org-table-kill-row) + ("c i" . org-table-insert-column) + ("c d" . org-table-delete-column)) + + ;; backward and forward day are ',' and '.' + ;; shift & meta moves by week or year + ;; C-. jumps to today + ;; original keybindings blocked by windmove keys + ;; these are consistent with plain-old calendar mode + (:map org-read-date-minibuffer-local-map + ("," . (lambda () (interactive) + (org-eval-in-calendar '(calendar-backward-day 1)))) + ("." . (lambda () (interactive) + (org-eval-in-calendar '(calendar-forward-day 1)))) + ("<" . (lambda () (interactive) + (org-eval-in-calendar '(calendar-backward-month 1)))) + (">" . (lambda () (interactive) + (org-eval-in-calendar '(calendar-forward-month 1)))) + ("M-," . (lambda () (interactive) + (org-eval-in-calendar '(calendar-backward-year 1)))) + ("M-." . (lambda () (interactive) + (org-eval-in-calendar '(calendar-forward-year 1))))) + + :init + ;; windmove's keybindings conflict with org-agenda-todo-nextset/previousset keybindings + ;; solution: map the super key so that + ;; - super up/down increases and decreases the priority + ;; - super left/right changes the todo state + (setq org-replace-disputed-keys t) + (setq org-disputed-keys + '(([(shift left)] . [(super left)]) + ([(shift right)] . [(super right)]) + ([(shift up)] . [(super up)]) + ([(shift down)] . [(super down)]) + ([(control shift right)] . [(meta shift +)]) + ([(control shift left)] . [(meta shift -)]))) + + (defun cj/org-narrow-forward () + "Narrow to the next subtree at the same level." + (interactive) + (widen) + (org-forward-heading-same-level 1) + (org-narrow-to-subtree)) + + (defun cj/org-narrow-backwards () + "Narrow to the previous subtree at the same level." + (interactive) + (widen) + (org-backward-heading-same-level 1) + (org-narrow-to-subtree)) + + :hook + (org-mode . turn-on-visual-line-mode) + (org-mode . (lambda () (setq-local tab-width 8))) + + :config + ;; Load org-protocol for org-protocol:// URL handling + (require 'org-protocol nil t) + + ;; Set archive location (must be done after org loads) + (setq org-archive-location + (concat org-dir "/archives/archive.org::datetree/")) + + (cj/org-general-settings) + (cj/org-appearance-settings) + (cj/org-todo-settings)) + ;; ------------------------------- Org Superstar ------------------------------- (use-package org-superstar @@ -222,6 +226,29 @@ (org-superstar-configure-like-org-bullets) (setq org-superstar-leading-bullet ?\s)) +;; -------------------------------- Org-Appear --------------------------------- + +(use-package org-appear + ;; Default: OFF (toggle with cj/org-appear-toggle) + ;; Useful for editing links, but can make tables hard to read when links expand + :custom + (org-appear-autoemphasis t) ;; Show * / _ when cursor is on them + (org-appear-autolinks t) ;; Also works for links + (org-appear-autosubmarkers t)) ;; And sub/superscripts + +(defun cj/org-appear-toggle () + "Toggle org-appear-mode in the current org-mode buffer. +When enabled, org-appear shows emphasis markers and link URLs only when +point is on them. When disabled, they stay hidden (cleaner for reading, +especially in tables with long URLs)." + (interactive) + (if (bound-and-true-p org-appear-mode) + (progn + (org-appear-mode -1) + (message "org-appear disabled (links/emphasis stay hidden)")) + (org-appear-mode 1) + (message "org-appear enabled (links/emphasis show when editing)"))) + ;; ------------------------------- Org-Checklist ------------------------------- ;; needed for org-habits to reset checklists once task is complete @@ -266,5 +293,50 @@ the current buffer's cache. Useful when encountering parsing errors like (message "Cleared org-element cache for current buffer")) (user-error "Current buffer is not in org-mode")))) +;; Add to org keymap +(keymap-set cj/org-map "c" #'cj/org-clear-element-cache) + +;; ----------------------- Org Multi-Level Sorting ----------------------------- + +(defun cj/org-sort-by-todo-and-priority () + "Sort org entries by TODO status (TODO before DONE) and priority (A to D). +Sorts the current level's entries. Within each TODO state group, entries are +sorted by priority. Uses stable sorting: sort by priority first, then by TODO +status to preserve priority ordering within TODO groups." + (interactive) + (unless (derived-mode-p 'org-mode) + (user-error "Current buffer is not in org-mode")) + (save-excursion + ;; First sort by priority (A, B, C, D, then no priority) + ;; Ignore "Nothing to sort" errors for empty sections + (condition-case nil + (org-sort-entries nil ?p) + (user-error nil)) + ;; Then sort by TODO status (TODO before DONE) + ;; This preserves the priority ordering within each TODO group + (condition-case nil + (org-sort-entries nil ?o) + (user-error nil))) + (message "Sorted entries by TODO status and priority")) + +;; which-key labels for org keymaps +(with-eval-after-load 'which-key + (which-key-add-key-based-replacements + ;; org general operations + "C-; O" "org menu" + "C-; O c" "clear element cache" + ;; org table operations + "C-; T" "org table menu" + "C-; T r" "table row" + "C-; T r i" "insert row" + "C-; T r d" "delete row" + "C-; T c" "table column" + "C-; T c i" "insert column" + "C-; T c d" "delete column" + ;; org global bindings + "C-c a" "org agenda" + "C-c c" "org capture" + "C-c l" "org store link")) + (provide 'org-config) ;;; org-config.el ends here diff --git a/modules/org-contacts-config.el b/modules/org-contacts-config.el index 706412a2..924b164c 100644 --- a/modules/org-contacts-config.el +++ b/modules/org-contacts-config.el @@ -20,68 +20,106 @@ ;; Add a wrapper function that ensures proper context (defun cj/org-contacts-anniversaries-safe () - "Safely call org-contacts-anniversaries with required bindings." - (require 'diary-lib) - ;; These need to be dynamically bound for diary functions - (defvar date) - (defvar entry) - (defvar original-date) - (let ((date (calendar-current-date)) - (entry "") - (original-date (calendar-current-date))) - (ignore-errors - (org-contacts-anniversaries)))) + "Safely call org-contacts-anniversaries with required bindings." + (require 'diary-lib) + ;; These need to be dynamically bound for diary functions + (defvar date) + (defvar entry) + (defvar original-date) + (let ((date (calendar-current-date)) + (entry "") + (original-date (calendar-current-date))) + (ignore-errors + (org-contacts-anniversaries)))) ;; Use the safe wrapper instead (add-hook 'org-agenda-finalize-hook 'cj/org-contacts-anniversaries-safe)) ;; ----------------------- Org-Contacts Capture Template ----------------------- +(defun cj/org-contacts-finalize-birthday-timestamp () + "Add yearly repeating timestamp after properties drawer if BIRTHDAY is set." + (when (string= (plist-get org-capture-plist :key) "C") + (save-excursion + (goto-char (point-min)) + (let ((birthday (org-entry-get (point) "BIRTHDAY"))) + (when (and birthday (not (string-blank-p birthday))) + ;; Parse birthday - returns (year month day) or nil + (let ((parsed + (cond + ((string-match "^\\([0-9]\\{4\\}\\)-\\([0-9]\\{2\\}\\)-\\([0-9]\\{2\\}\\)$" birthday) + (list (string-to-number (match-string 1 birthday)) + (string-to-number (match-string 2 birthday)) + (string-to-number (match-string 3 birthday)))) + ((string-match "^\\([0-9]\\{2\\}\\)-\\([0-9]\\{2\\}\\)$" birthday) + (list (nth 5 (decode-time)) + (string-to-number (match-string 1 birthday)) + (string-to-number (match-string 2 birthday)))) + (t nil)))) + (when parsed + (let* ((year (nth 0 parsed)) + (month (nth 1 parsed)) + (day (nth 2 parsed)) + (time (encode-time 0 0 0 day month year)) + (dow (format-time-string "%a" time)) + (timestamp (format "<%04d-%02d-%02d %s +1y>" year month day dow)) + (heading-end (save-excursion (outline-next-heading) (point)))) + ;; Find :END: and insert timestamp + (when (re-search-forward "^[ \t]*:END:[ \t]*$" heading-end t) + (let ((end-pos (point))) + (goto-char end-pos) + (unless (re-search-forward "<[0-9]\\{4\\}-[0-9]\\{2\\}-[0-9]\\{2\\}[^>]*\\+1y>" heading-end t) + (goto-char end-pos) + (end-of-line) + (insert "\n" timestamp)))))))))))) + (with-eval-after-load 'org-capture (add-to-list 'org-capture-templates - '("C" "Contact" entry (file+headline contacts-file "Contacts") - "* %(cj/org-contacts-template-name) + '("C" "Contact" entry (file+headline contacts-file "Contacts") + "* %(cj/org-contacts-template-name) :PROPERTIES: :EMAIL: %(cj/org-contacts-template-email) :PHONE: %^{Phone(s) - separate multiple with commas} :ADDRESS: %^{Address} -:BIRTHDAY: %^{Birthday (YYYY-MM-DD)} +:BIRTHDAY: %^{Birthday (YYYY-MM-DD or MM-DD)} +:NICKNAME: %^{Nickname} :COMPANY: %^{Company} :TITLE: %^{Title/Position} :WEBSITE: %^{URL} +:NOTE: %^{Notes} :END: -%^{Notes} -Added: %U"))) +Added: %U" + :prepare-finalize cj/org-contacts-finalize-birthday-timestamp))) ;; TASK: What purpose did this serve? ;; duplicate?!? ;; (with-eval-after-load 'org-capture ;; (add-to-list 'org-capture-templates -;; '("C" "Contact" entry (file+headline contacts-file "Contacts") -;; "* %(cj/org-contacts-template-name) +;; '("C" "Contact" entry (file+headline contacts-file "Contacts") +;; "* %(cj/org-contacts-template-name) ;; Added: %U"))) (defun cj/org-contacts-template-name () "Get name for contact template from context." (let ((name (when (boundp 'cj/contact-name) cj/contact-name))) - (or name - (when (eq major-mode 'mu4e-headers-mode) - (mu4e-message-field (mu4e-message-at-point) :from-or-to)) - (when (eq major-mode 'mu4e-view-mode) - (mu4e-message-field mu4e~view-message :from-or-to)) - (read-string "Name: ")))) + (or name + (when (eq major-mode 'mu4e-headers-mode) + (mu4e-message-field (mu4e-message-at-point) :from-or-to)) + (when (eq major-mode 'mu4e-view-mode) + (mu4e-message-field mu4e~view-message :from-or-to)) + (read-string "Name: ")))) (defun cj/org-contacts-template-email () "Get email for contact template from context." (let ((email (when (boundp 'cj/contact-email) cj/contact-email))) - (or email - (when (eq major-mode 'mu4e-headers-mode) - (let ((from (mu4e-message-field (mu4e-message-at-point) :from))) - (when from (cdr (car from))))) - (when (eq major-mode 'mu4e-view-mode) - (let ((from (mu4e-message-field mu4e~view-message :from))) - (when from (cdr (car from))))) - (read-string "Email: ")))) + (or email + (when (eq major-mode 'mu4e-headers-mode) + (let ((from (mu4e-message-field (mu4e-message-at-point) :from))) + (when from (cdr (car from))))) + (when (eq major-mode 'mu4e-view-mode) + (let ((from (mu4e-message-field mu4e~view-message :from))) + (when from (cdr (car from))))) + (read-string "Email: ")))) ;;; ------------------------- Quick Contact Functions --------------------------- @@ -91,13 +129,13 @@ Added: %U"))) (find-file contacts-file) (goto-char (point-min)) (let ((contact (completing-read "Contact: " - (org-map-entries - (lambda () (nth 4 (org-heading-components))) - nil (list contacts-file))))) - (goto-char (point-min)) - (search-forward contact) - (org-fold-show-entry) - (org-reveal))) + (org-map-entries + (lambda () (nth 4 (org-heading-components))) + nil (list contacts-file))))) + (goto-char (point-min)) + (search-forward contact) + (org-fold-show-entry) + (org-reveal))) (defun cj/org-contacts-new () "Create a new contact." @@ -110,19 +148,6 @@ Added: %U"))) (find-file contacts-file) (org-columns)) -;;; -------------------------- Org-Roam Integration ----------------------------- - -;; (with-eval-after-load 'org-roam -;; (defun cj/org-contacts-link-to-roam () -;; "Link current contact to an org-roam node." -;; (interactive) -;; (when (eq major-mode 'org-mode) -;; (let ((contact-name (org-entry-get (point) "ITEM"))) -;; (org-set-property "ROAM_REFS" -;; (org-roam-node-id -;; (org-roam-node-read nil nil nil nil -;; :initial-input contact-name))))))) - ;;; ----------------------------- Birthday Agenda -------------------------------- (with-eval-after-load 'org-agenda @@ -131,40 +156,48 @@ Added: %U"))) ;; Custom agenda command for upcoming birthdays (add-to-list 'org-agenda-custom-commands - '("b" "Birthdays and Anniversaries" - ((tags-todo "BIRTHDAY|ANNIVERSARY" - ((org-agenda-overriding-header "Upcoming Birthdays and Anniversaries") - (org-agenda-sorting-strategy '(time-up)))))))) + '("b" "Birthdays and Anniversaries" + ((tags-todo "BIRTHDAY|ANNIVERSARY" + ((org-agenda-overriding-header "Upcoming Birthdays and Anniversaries") + (org-agenda-sorting-strategy '(time-up)))))))) ;;; ---------------------------- Core Contact Data Functions --------------------------- (defun cj/org-contacts--props-matching (entry pattern) "Return all property values from ENTRY whose keys match PATTERN (a regexp)." (let ((props (nth 2 entry))) - (delq nil - (mapcar (lambda (prop) - (when (string-match-p pattern (car prop)) - (cdr prop))) - props)))) + (delq nil + (mapcar (lambda (prop) + (when (string-match-p pattern (car prop)) + (cdr prop))) + props)))) + +(defun cj/--parse-email-string (name email-string) + "Parse EMAIL-STRING and return formatted entries for NAME. +EMAIL-STRING may contain multiple emails separated by commas, semicolons, or spaces. +Returns a list of strings formatted as 'Name <email>'. +Returns nil if EMAIL-STRING is nil or contains only whitespace." + (when (and email-string (string-match-p "[^[:space:]]" email-string)) + (let ((emails (split-string email-string "[,;[:space:]]+" t))) + (mapcar (lambda (email) + (format "%s <%s>" name (string-trim email))) + emails)))) (defun cj/get-all-contact-emails () "Retrieve all contact emails from org-contacts database. Returns a list of formatted strings like \"Name <email@example.com>\". This is the core function used by the mu4e integration module." (let ((contacts (org-contacts-db))) - (delq nil - (mapcan (lambda (e) - (let* ((name (car e)) - ;; This returns a LIST of email strings - (email-strings (cj/org-contacts--props-matching e "EMAIL"))) - ;; Need mapcan here to handle the list - (mapcan (lambda (email-str) - (when (and email-str (string-match-p "[^[:space:]]" email-str)) - (mapcar (lambda (email) - (format "%s <%s>" name (string-trim email))) - (split-string email-str "[,;[:space:]]+" t)))) - email-strings))) - contacts)))) + (delq nil + (mapcan (lambda (e) + (let* ((name (car e)) + ;; This returns a LIST of email strings + (email-strings (cj/org-contacts--props-matching e "EMAIL"))) + ;; Process each email string using the extracted parser + (mapcan (lambda (email-str) + (cj/--parse-email-string name email-str)) + email-strings))) + contacts)))) ;; Simple insertion function for use outside of mu4e (defun cj/insert-contact-email () @@ -173,8 +206,8 @@ For use outside of mu4e compose buffers. In mu4e, the integration module provides more sophisticated completion." (interactive) (let* ((items (cj/get-all-contact-emails)) - (selected (completing-read "Contact: " items nil t))) - (insert selected))) + (selected (completing-read "Contact: " items nil t))) + (insert selected))) ;;; -------------------------------- Org Contacts -------------------------------- @@ -195,9 +228,9 @@ module provides more sophisticated completion." (setq mu4e-org-contacts-file contacts-file) (add-to-list 'mu4e-headers-actions - '("org-contact-add" . mu4e-action-add-org-contact) t) + '("org-contact-add" . mu4e-action-add-org-contact) t) (add-to-list 'mu4e-view-actions - '("org-contact-add" . mu4e-action-add-org-contact) t) + '("org-contact-add" . mu4e-action-add-org-contact) t) ;; Disable mu4e's built-in completion in favor of our custom solution (setq mu4e-compose-complete-addresses nil)) @@ -207,15 +240,24 @@ module provides more sophisticated completion." ;; Keymap for `org-contacts' commands (defvar cj/org-contacts-map (let ((map (make-sparse-keymap))) - (keymap-set map "f" #'cj/org-contacts-find) ;; find contact - (keymap-set map "n" #'cj/org-contacts-new) ;; new contact - (keymap-set map "e" #'cj/insert-contact-email) ;; inserts email from org-contact - (keymap-set map "v" #'cj/org-contacts-view-all) ;; view all contacts - map) + (keymap-set map "f" #'cj/org-contacts-find) ;; find contact + (keymap-set map "n" #'cj/org-contacts-new) ;; new contact + (keymap-set map "e" #'cj/insert-contact-email) ;; inserts email from org-contact + (keymap-set map "v" #'cj/org-contacts-view-all) ;; view all contacts + map) "Keymap for `org-contacts' commands.") ;; Bind the org-contacts map to the C-c C prefix (keymap-global-set "C-c C" cj/org-contacts-map) +;; which-key labels +(with-eval-after-load 'which-key + (which-key-add-key-based-replacements + "C-c C" "contacts menu" + "C-c C f" "find contact" + "C-c C n" "new contact" + "C-c C e" "insert email" + "C-c C v" "view all contacts")) + (provide 'org-contacts-config) ;;; org-contacts-config.el ends here diff --git a/modules/org-drill-config.el b/modules/org-drill-config.el index f18760c7..8d82c42c 100644 --- a/modules/org-drill-config.el +++ b/modules/org-drill-config.el @@ -19,17 +19,30 @@ ;; --------------------------------- Org Drill --------------------------------- (use-package org-drill + :load-path "~/code/org-drill" + ;; Use local development version instead of VC install + ;; :vc (:url "https://github.com/cjennings/org-drill" + ;; :branch "main" + ;; :rev :newest) :after (org org-capture) + :demand t :commands (org-drill cj/drill-start) :config (setq org-drill-leech-failure-threshold 50) ;; leech cards = 50 wrong anwers (setq org-drill-leech-method 'warn) ;; leech cards show warnings (setq org-drill-use-visible-cloze-face-p t) ;; cloze text show up in a different font (setq org-drill-hide-item-headings-p t) ;; don't show heading text - (setq org-drill-maximum-items-per-session 1000) ;; drill sessions end after 1000 cards - (setq org-drill-maximum-duration 60) ;; each drill session can last up to a an hour + (setq org-drill-maximum-items-per-session 100) ;; drill sessions end after 100 cards + (setq org-drill-maximum-duration 30) ;; each drill session can last up to 30 mins (setq org-drill-add-random-noise-to-intervals-p t) ;; slightly vary number of days to repetition + ;; ------------------------------ Display Settings ----------------------------- + + ;; Configure display settings for drill sessions + (setq org-drill-text-size-during-session 24) ;; 24-point font for comfortable reading + (setq org-drill-use-variable-pitch t) ;; use variable-pitch font for readability + (setq org-drill-hide-modeline-during-session t) ;; hide modeline for cleaner display + (defun cj/drill-start () "Prompt user to pick a drill org file, then start an org-drill session." (interactive) @@ -70,7 +83,13 @@ (keymap-set cj/custom-keymap "D" cj/drill-map) (with-eval-after-load 'which-key - (which-key-add-key-based-replacements "C-; D" "org-drill menu"))) + (which-key-add-key-based-replacements + "C-; D" "org-drill menu" + "C-; D s" "start drill" + "C-; D e" "edit drill file" + "C-; D c" "capture question" + "C-; D r" "refile to drill" + "C-; D R" "resume drill"))) (provide 'org-drill-config) ;;; org-drill-config.el ends here. diff --git a/modules/org-export-config.el b/modules/org-export-config.el index 43329cc3..612b80cb 100644 --- a/modules/org-export-config.el +++ b/modules/org-export-config.el @@ -24,6 +24,8 @@ ;; ;;; Code: +(require 'system-lib) + ;; --------------------------------- Org Export -------------------------------- (use-package ox @@ -112,7 +114,7 @@ (variable . "transition=slide") (variable . "slideNumber=true")))) (unless (file-exists-p reveal-dir) - (message "Downloading reveal.js...") + (cj/log-silently "Downloading reveal.js...") (shell-command (format "git clone https://github.com/hakimel/reveal.js.git %s" reveal-dir))) (org-pandoc-export-to-revealjs))) diff --git a/modules/org-gcal-config.el b/modules/org-gcal-config.el deleted file mode 100644 index ed0831b8..00000000 --- a/modules/org-gcal-config.el +++ /dev/null @@ -1,94 +0,0 @@ -;;; org-gcal-config.el --- Google Calendar synchronization for Org-mode -*- lexical-binding: t; coding: utf-8; -*- -;; -;; Author: Craig Jennings <c@cjennings.net> -;; -;;; Commentary: -;; -;; Bidirectional synchronization between Google Calendar and Org-mode using org-gcal. -;; - Credential management via authinfo.gpg -;; - Automatic archival of past events -;; - Automatic removal of cancelled events, but with TODOs added for visibility -;; - System timezone configuration via functions in host-environment -;; - No notifications on syncing -;; - Initial automatic sync post Emacs startup. No auto resync'ing. -;; (my calendar doesn't change hourly and I want fewer distractions and slowdowns). -;; if you need it: https://github.com/kidd/org-gcal.el?tab=readme-ov-file#sync-automatically-at-regular-times -;; - Validates existing oath2-auto.plist file or creates it to avoid the issue mentioned here: -;; https://github.com/kidd/org-gcal.el?tab=readme-ov-file#note -;; -;; Prerequisites: -;; 1. Create OAuth 2.0 credentials in Google Cloud Console -;; See: https://github.com/kidd/org-gcal.el?tab=readme-ov-file#installation -;; 2. Store credentials in ~/.authinfo.gpg with this format: -;; machine org-gcal login YOUR_CLIENT_ID password YOUR_CLIENT_SECRET -;; 3. Define `gcal-file' in user-constants (location of org file to hold sync'd events). -;; -;; Usage: -;; - Manual sync: C-; g (or M-x org-gcal-sync) -;; -;; Note: -;; This configuration creates oauth2-auto.plist on first run to prevent sync errors. -;; Passphrase caching is enabled. -;; -;;; Code: - -(require 'host-environment) -(require 'user-constants) - -(defun cj/org-gcal-clear-sync-lock () - "Clear the org-gcal sync lock. -Useful when a sync fails and leaves the lock in place, preventing future syncs." - (interactive) - (setq org-gcal--sync-lock nil) - (message "org-gcal sync lock cleared")) - -(use-package org-gcal - :defer t ;; unless idle timer is set below - :bind (("C-; g" . org-gcal-sync) - ("C-; G" . cj/org-gcal-clear-sync-lock)) - - :init - ;; Retrieve credentials from authinfo.gpg BEFORE package loads - ;; This is critical - org-gcal checks these variables at load time - (require 'auth-source) - (let ((credentials (car (auth-source-search :host "org-gcal" :require '(:user :secret))))) - (when credentials - (setq org-gcal-client-id (plist-get credentials :user)) - ;; The secret might be a function, so we need to handle that - (let ((secret (plist-get credentials :secret))) - (setq org-gcal-client-secret - (if (functionp secret) - (funcall secret) - secret))))) - - ;; identify calendar to sync and it's destination - (setq org-gcal-fetch-file-alist `(("craigmartinjennings@gmail.com" . ,gcal-file))) - - (setq org-gcal-up-days 30) ;; Look 30 days back - (setq org-gcal-down-days 60) ;; Look 60 days forward - (setq org-gcal-auto-archive t) ;; auto-archive old events - (setq org-gcal-notify-p nil) ;; nil disables; t enables notifications - (setq org-gcal-remove-api-cancelled-events t) ;; auto-remove cancelled events - (setq org-gcal-update-cancelled-events-with-todo t) ;; todo cancelled events for visibility - - :config - ;; Enable plstore passphrase caching after org-gcal loads - (require 'plstore) - (setq plstore-cache-passphrase-for-symmetric-encryption t) - - ;; set org-gcal timezone based on system timezone - (setq org-gcal-local-timezone (cj/detect-system-timezone)) - - ;; Reload client credentials (should already be loaded by org-gcal, but ensure it's set) - (org-gcal-reload-client-id-secret)) - -;; Set up automatic initial sync on boot with error handling -;;(run-with-idle-timer -;; 2 nil -;; (lambda () -;; (condition-case err -;; (org-gcal-sync) -;; (error (message "org-gcal: Initial sync failed: %s" err))))) - -(provide 'org-gcal-config) -;;; org-gcal-config.el ends here diff --git a/modules/org-noter-config.el b/modules/org-noter-config.el index 253ed892..fc578085 100644 --- a/modules/org-noter-config.el +++ b/modules/org-noter-config.el @@ -1,63 +1,250 @@ -;;; org-noter-config.el --- -*- coding: utf-8; lexical-binding: t; -*- +;;; org-noter-config.el --- Org-noter configuration -*- coding: utf-8; lexical-binding: t; -*- ;;; Commentary: -;; Org-noter configuration for taking notes on PDF and DjVu documents. Workflow: -;; open a PDF/DjVu file in Emacs, press F6 to start org-noter session, frame -;; splits with document on one side and notes on the other, notes are saved to -;; ~/sync/org-noter/reading-notes.org by default, and position is automatically -;; saved when closing session. Features include integration with pdf-tools and -;; djvu, org-roam integration for linking notes, automatic session resumption at -;; last position, inserting highlighted text into notes, notes following -;; TASK: Aborted Commentary +;; +;; Org-noter configuration for taking notes on PDF and EPUB documents. +;; +;; Workflow: +;; 1. Open a PDF (pdf-view-mode) or EPUB (nov-mode) in Emacs +;; 2. Press F6 to start org-noter session +;; 3. If new book: prompted for title, creates notes file as org-roam node +;; 4. If existing book: finds and opens associated notes file +;; 5. Window splits with document on left (2/3) and notes on right (1/3) +;; 6. Use 'i' to insert notes at current location +;; 7. Notes are saved as org-roam nodes in org-roam-directory +;; +;; Can also start from notes file: open notes via org-roam, press F6 to open document. +;; +;; See docs/org-noter-workflow-spec.org for full specification. ;;; Code: +(require 'cl-lib) + +;; Forward declarations +(declare-function org-id-uuid "org-id") +(declare-function nov-mode "ext:nov") +(declare-function pdf-view-mode "ext:pdf-view") +(defvar nov-file-name) +(defvar org-roam-directory) +(defvar org-dir) + +;;; Configuration Variables + +(defvar cj/org-noter-notes-directory + (if (boundp 'org-roam-directory) + org-roam-directory + (expand-file-name "~/sync/org/roam/")) + "Directory where org-noter notes files are stored. +Defaults to `org-roam-directory' so notes are indexed by org-roam.") + +(defvar cj/org-noter-keybinding (kbd "<f6>") + "Keybinding to start org-noter session.") + +(defvar cj/org-noter-split-direction 'horizontal + "Direction to split window for notes. +`vertical' puts notes on the right (side-by-side). +`horizontal' puts notes on the bottom (stacked).") + +(defvar cj/org-noter-split-fraction 0.67 + "Fraction of window for document (notes get the remainder). +Default 0.67 means document gets 2/3, notes get 1/3.") + +;;; Helper Functions + +(defun cj/org-noter--title-to-slug (title) + "Convert TITLE to lowercase hyphenated slug for filename. +Example: \"The Pragmatic Programmer\" -> \"the-pragmatic-programmer\"" + (let ((slug (downcase title))) + (setq slug (replace-regexp-in-string "[^a-z0-9]+" "-" slug)) + (setq slug (replace-regexp-in-string "^-\\|-$" "" slug)) + slug)) + +(defun cj/org-noter--generate-notes-template (title doc-path) + "Generate org-roam notes template for TITLE and DOC-PATH." + (format ":PROPERTIES: +:ID: %s +:ROAM_REFS: %s +:NOTER_DOCUMENT: %s +:END: +#+title: Notes on %s +#+FILETAGS: :ReadingNotes: +#+CATEGORY: %s + +* Notes +" + (org-id-uuid) + doc-path + doc-path + title + title)) + +(defun cj/org-noter--in-document-p () + "Return non-nil if current buffer is a PDF or EPUB document." + (or (derived-mode-p 'pdf-view-mode) + (derived-mode-p 'nov-mode))) + +(defun cj/org-noter--in-notes-file-p () + "Return non-nil if current buffer is an org-noter notes file." + (and (derived-mode-p 'org-mode) + (save-excursion + (goto-char (point-min)) + (org-entry-get nil "NOTER_DOCUMENT")))) + +(defun cj/org-noter--get-document-path () + "Get file path of current document." + (cond + ((derived-mode-p 'nov-mode) nov-file-name) + ((derived-mode-p 'pdf-view-mode) (buffer-file-name)) + (t nil))) + +(defun cj/org-noter--extract-document-title () + "Extract title from current document filename. +Uses filename (without extension) for both PDFs and EPUBs." + (file-name-base (cj/org-noter--get-document-path))) + +(defun cj/org-noter--find-notes-file () + "Find existing notes file for current document. +Searches `cj/org-noter-notes-directory' for org files with matching +NOTER_DOCUMENT property. Returns path to notes file or nil." + (let ((doc-path (cj/org-noter--get-document-path))) + (when doc-path + (cl-find-if + (lambda (file) + (with-temp-buffer + (insert-file-contents file nil 0 1000) + (string-match-p (regexp-quote doc-path) (buffer-string)))) + (directory-files cj/org-noter-notes-directory t "\\.org$"))))) + +(defun cj/org-noter--create-notes-file () + "Create new org-roam notes file for current document. +Prompts user to confirm/edit title (pre-slugified), generates filename, +creates org-roam node with proper properties. Returns path to new file." + (let* ((doc-path (cj/org-noter--get-document-path)) + (default-title (cj/org-noter--title-to-slug + (cj/org-noter--extract-document-title))) + (title (read-string "Notes title: " default-title)) + (slug (cj/org-noter--title-to-slug title)) + (filename (format "notes-on-%s.org" slug)) + (filepath (expand-file-name filename cj/org-noter-notes-directory))) + (unless (file-exists-p filepath) + (with-temp-file filepath + (insert (cj/org-noter--generate-notes-template title doc-path)))) + (find-file-noselect filepath) + filepath)) + +;;; Main Entry Point + +(defun cj/org-noter--session-active-p () + "Return non-nil if an org-noter session is active for current buffer." + (and (boundp 'org-noter--session) + org-noter--session)) + +(defun cj/org-noter--toggle-notes-window () + "Toggle visibility of notes window in active org-noter session. +Preserves PDF fit setting when toggling." + (let ((notes-window (org-noter--get-notes-window)) + (pdf-fit (and (derived-mode-p 'pdf-view-mode) + (bound-and-true-p pdf-view-display-size)))) + (if notes-window + (delete-window notes-window) + (org-noter--get-notes-window 'start)) + ;; Restore PDF fit setting + (when pdf-fit + (pcase pdf-fit + ('fit-width (pdf-view-fit-width-to-window)) + ('fit-height (pdf-view-fit-height-to-window)) + ('fit-page (pdf-view-fit-page-to-window)) + (_ nil))))) + +(defun cj/org-noter-start () + "Start org-noter session or toggle notes window if session active. +When called from a document (PDF/EPUB): + - If session active: toggle notes window visibility + - If no session: find or create notes file, start session +When called from a notes file: + - If session active: switch to document window + - If no session: start session" + (interactive) + (cond + ;; In document with active session - toggle notes + ((and (cj/org-noter--in-document-p) + (cj/org-noter--session-active-p)) + (cj/org-noter--toggle-notes-window)) + ;; In notes file with active session - switch to document + ((and (cj/org-noter--in-notes-file-p) + (cj/org-noter--session-active-p)) + (let ((doc-window (org-noter--get-doc-window))) + (when doc-window + (select-window doc-window)))) + ;; In document without session - start new session + ((cj/org-noter--in-document-p) + (let ((notes-file (or (cj/org-noter--find-notes-file) + (cj/org-noter--create-notes-file)))) + (when notes-file + ;; Open notes file and call org-noter from there + (find-file notes-file) + (goto-char (point-min)) + (org-noter)))) + ;; In notes file without session - start session + ((cj/org-noter--in-notes-file-p) + (org-noter)) + (t + (message "Not in a document or org-noter notes file")))) + +;;; Package Configuration + (use-package djvu :defer 0.5) -(use-package pdf-tools - :defer t - :mode ("\\.pdf\\'" . pdf-view-mode) - :config - (pdf-tools-install :no-query)) - (use-package org-pdftools :after (org pdf-tools) :hook (org-mode . org-pdftools-setup-link)) +(global-set-key (kbd "<f6>") #'cj/org-noter-start) + (use-package org-noter - :after (:any org pdf-tools djvu) + :after (:any org pdf-tools djvu nov) :commands org-noter :config + ;; Window layout based on cj/org-noter-split-direction + (setq org-noter-notes-window-location + (if (eq cj/org-noter-split-direction 'vertical) + 'horizontal-split ; confusingly named: horizontal-split = side-by-side + 'vertical-split)) ; vertical-split = stacked + + ;; Split ratio from configuration (first is notes, second is doc) + (setq org-noter-doc-split-fraction + (cons (- 1.0 cj/org-noter-split-fraction) + cj/org-noter-split-fraction)) + ;; Basic settings (setq org-noter-always-create-frame nil) - (setq org-noter-notes-window-location 'horizontal-split) - (setq org-noter-notes-window-behavior '(start scroll)) ; note: must be a list! - (setq org-noter-doc-split-fraction '(0.5 . 0.5)) - (setq org-noter-notes-search-path (list (concat org-dir "/org-noter/"))) - (setq org-noter-default-notes-file-names '("reading-notes.org")) + (setq org-noter-notes-window-behavior '(start scroll)) + (setq org-noter-notes-search-path (list cj/org-noter-notes-directory)) (setq org-noter-separate-notes-from-heading t) - (setq org-noter-kill-frame-at-session-end t) ; kill frame when closing session + (setq org-noter-kill-frame-at-session-end nil) - (setq org-noter-auto-save-last-location t) ; Save position when closing - (setq org-noter-insert-selected-text-inside-note t) ; Insert highlighted text - (setq org-noter-closest-tipping-point 0.3) ; When to show closest previous note - (setq org-noter-hide-other t) ; Hide unrelated notes + (setq org-noter-auto-save-last-location t) + (setq org-noter-insert-selected-text-inside-note t) + (setq org-noter-closest-tipping-point 0.3) + (setq org-noter-hide-other t) - ;; Load the integration file if it exists in your config + ;; Load integration file if exists (let ((integration-file (expand-file-name "org-noter-integration.el" - (file-name-directory (locate-library "org-noter"))))) - (when (file-exists-p integration-file) - (load integration-file))) + (file-name-directory (locate-library "org-noter"))))) + (when (file-exists-p integration-file) + (load integration-file))) - ;; If you want to use the org-noter-pdftools integration features + ;; PDF tools integration (when (featurep 'org-noter-integration) - (setq org-noter-use-pdftools-link-location t) - (setq org-noter-use-org-id t) - (setq org-noter-use-unique-org-id t)) - (org-noter-enable-org-roam-integration) + (setq org-noter-use-pdftools-link-location t) + (setq org-noter-use-org-id t) + (setq org-noter-use-unique-org-id t)) - (org-noter-enable-org-roam-integration)) + ;; Defer org-roam integration to avoid slowing PDF load + (with-eval-after-load 'org-roam + (org-noter-enable-org-roam-integration))) (provide 'org-noter-config) -;;; org-noter-config.el ends here. +;;; org-noter-config.el ends here diff --git a/modules/org-refile-config.el b/modules/org-refile-config.el index 7b50604a..1cf976d4 100644 --- a/modules/org-refile-config.el +++ b/modules/org-refile-config.el @@ -2,49 +2,154 @@ ;; author: Craig Jennings <c@cjennings.net> ;;; Commentary: ;; Configuration and custom functions for org-mode refiling. +;; +;; Performance: +;; - Caches refile targets to avoid scanning 34,000+ files on every refile +;; - Cache builds asynchronously 5 seconds after Emacs startup (non-blocking) +;; - First refile uses cache if ready, otherwise builds synchronously (one-time delay) +;; - Subsequent refiles are instant (cached) +;; - Cache auto-refreshes after 1 hour +;; - Manual refresh: M-x cj/org-refile-refresh-targets (e.g., after adding projects) ;;; Code: +(require 'system-lib) + ;; ----------------------------- Org Refile Targets ---------------------------- ;; sets refile targets ;; - adds project files in org-roam to the refile targets ;; - adds todo.org files in subdirectories of the code and project directories -(defun cj/build-org-refile-targets () - "Build =org-refile-targets=." +(defvar cj/org-refile-targets-cache nil + "Cached refile targets to avoid expensive directory scanning. +Set to nil to invalidate cache.") + +(defvar cj/org-refile-targets-cache-time nil + "Time when refile targets cache was last built.") + +(defvar cj/org-refile-targets-cache-ttl 3600 + "Time-to-live for refile targets cache in seconds (default: 1 hour).") + +(defvar cj/org-refile-targets-building nil + "Non-nil when refile targets are being built asynchronously. +Prevents duplicate builds if user refiles before async build completes.") + +(defun cj/org-refile-ensure-org-mode (file) + "Ensure FILE is a .org file and its buffer is in org-mode. +Returns the buffer visiting FILE, switching it to org-mode if needed. +Signals an error if FILE doesn't have a .org extension. + +This prevents issues where: +1. Buffers get stuck in fundamental-mode (e.g., opened before org loaded) +2. Non-.org files are accidentally added to refile targets" + (unless (string-match-p "\\.org\\'" file) + (error "Refile target \"%s\" is not a .org file" file)) + + (let ((buf (org-get-agenda-file-buffer file))) + (with-current-buffer buf + (unless (derived-mode-p 'org-mode) + (cj/log-silently "Switching %s to org-mode (was in %s)" + (buffer-name) major-mode) + (org-mode))) + buf)) + +(defun cj/build-org-refile-targets (&optional force-rebuild) + "Build =org-refile-targets= with caching. + +When FORCE-REBUILD is non-nil, bypass cache and rebuild from scratch. +Otherwise, returns cached targets if available and not expired. + +This function scans 30,000+ files across code/projects directories, +so caching improves performance from 15-20 seconds to instant." + (interactive "P") + ;; Check if we can use cache + (let ((cache-valid (and cj/org-refile-targets-cache + cj/org-refile-targets-cache-time + (not force-rebuild) + (< (- (float-time) cj/org-refile-targets-cache-time) + cj/org-refile-targets-cache-ttl)))) + (if cache-valid + ;; Use cached targets (instant) + (progn + (setq org-refile-targets cj/org-refile-targets-cache) + ;; Always show cache-hit message (interactive or background) + (cj/log-silently "Using cached refile targets (%d files)" + (length org-refile-targets))) + ;; Check if async build is in progress + (when cj/org-refile-targets-building + (cj/log-silently "Waiting for background cache build to complete...")) + ;; Rebuild from scratch (slow - scans 34,000+ files) + (unwind-protect + (progn + (setq cj/org-refile-targets-building t) + (let ((start-time (current-time)) + (new-files + (list + (cons inbox-file '(:maxlevel . 1)) + (cons reference-file '(:maxlevel . 2)) + (cons schedule-file '(:maxlevel . 1))))) + + ;; Extend with org-roam files if available AND org-roam is loaded + (when (and (fboundp 'cj/org-roam-list-notes-by-tag) + (fboundp 'org-roam-node-list)) + (let* ((project-and-topic-files + (append (cj/org-roam-list-notes-by-tag "Project") + (cj/org-roam-list-notes-by-tag "Topic"))) + (file-rule '(:maxlevel . 1))) + (dolist (file project-and-topic-files) + (unless (assoc file new-files) + (push (cons file file-rule) new-files))))) + + ;; Add todo.org files from known directories + (dolist (dir (list user-emacs-directory code-dir projects-dir)) + (let* ((todo-files (directory-files-recursively + dir "^[Tt][Oo][Dd][Oo]\\.[Oo][Rr][Gg]$")) + (file-rule '(:maxlevel . 1))) + (dolist (file todo-files) + (unless (assoc file new-files) + (push (cons file file-rule) new-files))))) + + ;; Update targets and cache + (setq new-files (nreverse new-files)) + (setq org-refile-targets new-files) + (setq cj/org-refile-targets-cache new-files) + (setq cj/org-refile-targets-cache-time (float-time)) + + ;; Always show completion message (interactive or background) + (cj/log-silently "Built refile targets: %d files in %.2f seconds" + (length org-refile-targets) + (- (float-time) (float-time start-time))))) + ;; Always clear the building flag, even if build fails + (setq cj/org-refile-targets-building nil))))) + +;; Build cache asynchronously after startup to avoid blocking Emacs +(run-with-idle-timer + 5 ; Wait 5 seconds after Emacs is idle + nil ; Don't repeat + (lambda () + (cj/log-silently "Building org-refile targets cache in background...") + (cj/build-org-refile-targets))) + +(defun cj/org-refile-refresh-targets () + "Force rebuild of refile targets cache. + +Use this after adding new projects or todo.org files. +Bypasses cache and scans all directories from scratch." (interactive) - (let ((new-files - (list - (cons inbox-file '(:maxlevel . 1)) - (cons reference-file '(:maxlevel . 2)) - (cons schedule-file '(:maxlevel . 1))))) - ;; Extend with org-roam files if available AND org-roam is loaded - (when (and (fboundp 'cj/org-roam-list-notes-by-tag) - (fboundp 'org-roam-node-list)) ; <-- Add this check - (let* ((project-and-topic-files - (append (cj/org-roam-list-notes-by-tag "Project") - (cj/org-roam-list-notes-by-tag "Topic"))) - (file-rule '(:maxlevel . 1))) - (dolist (file project-and-topic-files) - (unless (assoc file new-files) - (push (cons file file-rule) new-files))))) - ;; Add todo.org files from known directories - (dolist (dir (list user-emacs-directory code-dir projects-dir)) - (let* ((todo-files (directory-files-recursively - dir "^[Tt][Oo][Dd][Oo]\\.[Oo][Rr][Gg]$")) - (file-rule '(:maxlevel . 1))) - (dolist (file todo-files) - (unless (assoc file new-files) - (push (cons file file-rule) new-files))))) - (setq org-refile-targets (nreverse new-files)))) - -(add-hook 'emacs-startup-hook #'cj/build-org-refile-targets) + (cj/build-org-refile-targets 'force-rebuild)) (defun cj/org-refile (&optional ARG DEFAULT-BUFFER RFLOC MSG) - "Simply rebuilds the refile targets before calling org-refile. + "Call org-refile with cached refile targets. + +Uses cached targets for performance (instant vs 15-20 seconds). +Cache auto-refreshes after 1 hour or on Emacs restart. + +To manually refresh cache (e.g., after adding projects): + M-x cj/org-refile-refresh-targets ARG DEFAULT-BUFFER RFLOC and MSG parameters passed to org-refile." (interactive "P") + ;; Use cached targets (don't rebuild every time!) (cj/build-org-refile-targets) (org-refile ARG DEFAULT-BUFFER RFLOC MSG)) @@ -72,7 +177,17 @@ ARG DEFAULT-BUFFER RFLOC and MSG parameters passed to org-refile." ;; save all open org buffers after a refile is complete (advice-add 'org-refile :after (lambda (&rest _) - (org-save-all-org-buffers)))) + (org-save-all-org-buffers))) + + ;; Ensure refile target buffers are in org-mode before processing + ;; Fixes issue where buffers opened before org loaded get stuck in fundamental-mode + (advice-add 'org-refile-get-targets :before + (lambda (&rest _) + "Ensure all refile target buffers are in org-mode." + (dolist (target org-refile-targets) + (let ((file (car target))) + (when (stringp file) + (cj/org-refile-ensure-org-mode file))))))) (provide 'org-refile-config) ;;; org-refile-config.el ends here. diff --git a/modules/org-roam-config.el b/modules/org-roam-config.el index 18552b1d..e8132776 100644 --- a/modules/org-roam-config.el +++ b/modules/org-roam-config.el @@ -1,7 +1,15 @@ ;;; org-roam-config.el --- Org-Roam Config -*- lexical-binding: t; coding: utf-8; -*- ;; author: Craig Jennings <c@cjennings.net> ;;; Commentary: -;; Currently a work in progress. The initial version of this was taken from David Wilson: +;; Configuration and utilities for org-roam knowledge management. +;; +;; Key features: +;; - Custom capture templates for different node types (v2mom, recipe, topic) +;; - Automatic moving of completed tasks to daily journal +;; - Tag-based node filtering and finding +;; - Branch extraction to new roam nodes (cj/move-org-branch-to-roam) +;; +;; The initial version was adapted from David Wilson: ;; https://systemcrafters.net/build-a-second-brain-in-emacs/5-org-roam-hacks/ ;;; Code: @@ -11,6 +19,7 @@ ;; ---------------------------------- Org Roam --------------------------------- (use-package org-roam + :defer 1 :commands (org-roam-node-find org-roam-node-insert org-roam-db-autosync-mode) :config ;; Enable autosync mode after org-roam loads @@ -77,7 +86,9 @@ (add-to-list 'org-after-todo-state-change-hook (lambda () (when (and (member org-state org-done-keywords) - (not (member org-last-state org-done-keywords))) + (not (member org-last-state org-done-keywords)) + ;; Don't run for gcal.org - it's synced from Google Calendar + (not (string= (buffer-file-name) (expand-file-name gcal-file)))) (cj/org-roam-copy-todo-to-today))))) ;; ------------------------- Org Roam Insert Immediate ------------------------- @@ -190,6 +201,51 @@ Otherwise return TEXT unchanged." (or description url)) text)) +(defun cj/--generate-roam-slug (title) + "Convert TITLE to a filename-safe slug. +Converts to lowercase, replaces non-alphanumeric characters with hyphens, +and removes leading/trailing hyphens. +Returns the slugified string." + (let ((slug (replace-regexp-in-string + "[^a-zA-Z0-9]+" "-" + (downcase title)))) + (replace-regexp-in-string "^-\\|-$" "" slug))) + +(defun cj/--demote-org-subtree (content from-level to-level) + "Demote org subtree CONTENT from FROM-LEVEL to TO-LEVEL. +CONTENT is the org-mode text with headings. +FROM-LEVEL is the current level of the top heading (integer). +TO-LEVEL is the desired level for the top heading (integer). +Returns the demoted content as a string. +All headings in the tree are adjusted proportionally." + (if (<= from-level to-level) + ;; No demotion needed + content + (let ((demote-count (- from-level to-level))) + (with-temp-buffer + (insert content) + (goto-char (point-min)) + (while (re-search-forward "^\\(\\*+\\) " nil t) + (let* ((stars (match-string 1)) + (level (length stars)) + (new-level (max 1 (- level demote-count))) + (new-stars (make-string new-level ?*))) + (replace-match (concat new-stars " ")))) + (buffer-string))))) + +(defun cj/--format-roam-node (title node-id content) + "Format org-roam node file CONTENT with TITLE and NODE-ID. +TITLE is the node title string. +NODE-ID is the unique identifier for the node. +CONTENT is the main body content (already demoted if needed). +Returns the complete file content as a string." + (concat ":PROPERTIES:\n" + ":ID: " node-id "\n" + ":END:\n" + "#+TITLE: " title "\n" + "#+CATEGORY: " title "\n" + "#+FILETAGS: Topic\n\n" + content)) (defun cj/move-org-branch-to-roam () "Move the org subtree at point to a new org-roam node. @@ -213,12 +269,7 @@ title." (title (cj/org-link-get-description raw-title)) (timestamp (format-time-string "%Y%m%d%H%M%S")) ;; Convert title to filename-safe format - (title-slug (replace-regexp-in-string - "[^a-zA-Z0-9]+" "-" - (downcase title))) - ;; Remove leading/trailing hyphens - (title-slug (replace-regexp-in-string - "^-\\|-$" "" title-slug)) + (title-slug (cj/--generate-roam-slug title)) (filename (format "%s-%s.org" timestamp title-slug)) (filepath (expand-file-name filename org-roam-directory)) ;; Generate a unique ID for the node @@ -234,33 +285,11 @@ title." (org-cut-subtree) ;; Process the subtree to demote it to level 1 - (with-temp-buffer - (org-mode) - (insert subtree-content) - ;; Demote the entire tree so the top level becomes level 1 - (goto-char (point-min)) - (when (> current-level 1) - (let ((demote-count (- current-level 1))) - (while (re-search-forward "^\\*+ " nil t) - (beginning-of-line) - (dotimes (_ demote-count) - (when (looking-at "^\\*\\*") - (delete-char 1))) - (forward-line)))) - (setq subtree-content (buffer-string))) + (setq subtree-content (cj/--demote-org-subtree subtree-content current-level 1)) ;; Create the new org-roam file (with-temp-file filepath - ;; Insert the org-roam template with ID at file level - (insert ":PROPERTIES:\n") - (insert ":ID: " node-id "\n") - (insert ":END:\n") - (insert "#+TITLE: " title "\n") - (insert "#+CATEGORY: " title "\n") - (insert "#+FILETAGS: Topic\n\n") - - ;; Insert the demoted subtree content - (insert subtree-content)) + (insert (cj/--format-roam-node title node-id subtree-content))) ;; Sync the org-roam database (org-roam-db-sync) @@ -268,5 +297,49 @@ title." ;; Message to user (message "'%s' added as an org-roam node." title))) +;; TASK: Need to decide keybindings before implementation and testing +;; (use-package consult-org-roam +;; :ensure t +;; :after org-roam +;; :init +;; (require 'consult-org-roam) +;; ;; Activate the minor mode +;; (consult-org-roam-mode 1) +;; :custom +;; ;; Use `ripgrep' for searching with `consult-org-roam-search' +;; (consult-org-roam-grep-func #'consult-ripgrep) +;; ;; Configure a custom narrow key for `consult-buffer' +;; (consult-org-roam-buffer-narrow-key ?r) +;; ;; Display org-roam buffers right after non-org-roam buffers +;; ;; in consult-buffer (and not down at the bottom) +;; (consult-org-roam-buffer-after-buffers t) +;; :config +;; ;; Eventually suppress previewing for certain functions +;; (consult-customize +;; consult-org-roam-forward-links +;; :preview-key "M-.") +;; :bind +;; ;; Define some convenient keybindings as an addition +;; ("C-c n e" . consult-org-roam-file-find) +;; ("C-c n b" . consult-org-roam-backlinks) +;; ("C-c n B" . consult-org-roam-backlinks-recursive) +;; ("C-c n l" . consult-org-roam-forward-links) +;; ("C-c n r" . consult-org-roam-search)) + + +;; which-key labels +(with-eval-after-load 'which-key + (which-key-add-key-based-replacements + "C-c n" "org-roam menu" + "C-c n l" "roam buffer toggle" + "C-c n f" "roam find node" + "C-c n p" "roam find project" + "C-c n r" "roam find recipe" + "C-c n t" "roam find topic" + "C-c n i" "roam insert node" + "C-c n w" "roam find webclip" + "C-c n I" "roam insert immediate" + "C-c n d" "roam dailies menu")) + (provide 'org-roam-config) ;;; org-roam-config.el ends here. diff --git a/modules/org-webclipper.el b/modules/org-webclipper.el index e8f2cf23..7b024e43 100644 --- a/modules/org-webclipper.el +++ b/modules/org-webclipper.el @@ -11,6 +11,7 @@ ;; - Automatic conversion to Org format using eww-readable and Pandoc ;; - One-click capture from any web page ;; - Preserves page structure and formatting +;; - Smart heading adjustment (removes page title, demotes remaining headings) ;; ;; Setup: ;; 1. Ensure this file is loaded in your Emacs configuration @@ -30,6 +31,11 @@ ;; The clipped content will be added to the file specified by `webclipped-file` ;; under the "Webclipped Inbox" heading with proper formatting and metadata. ;; +;; Architecture: +;; - cj/--process-webclip-content: Pure function for content processing +;; - cj/org-protocol-webclip-handler: Handles URL fetching and capture +;; - cj/org-webclipper-EWW: Direct capture from EWW/W3M buffers +;; ;; Requirements: ;; - org-web-tools package ;; - Pandoc installed on your system @@ -37,23 +43,6 @@ ;;; Code: -;; Declare functions and variables to avoid warnings -(declare-function org-protocol-protocol-alist "org-protocol") -(declare-function org-capture "org-capture") -(declare-function org-capture-get "org-capture") -(declare-function org-web-tools--url-as-readable-org "org-web-tools") -(declare-function org-w3m-copy-for-org-mode "org-w3m") -(declare-function org-eww-copy-for-org-mode "org-eww") -(declare-function org-at-heading-p "org") -(declare-function org-heading-components "org") -(declare-function org-copy-subtree "org") -(declare-function org-cut-subtree "org") -(declare-function org-id-new "org-id") -(declare-function org-roam-db-sync "org-roam") -(defvar org-capture-templates) -(defvar org-protocol-protocol-alist) -(defvar org-roam-directory) -(defvar webclipped-file) ;; Variables for storing org-protocol data (defvar cj/webclip-current-url nil @@ -66,6 +55,9 @@ (defvar cj/webclipper-initialized nil "Track if webclipper has been initialized.") +(use-package org-web-tools + :defer t) + ;; Lazy initialization function (defun cj/webclipper-ensure-initialized () "Ensure webclipper is initialized when first used." @@ -73,6 +65,7 @@ ;; Load required packages now (require 'org-protocol) (require 'org-capture) + (require 'org-web-tools) (require 'user-constants) ;; for webclipped-file ;; Register the org-protocol handler @@ -102,7 +95,28 @@ (setq cj/webclipper-initialized t))) -;;;###autoload +(defun cj/--process-webclip-content (org-content) + "Process webclip ORG-CONTENT by removing first heading and demoting others. +ORG-CONTENT is the raw org-mode text from the web page conversion. +Returns the processed content as a string with: +- First top-level heading removed +- Initial blank lines removed +- All remaining headings demoted by one level" + (with-temp-buffer + (insert org-content) + (goto-char (point-min)) + ;; Skip the first heading line (we'll use our template's heading) + (when (looking-at "^\\* .*\n") + (delete-region (match-beginning 0) (match-end 0))) + ;; Remove any initial blank lines + (while (looking-at "^[ \t]*\n") + (delete-char 1)) + ;; Demote all remaining headings by one level + ;; since our template already provides the top-level heading + (while (re-search-forward "^\\(\\*+\\) " nil t) + (replace-match (concat (match-string 1) "* ") t t)) + (buffer-string))) + (defun cj/org-protocol-webclip (info) "Process org-protocol webclip requests. INFO is a plist containing :url and :title from the org-protocol call." @@ -135,22 +149,7 @@ It fetches the page content and converts it to Org format." (error "No URL provided for clipping") (condition-case err (let* ((org-content (org-web-tools--url-as-readable-org url)) - ;; Process the content to adjust heading levels - (processed-content - (with-temp-buffer - (insert org-content) - (goto-char (point-min)) - ;; Skip the first heading line (we'll use our template's heading) - (when (looking-at "^\\* .*\n") - (delete-region (match-beginning 0) (match-end 0))) - ;; Remove any initial blank lines - (while (looking-at "^[ \t]*\n") - (delete-char 1)) - ;; Demote all remaining headings by one level - ;; since our template already provides the top-level heading - (while (re-search-forward "^\\(\\*+\\) " nil t) - (replace-match (concat (match-string 1) "* ") t t)) - (buffer-string)))) + (processed-content (cj/--process-webclip-content org-content))) ;; Show success message with the title (require 'user-constants) ;; Ensure webclipped-file is available (message "'%s' added to %s" title webclipped-file) @@ -162,7 +161,7 @@ It fetches the page content and converts it to Org format." ;; ---------------------------- Org Webpage Clipper ---------------------------- -;;;###autoload + (defun cj/org-webclipper-EWW () "Capture the current web page for later viewing in an Org file. Return the yanked content as a string so templates can insert it." @@ -182,13 +181,11 @@ Return the yanked content as a string so templates can insert it." ;; extract the webpage content from the kill ring (car kill-ring))) - ;; ----------------------------- Webclipper Keymap ----------------------------- ;; keymaps shouldn't be required for webclipper -;; TASK Move org-branch to roam functionality under org-roam ;; Setup keymaps -;; ;;;###autoload +;; ;; (defun cj/webclipper-setup-keymaps () ;; "Setup webclipper keymaps." ;; (define-prefix-command 'cj/webclipper-map nil @@ -201,7 +198,6 @@ Return the yanked content as a string so templates can insert it." ;; (cj/webclipper-setup-keymaps)) ;; Register protocol handler early for external calls -;;;###autoload (with-eval-after-load 'org-protocol (unless (assoc "webclip" org-protocol-protocol-alist) (add-to-list 'org-protocol-protocol-alist @@ -210,9 +206,9 @@ Return the yanked content as a string so templates can insert it." :function cj/org-protocol-webclip :kill-client t)))) -(with-eval-after-load 'cj/custom-keymap - (require 'org-webclipper) - (cj/webclipper-setup-keymaps)) +;; (with-eval-after-load 'cj/custom-keymap +;; (require 'org-webclipper) +;; (cj/webclipper-setup-keymaps)) (provide 'org-webclipper) ;;; org-webclipper.el ends here diff --git a/modules/popper-config.el b/modules/popper-config.el index b0f503e8..359e789c 100644 --- a/modules/popper-config.el +++ b/modules/popper-config.el @@ -16,6 +16,7 @@ ;;; Code: (use-package popper + :disabled t :bind (("C-`" . popper-toggle) ("M-`" . popper-cycle) ("C-M-`" . popper-toggle-type)) @@ -23,9 +24,11 @@ (popper-display-control-nil) :init (setq popper-reference-buffers - '("\\*Messages\\*" + '( + ;; "\\*Messages\\*" "Output\\*$" "\\*Async Shell Command\\*" + "\\*Async-native-compile-log\\*" help-mode compilation-mode)) (add-to-list 'display-buffer-alist diff --git a/modules/prog-general.el b/modules/prog-general.el index f6ebfe09..0ae6aa82 100644 --- a/modules/prog-general.el +++ b/modules/prog-general.el @@ -93,8 +93,7 @@ ;; --------------------------------- Treesitter -------------------------------- ;; incremental language syntax parser - -(use-package tree-sitter) +;; Using Emacs 29+ built-in treesit with treesit-auto for grammar management ;; installs tree-sitter grammars if they're absent (use-package treesit-auto @@ -251,7 +250,7 @@ If no such file exists there, display a message." (deadgrep term dir)))) (with-eval-after-load 'dired - (keymap-set dired-mode-map "d" #'cj/deadgrep-here)) + (keymap-set dired-mode-map "G" #'cj/deadgrep-here)) ;; ---------------------------------- Snippets --------------------------------- @@ -264,12 +263,8 @@ If no such file exists there, display a message." ("C-c s n" . yas-new-snippet) ("C-c s e" . yas-visit-snippet-file) :config - (setq yas-snippet-dirs '(snippets-dir))) - -(use-package ivy-yasnippet - :after yasnippet - :bind - ("C-c s i" . ivy-yasnippet)) + (setq yas-snippet-dirs (list snippets-dir)) + (yas-reload-all)) ;; --------------------- Display Color On Color Declaration -------------------- ;; display the actual color as highlight to color hex code @@ -400,6 +395,15 @@ If no such file exists there, display a message." "1.5 sec" nil 'delete-windows-on (get-buffer-create "*compilation*")))))) +;; which-key labels +(with-eval-after-load 'which-key + (which-key-add-key-based-replacements + "C-c s" "snippets menu" + "C-c s n" "new snippet" + "C-c s e" "edit snippet" + "C-c s i" "insert snippet" + "C-c p" "projectile menu" + "C-c C-s" "symbol overlay")) (provide 'prog-general) ;;; prog-general.el ends here diff --git a/modules/prog-go.el b/modules/prog-go.el index 465cbf14..0d271617 100644 --- a/modules/prog-go.el +++ b/modules/prog-go.el @@ -31,9 +31,6 @@ Install with: go install golang.org/x/tools/gopls@latest") "Path to Delve debugger. Install with: go install github.com/go-delve/delve/cmd/dlv@latest") -(defvar go-ts-mode-map) -(defvar go-mod-ts-mode-map) - ;; Forward declarations for LSP (declare-function lsp-deferred "lsp-mode") (defvar lsp-go-gopls-server-path) @@ -88,6 +85,9 @@ Install with: go install github.com/go-delve/delve/cmd/dlv@latest") (defun cj/go-mode-keybindings () "Set up keybindings for Go programming. Overrides default prog-mode keybindings with Go-specific commands." + ;; C-; f: Format with gofmt/goimports + (local-set-key (kbd "C-; f") #'gofmt) + ;; S-f5: Run staticcheck (static analysis) (local-set-key (kbd "S-<f5>") #'cj/go-staticcheck) @@ -100,8 +100,6 @@ Overrides default prog-mode keybindings with Go-specific commands." (use-package go-mode :hook ((go-ts-mode . cj/go-setup) (go-ts-mode . cj/go-mode-keybindings)) - :bind (:map go-ts-mode-map - ("C-; f" . gofmt)) ;; Override global formatter with gofmt/goimports :mode (("\\.go\\'" . go-ts-mode) ;; .go files use go-ts-mode ("go\\.mod\\'" . go-mod-ts-mode)) ;; go.mod uses go-mod-ts-mode :config diff --git a/modules/prog-lisp.el b/modules/prog-lisp.el index 7693c253..cfa015ae 100644 --- a/modules/prog-lisp.el +++ b/modules/prog-lisp.el @@ -97,9 +97,12 @@ :commands (with-mock mocklet mocklet-function)) ;; mock/stub framework ;; --------------------------------- Elisp Lint -------------------------------- +;; Comprehensive linting for Emacs Lisp code (indentation, whitespace, etc.) +;; Used by chime.el 'make lint' target for code quality checks (use-package elisp-lint - :commands (elisp-lint-file elisp-lint-directory)) + :ensure t + :commands (elisp-lint-file elisp-lint-directory elisp-lint-files-batch)) ;; ------------------------------ Package Tooling ------------------------------ diff --git a/modules/quick-video-capture.el b/modules/quick-video-capture.el index 100cf04a..4e62309e 100644 --- a/modules/quick-video-capture.el +++ b/modules/quick-video-capture.el @@ -20,6 +20,8 @@ ;;; Code: +(require 'system-lib) + ;; Declare external functions to avoid warnings (declare-function org-capture "org-capture" (&optional goto keys)) (declare-function org-protocol-check-filename-for-protocol "org-protocol" (fname restoffiles client)) @@ -99,7 +101,7 @@ It's designed to be idempotent - safe to call multiple times." :jump-to-captured nil))) (setq cj/video-download-initialized t) - (message "Video download functionality initialized"))) + (cj/log-silently "Video download functionality initialized"))) (defun cj/video-download-bookmarklet-instructions () "Display instructions for setting up the browser bookmarklet." diff --git a/modules/reconcile-open-repos.el b/modules/reconcile-open-repos.el index 648de222..4bd0be7c 100644 --- a/modules/reconcile-open-repos.el +++ b/modules/reconcile-open-repos.el @@ -51,7 +51,7 @@ Magit for review." ;; if git directory is clean, pulling generates no errors (if (string-empty-p (shell-command-to-string "git status --porcelain")) (progn - (let ((pull-result (shell-command "git pull --quiet"))) + (let ((pull-result (shell-command "git pull --rebase --quiet"))) (unless (= pull-result 0) (message "Warning: git pull failed for %s (exit code: %d)" directory pull-result)))) @@ -61,7 +61,7 @@ Magit for review." (let ((stash-result (shell-command "git stash --quiet"))) (if (= stash-result 0) (progn - (let ((pull-result (shell-command "git pull --quiet"))) + (let ((pull-result (shell-command "git pull --rebase --quiet"))) (if (= pull-result 0) (let ((stash-pop-result (shell-command "git stash pop --quiet"))) (unless (= stash-pop-result 0) @@ -73,7 +73,6 @@ Magit for review." ;; ---------------------------- Check For Open Work ---------------------------- -;;;###autoload (defun cj/check-for-open-work () "Check all project directories for open work." (interactive) diff --git a/modules/selection-framework.el b/modules/selection-framework.el index 66ca1cbd..5ace0a5f 100644 --- a/modules/selection-framework.el +++ b/modules/selection-framework.el @@ -27,14 +27,13 @@ (vertico-resize nil) ; Don't resize the minibuffer (vertico-sort-function #'vertico-sort-history-alpha) ; History first, then alphabetical :bind (:map vertico-map - ;; Match ivy's C-j C-k behavior - ("C-j" . vertico-next) - ("C-k" . vertico-previous) - ("C-l" . vertico-insert) ; Insert current candidate - ("RET" . vertico-exit) - ("C-RET" . vertico-exit-input) - ("M-RET" . minibuffer-force-complete-and-exit) - ("TAB" . minibuffer-complete)) + ("C-j" . vertico-next) + ("C-k" . vertico-previous) + ("C-l" . vertico-insert) ; Insert current candidate + ("RET" . vertico-exit) + ("C-RET" . vertico-exit-input) + ("M-RET" . minibuffer-force-complete-and-exit) + ("TAB" . minibuffer-complete)) :init (vertico-mode)) @@ -59,45 +58,45 @@ (use-package consult :demand t :bind (;; C-c bindings (mode-specific-map) - ("C-c h" . consult-history) - ;; C-x bindings (ctl-x-map) - ("C-x M-:" . consult-complex-command) - ("C-x b" . consult-buffer) - ("C-x 4 b" . consult-buffer-other-window) - ("C-x 5 b" . consult-buffer-other-frame) - ("C-x r b" . consult-bookmark) - ("C-x p b" . consult-project-buffer) - ;; M-g bindings (goto-map) - ("M-g e" . consult-compile-error) - ("M-g f" . consult-flymake) - ("M-g g" . consult-goto-line) - ("M-g M-g" . consult-goto-line) - ("M-g o" . consult-outline) - ("M-g m" . consult-mark) - ("M-g k" . consult-global-mark) - ("M-g i" . consult-imenu) - ("M-g I" . consult-imenu-multi) - ;; M-s bindings (search-map) - ("M-s d" . consult-find) - ("M-s D" . consult-locate) - ("M-s g" . consult-grep) - ("M-s G" . consult-git-grep) - ("M-s r" . consult-ripgrep) - ("M-s l" . consult-line) - ("M-s L" . consult-line-multi) - ("M-s k" . consult-keep-lines) - ("M-s u" . consult-focus-lines) - ;; Isearch integration - ("M-s e" . consult-isearch-history) - :map isearch-mode-map - ("M-e" . consult-isearch-history) - ("M-s e" . consult-isearch-history) - ("M-s l" . consult-line) - ("M-s L" . consult-line-multi) - ;; Minibuffer history - :map minibuffer-local-map - ("M-s" . consult-history) - ("M-r" . consult-history)) + ("C-c h" . consult-history) + ;; C-x bindings (ctl-x-map) + ("C-x M-:" . consult-complex-command) + ("C-x b" . consult-buffer) + ("C-x 4 b" . consult-buffer-other-window) + ("C-x 5 b" . consult-buffer-other-frame) + ("C-x r b" . consult-bookmark) + ("C-x p b" . consult-project-buffer) + ;; M-g bindings (goto-map) + ("M-g e" . consult-compile-error) + ("M-g f" . consult-flymake) + ("M-g g" . consult-goto-line) + ("M-g M-g" . consult-goto-line) + ("M-g o" . consult-outline) + ("M-g m" . consult-mark) + ("M-g k" . consult-global-mark) + ("M-g i" . consult-imenu) + ("M-g I" . consult-imenu-multi) + ;; M-s bindings (search-map) + ("M-s d" . consult-find) + ("M-s D" . consult-locate) + ("M-s g" . consult-grep) + ("M-s G" . consult-git-grep) + ("M-s r" . consult-ripgrep) + ("M-s l" . consult-line) + ("M-s L" . consult-line-multi) + ("M-s k" . consult-keep-lines) + ("M-s u" . consult-focus-lines) + ;; Isearch integration + ("M-s e" . consult-isearch-history) + :map isearch-mode-map + ("M-e" . consult-isearch-history) + ("M-s e" . consult-isearch-history) + ("M-s l" . consult-line) + ("M-s L" . consult-line-multi) + ;; Minibuffer history + :map minibuffer-local-map + ("M-s" . consult-history) + ("M-r" . consult-history)) :hook (completion-list-mode . consult-preview-at-point-mode) @@ -106,14 +105,14 @@ ;; preview for =consult-register', =consult-register-load', ;; =consult-register-store' and the Emacs built-ins. (setq register-preview-delay 0.5 - register-preview-function #'consult-register-format) + register-preview-function #'consult-register-format) ;; Optionally tweak the register preview window. (advice-add #'register-preview :override #'consult-register-window) ;; Configure other variables and modes (setq xref-show-xrefs-function #'consult-xref - xref-show-definitions-function #'consult-xref) + xref-show-definitions-function #'consult-xref) :config ;; Configure preview. Default is 'any. @@ -128,7 +127,7 @@ ;; Use Consult for completion-at-point (setq completion-in-region-function #'consult-completion-in-region)) -(global-unset-key (kbd "C-s")) +;; Override default search with consult-line (keymap-global-set "C-s" #'consult-line) ;; Consult integration with Embark @@ -139,9 +138,9 @@ (use-package consult-dir :bind (("C-x C-d" . consult-dir) - :map vertico-map - ("C-x C-d" . consult-dir) - ("C-x C-j" . consult-dir-jump-file)) + :map vertico-map + ("C-x C-d" . consult-dir) + ("C-x C-j" . consult-dir-jump-file)) :config (add-to-list 'consult-dir-sources 'consult-dir--source-tramp-ssh t) (setq consult-dir-project-list-function #'consult-dir-projectile-dirs)) @@ -152,14 +151,14 @@ (use-package orderless :demand t :custom - (completion-styles '(orderless)) + (completion-styles '(orderless basic)) (completion-category-defaults nil) - (completion-category-overrides '((file (styles partial-completion)) - (multi-category (styles orderless)))) + (completion-category-overrides '((file (styles partial-completion orderless basic)) + (multi-category (styles orderless basic)))) (orderless-matching-styles '(orderless-literal - orderless-regexp - orderless-initialism - orderless-prefixes))) + orderless-regexp + orderless-initialism + orderless-prefixes))) ;; ---------------------------------- Embark ----------------------------------- ;; Contextual actions - provides right-click like functionality @@ -179,20 +178,14 @@ :config ;; Hide the mode line of the Embark live/completions buffers (add-to-list 'display-buffer-alist - '("\\`\\*Embark Collect \\(Live\\|Completions\\)\\*" - nil - (window-parameters (mode-line-format . none))))) - -;; this typo causes crashes -;; (add-to-list 'display-buffer-alist -;; '("\\=\\*Embark Collect \\(Live\\|Completions\\)\\*" -;; nil -;; (window-parameters (mode-line-format . none))))) + '("\\`\\*Embark Collect \\(Live\\|Completions\\)\\*" + nil + (window-parameters (mode-line-format . none))))) ;; --------------------------- Consult Integration ---------------------------- ;; Additional integrations for specific features -;; Yasnippet integration - replaces ivy-yasnippet +;; Yasnippet integration (use-package consult-yasnippet :after yasnippet :bind ("C-c s i" . consult-yasnippet)) @@ -201,19 +194,19 @@ (use-package consult-flycheck :after flycheck :bind (:map flycheck-mode-map - ("C-c ! c" . consult-flycheck))) + ("C-c ! c" . consult-flycheck))) ;; ---------------------------------- Company ---------------------------------- -;; In-buffer completion (retained from original configuration) +;; In-buffer completion for text and code (use-package company :demand t :hook (after-init . global-company-mode) :bind (:map company-active-map - ("<tab>" . company-complete-selection) - ("C-n" . company-select-next) - ("C-p" . company-select-previous)) + ("<tab>" . company-complete-selection) + ("C-n" . company-select-next) + ("C-p" . company-select-previous)) :custom (company-backends '(company-capf company-files company-keywords)) (company-idle-delay 2) @@ -227,9 +220,9 @@ :config ;; Disable company in mail-related modes (setq company-global-modes - '(not message-mode - mu4e-compose-mode - org-msg-edit-mode))) + '(not message-mode + mu4e-compose-mode + org-msg-edit-mode))) (use-package company-quickhelp @@ -259,5 +252,23 @@ :config (company-prescient-mode)) +;; -------------------------- Consult Line Or Repeat ------------------------- + +(defun cj/consult-line-or-repeat () + "Call consult-line, or repeat last search if called twice." + (interactive) + (if (eq last-command 'cj/consult-line-or-repeat) + (vertico-repeat) + (consult-line))) +(keymap-global-set "C-s" #'cj/consult-line-or-repeat) + +;; which-key labels +(with-eval-after-load 'which-key + (which-key-add-key-based-replacements + "C-c h" "consult history" + "C-c s i" "insert snippet" + "M-g" "goto menu" + "M-s" "search menu")) + (provide 'selection-framework) ;;; selection-framework.el ends here diff --git a/modules/system-commands.el b/modules/system-commands.el new file mode 100644 index 00000000..fb8c0611 --- /dev/null +++ b/modules/system-commands.el @@ -0,0 +1,138 @@ +;;; system-commands.el --- System power and session management -*- lexical-binding: t; coding: utf-8; -*- +;; author: Craig Jennings <c@cjennings.net> +;; +;;; Commentary: +;; +;; System commands for logout, lock, suspend, shutdown, reboot, and Emacs +;; exit/restart. Provides both a keymap (C-; !) and a completing-read menu. +;; +;; Commands include: +;; - Logout (terminate user session) +;; - Lock screen (slock) +;; - Suspend (systemctl suspend) +;; - Shutdown (systemctl poweroff) +;; - Reboot (systemctl reboot) +;; - Exit Emacs (kill-emacs) +;; - Restart Emacs (via systemctl --user restart emacs.service) +;; +;; Dangerous commands (logout, suspend, shutdown, reboot) require confirmation. +;; +;;; Code: + +(eval-when-compile (require 'keybindings)) +(eval-when-compile (require 'subr-x)) +(require 'rx) + +;; ------------------------------ System Commands ------------------------------ + +(defun cj/system-cmd--resolve (cmd) + "Return (values symbol-or-nil command-string label) for CMD." + (cond + ((symbolp cmd) + (let ((val (and (boundp cmd) (symbol-value cmd)))) + (unless (and (stringp val) (not (string-empty-p val))) + (user-error "Variable %s is not a non-empty string" cmd)) + (list cmd val (symbol-name cmd)))) + ((stringp cmd) + (let ((s (string-trim cmd))) + (when (string-empty-p s) (user-error "Command string is empty")) + (list nil s "command"))) + (t (user-error "Error: cj/system-cmd expects a string or a symbol")))) + +(defun cj/system-cmd (cmd) + "Run CMD (string or symbol naming a string) detached via the shell. +Shell expansions like $(...) are supported. Output is silenced. +If CMD is deemed dangerous, ask for confirmation." + (interactive (list (read-shell-command "System command: "))) + (pcase-let ((`(,sym ,cmdstr ,label) (cj/system-cmd--resolve cmd))) + (when (and sym (get sym 'cj/system-confirm) + (memq (read-char-choice + (format "Run %s now (%s)? (Y/n) " label cmdstr) + '(?y ?Y ?n ?N ?\r ?\n ?\s)) + '(?n ?N))) + (user-error "Aborted")) + (let ((proc (start-process-shell-command "cj/system-cmd" nil + (format "nohup %s >/dev/null 2>&1 &" cmdstr)))) + (set-process-query-on-exit-flag proc nil) + (set-process-sentinel proc #'ignore) + (message "Running %s..." label)))) + +(defmacro cj/defsystem-command (name var cmdstr &optional confirm) + "Define VAR with CMDSTR and interactive command NAME to run it. +If CONFIRM is non-nil, mark VAR to always require confirmation." + (declare (indent defun)) + `(progn + (defvar ,var ,cmdstr) + ,(when confirm `(put ',var 'cj/system-confirm t)) + (defun ,name () + ,(format "Run %s via `cj/system-cmd'." var) + (interactive) + (cj/system-cmd ',var)))) + +;; Define system commands +(cj/defsystem-command cj/system-cmd-logout logout-cmd "loginctl terminate-user $(whoami)" t) +(cj/defsystem-command cj/system-cmd-lock lockscreen-cmd "slock") +(cj/defsystem-command cj/system-cmd-suspend suspend-cmd "systemctl suspend" t) +(cj/defsystem-command cj/system-cmd-shutdown shutdown-cmd "systemctl poweroff" t) +(cj/defsystem-command cj/system-cmd-reboot reboot-cmd "systemctl reboot" t) + +(defun cj/system-cmd-exit-emacs () + "Exit Emacs server and all clients." + (interactive) + (when (memq (read-char-choice + "Exit Emacs? (Y/n) " + '(?y ?Y ?n ?N ?\r ?\n ?\s)) + '(?n ?N)) + (user-error "Aborted")) + (kill-emacs)) + +(defun cj/system-cmd-restart-emacs () + "Restart Emacs server after saving buffers." + (interactive) + (when (memq (read-char-choice + "Restart Emacs? (Y/n) " + '(?y ?Y ?n ?N ?\r ?\n ?\s)) + '(?n ?N)) + (user-error "Aborted")) + (save-some-buffers) + ;; Start the restart process before killing Emacs + (run-at-time 0.5 nil + (lambda () + (call-process-shell-command + "systemctl --user restart emacs.service && emacsclient -c" + nil 0))) + (run-at-time 1 nil #'kill-emacs) + (message "Restarting Emacs...")) + +(defvar-keymap cj/system-command-map + :doc "Keymap for system commands." + "L" #'cj/system-cmd-logout + "r" #'cj/system-cmd-reboot + "s" #'cj/system-cmd-shutdown + "S" #'cj/system-cmd-suspend + "l" #'cj/system-cmd-lock + "E" #'cj/system-cmd-exit-emacs + "e" #'cj/system-cmd-restart-emacs) +(keymap-set cj/custom-keymap "!" cj/system-command-map) + +(defun cj/system-command-menu () + "Present system commands via \='completing-read\='." + (interactive) + (let* ((commands '(("Logout System" . cj/system-cmd-logout) + ("Lock Screen" . cj/system-cmd-lock) + ("Suspend System" . cj/system-cmd-suspend) + ("Shutdown System" . cj/system-cmd-shutdown) + ("Reboot System" . cj/system-cmd-reboot) + ("Exit Emacs" . cj/system-cmd-exit-emacs) + ("Restart Emacs" . cj/system-cmd-restart-emacs))) + (choice (completing-read "System command: " commands nil t))) + (when-let ((cmd (alist-get choice commands nil nil #'equal))) + (call-interactively cmd)))) + +(keymap-set cj/custom-keymap "!" #'cj/system-command-menu) + +(with-eval-after-load 'which-key + (which-key-add-key-based-replacements "C-; !" "system commands")) + +(provide 'system-commands) +;;; system-commands.el ends here diff --git a/modules/system-defaults.el b/modules/system-defaults.el index 52607121..715dcda6 100644 --- a/modules/system-defaults.el +++ b/modules/system-defaults.el @@ -229,6 +229,13 @@ Used to disable functionality with defalias \='somefunc \='cj/disabled)." (setq kept-new-versions 25) ;; keep 25 of the newest backups made (default: 2) (setq vc-make-backup-files t) ;; also backup any files in version control +;; ------------------ Unpropertize Kill Ring For Performance ----------------- + +(defun unpropertize-kill-ring () + (setq kill-ring (mapcar 'substring-no-properties kill-ring))) + +(add-hook 'kill-emacs-hook 'unpropertize-kill-ring) + ;; ------------------------------- GNU 'ls' On BSD ------------------------------- (when (env-bsd-p) diff --git a/modules/system-lib.el b/modules/system-lib.el new file mode 100644 index 00000000..4c2f17ef --- /dev/null +++ b/modules/system-lib.el @@ -0,0 +1,31 @@ +;;; system-lib.el --- System utility library functions -*- lexical-binding: t; -*- +;; +;;; Commentary: +;; This module provides low-level system utility functions for checking +;; the availability of external programs and system capabilities. +;; +;; Functions include: +;; - Checking if external programs are available in PATH +;; - Silent logging to *Messages* buffer +;; +;;; Code: + +(defun cj/executable-exists-p (program) + "Return non-nil if PROGRAM is available in PATH. +PROGRAM should be a string naming an executable program." + (and (stringp program) + (not (string-empty-p program)) + (executable-find program))) + +(defun cj/log-silently (format-string &rest args) + "Append formatted message (FORMAT-STRING with ARGS) to *Messages* buffer. +This does so without echoing in the minibuffer." + (let ((inhibit-read-only t)) + (with-current-buffer (get-buffer-create "*Messages*") + (goto-char (point-max)) + (unless (bolp) (insert "\n")) + (insert (apply #'format format-string args)) + (unless (bolp) (insert "\n"))))) + +(provide 'system-lib) +;;; system-lib.el ends here diff --git a/modules/system-utils.el b/modules/system-utils.el index 6e51c32c..f5af18de 100644 --- a/modules/system-utils.el +++ b/modules/system-utils.el @@ -43,6 +43,9 @@ (message "Error occurred during evaluation: %s" (error-message-string err))))) (keymap-global-set "C-c b" #'cj/eval-buffer-with-confirmation-or-error-message) +(with-eval-after-load 'which-key + (which-key-add-key-based-replacements "C-c b" "eval buffer")) + ;;; ---------------------------- Edit A File With Sudo ---------------------------- (use-package sudo-edit @@ -60,7 +63,7 @@ fully detached from Emacs." (let* ((file (cond ;; In dired/dirvish mode, get file at point ((derived-mode-p 'dired-mode) - (dired-get-file-for-visit)) + (dired-get-file-for-visit)) ;; In a regular file buffer (buffer-file-name buffer-file-name) @@ -131,13 +134,40 @@ Logs output and exit code to buffer *external-open.log*." (keymap-global-set "C-<f10>" #'cj/server-shutdown) ;;; ---------------------------- History Persistence ---------------------------- -;; Persist history over Emacs restarts (use-package savehist :ensure nil ; built-in :config - (savehist-mode) - (setq savehist-file "~/.emacs.d/.emacs-history")) + (setq kill-ring-max 50 + history-length 50) + + (setq savehist-additional-variables + '(kill-ring + command-history + set-variable-value-history + custom-variable-history + query-replace-history + read-expression-history + minibuffer-history + read-char-history + face-name-history + bookmark-history + file-name-history)) + + (put 'minibuffer-history 'history-length 50) + (put 'file-name-history 'history-length 50) + (put 'set-variable-value-history 'history-length 25) + (put 'custom-variable-history 'history-length 25) + (put 'query-replace-history 'history-length 25) + (put 'read-expression-history 'history-length 25) + (put 'read-char-history 'history-length 25) + (put 'face-name-history 'history-length 25) + (put 'bookmark-history 'history-length 25) + + (setq history-delete-duplicates t) + (let (message-log-max) + (savehist-mode)) + ) ;;; ------------------------ List Buffers With Nerd Icons ----------------------- @@ -156,34 +186,33 @@ Logs output and exit code to buffer *external-open.log*." ;;; -------------------------- Scratch Buffer Happiness ------------------------- (defvar scratch-emacs-version-and-system - (concat ";; Emacs " emacs-version - " on " system-configuration ".\n")) -(defvar scratch-greet - (concat ";; Emacs ♥ you, " user-login-name ". Happy Hacking!\n\n")) + (concat "# Emacs " emacs-version " ♥ you, " user-login-name ". Happy Hacking!\n")) +(defvar scratch-greet "\n") (setopt initial-scratch-message (concat scratch-emacs-version-and-system scratch-greet)) +;; Set scratch buffer to org-mode +(setopt initial-major-mode 'org-mode) + +;; Move cursor to end of scratch buffer on startup and set font size to 16pt +(add-hook 'emacs-startup-hook + (lambda () + (when (get-buffer "*scratch*") + (with-current-buffer "*scratch*" + (buffer-face-set :height 160) ; 160 = 16pt (height is in 1/10pt units) + (goto-char (point-max)))))) + ;;; --------------------------------- Dictionary -------------------------------- (use-package quick-sdcv :bind ("C-h d" . quick-sdcv-search-input) + :bind (:map quick-sdcv-mode-map + ("q" . quit-window)) :custom (quick-sdcv-dictionary-prefix-symbol "►") (quick-sdcv-ellipsis " ▼")) -;;; -------------------------------- Log Silently ------------------------------- - -(defun cj/log-silently (format-string &rest args) - "Append formatted message (FORMAT-STRING with ARGS) to *Messages* buffer. -This does so without echoing in the minibuffer." - (let ((inhibit-read-only t)) - (with-current-buffer (get-buffer-create "*Messages*") - (goto-char (point-max)) - (unless (bolp) (insert "\n")) - (insert (apply #'format format-string args)) - (unless (bolp) (insert "\n"))))) - ;;; ------------------------------ Process Monitor ------------------------------ (use-package proced diff --git a/modules/test-runner.el b/modules/test-runner.el index b4c40820..125a8d20 100644 --- a/modules/test-runner.el +++ b/modules/test-runner.el @@ -2,26 +2,75 @@ ;; author: Craig Jennings <c@cjennings.net> ;; ;;; Commentary: -;; Provides utilities for running ERT tests with focus/unfocus workflow + +;; This module provides a powerful ERT test runner with focus/unfocus workflow +;; for efficient test-driven development in Emacs Lisp projects. +;; +;; PURPOSE: +;; +;; When working on large Emacs Lisp projects with many test files, you often +;; want to focus on running just the tests relevant to your current work without +;; waiting for the entire suite to run. This module provides a smart test runner +;; that supports both running all tests and focusing on specific test files. +;; +;; WORKFLOW: +;; +;; 1. Run all tests initially to establish baseline (C-; t R) +;; 2. Add test files to focus while working on a feature (C-; t a) +;; 3. Run focused tests repeatedly as you develop (C-; t r) +;; 4. Add more test files as needed (C-; t b from within test buffer) +;; 5. View your focused test list at any time (C-; t v) +;; 6. Clear focus and run all tests before finishing (C-; t c, then C-; t R) +;; +;; PROJECT INTEGRATION: ;; -;; Tests should be located in the Projectile project test directories, -;; typically "test" or "tests" under the project root. -;; Falls back to =~/.emacs.d/tests= if not in a Projectile project. +;; - Automatically discovers test directories in Projectile projects +;; (looks for "test" or "tests" under project root) +;; - Falls back to ~/.emacs.d/tests if not in a Projectile project +;; - Test files must match pattern: test-*.el ;; -;; The default mode is to load and run all tests. +;; SPECIAL BEHAVIORS: ;; -;; To focus on running a specific set of test files: -;; - Toggle the mode to "focus" mode -;; - Add specific test files to the list of tests in "focus" -;; - Running tests (smartly) will now just run those tests +;; - Smart test running: Automatically runs all or focused tests based on mode +;; - Test extraction: Discovers test names via regex to run specific tests +;; - At-point execution: Run individual test at cursor position (C-; t .) +;; - Error handling: Continues loading tests even if individual files fail ;; -;; Don't forget to run all tests again in default mode at least once before finishing. +;; KEYBINDINGS: +;; +;; C-; t L Load all test files +;; C-; t R Run all tests (full suite) +;; C-; t r Run tests smartly (all or focused based on mode) +;; C-; t . Run test at point +;; C-; t a Add test file to focus (with completion) +;; C-; t b Add current buffer's test file to focus +;; C-; t c Clear all focused test files +;; C-; t v View list of focused test files +;; C-; t t Toggle mode between 'all and 'focused +;; +;; RECOMMENDED USAGE: +;; +;; While implementing a feature: +;; - Add the main test file for the feature you're working on +;; - Add any related test files that might be affected +;; - Use C-; t r to repeatedly run just those focused tests +;; - This provides fast feedback during development +;; +;; Before committing: +;; - Clear the focus with C-; t c +;; - Run the full suite with C-; t R to ensure nothing broke +;; - Verify all tests pass before pushing changes ;; ;;; Code: (require 'ert) (require 'cl-lib) +;;; External Variables and Functions + +(defvar cj/custom-keymap) ; Defined in init.el +(declare-function projectile-project-root "projectile" ()) + ;;; Variables (defvar cj/test-global-directory nil @@ -35,19 +84,19 @@ Each element is a filename (without path) to run.") (defvar cj/test-mode 'all "Current test execution mode. -Either 'all (run all tests) or 'focused (run only focused tests).") +Either \\='all (run all tests) or \\='focused (run only focused tests).") (defvar cj/test-last-results nil "Results from the last test run.") ;;; Core Functions -;;;###autoload (defun cj/test--get-test-directory () "Return the test directory path for the current project. -If in a Projectile project, prefers a 'test' or 'tests' directory inside the project root. -Falls back to =cj/test-global-directory= if not found or not in a project." +If in a Projectile project, prefers \\='test or \\='tests directory +inside the project root. Falls back to `cj/test-global-directory' +if not found or not in a project." (require 'projectile) (let ((project-root (ignore-errors (projectile-project-root)))) (if (not (and project-root (file-directory-p project-root))) @@ -60,15 +109,32 @@ Falls back to =cj/test-global-directory= if not found or not in a project." ((file-directory-p tests-dir) tests-dir) (t cj/test-global-directory)))))) -;;;###autoload (defun cj/test--get-test-files () - "Return a list of test file names (without path) in the appropriate test directory." + "Return list of test file names (without path) in test directory." (let ((dir (cj/test--get-test-directory))) (when (file-directory-p dir) (mapcar #'file-name-nondirectory (directory-files dir t "^test-.*\\.el$"))))) -;;;###autoload +(defun cj/test--do-load-files (_dir files) + "Load test FILES from DIR. +Returns: (cons \\='success loaded-count) on success, + (cons \\='error (list failed-files errors)) on errors." + (let ((loaded-count 0) + (errors '())) + (dolist (file files) + (condition-case err + (progn + (load-file file) + (setq loaded-count (1+ loaded-count))) + (error + (push (cons (file-name-nondirectory file) + (error-message-string err)) + errors)))) + (if (null errors) + (cons 'success loaded-count) + (cons 'error (list loaded-count (nreverse errors)))))) + (defun cj/test-load-all () "Load all test files from the appropriate test directory." (interactive) @@ -76,21 +142,27 @@ Falls back to =cj/test-global-directory= if not found or not in a project." (let ((dir (cj/test--get-test-directory))) (unless (file-directory-p dir) (user-error "Test directory %s does not exist" dir)) - (let ((test-files (directory-files dir t "^test-.*\\.el$")) - (loaded-count 0)) - (dolist (file test-files) - (condition-case err - (progn - (load-file file) - (setq loaded-count (1+ loaded-count)) - (message "Loaded test file: %s" (file-name-nondirectory file))) - (error - (message "Error loading %s: %s" - (file-name-nondirectory file) - (error-message-string err))))) - (message "Loaded %d test file(s)" loaded-count)))) - -;;;###autoload + (let ((test-files (directory-files dir t "^test-.*\\.el$"))) + (pcase (cj/test--do-load-files dir test-files) + (`(success . ,count) + (message "Loaded %d test file(s)" count)) + (`(error ,count ,errors) + (dolist (err errors) + (message "Error loading %s: %s" (car err) (cdr err))) + (message "Loaded %d test file(s) with %d error(s)" count (length errors))))))) + +(defun cj/test--do-focus-add (filename available-files focused-files) + "Add FILENAME to focused test files. +AVAILABLE-FILES is the list of all available test files. +FOCUSED-FILES is the current list of focused files. +Returns: \\='success if added successfully, + \\='already-focused if file is already focused, + \\='not-available if file is not in available-files." + (cond + ((not (member filename available-files)) 'not-available) + ((member filename focused-files) 'already-focused) + (t 'success))) + (defun cj/test-focus-add () "Select test file(s) to add to the focused list." (interactive) @@ -109,30 +181,64 @@ Falls back to =cj/test-global-directory= if not found or not in a project." unfocused-files nil t) (user-error "All test files are already focused")))) - (push selected cj/test-focused-files) - (message "Added to focus: %s" selected) - (when (called-interactively-p 'interactive) - (cj/test-view-focused)))))) + (pcase (cj/test--do-focus-add selected available-files cj/test-focused-files) + ('success + (push selected cj/test-focused-files) + (message "Added to focus: %s" selected) + (when (called-interactively-p 'interactive) + (cj/test-view-focused))) + ('already-focused + (message "Already focused: %s" selected)) + ('not-available + (user-error "File not available: %s" selected))))))) + +(defun cj/test--do-focus-add-file (filepath testdir focused-files) + "Validate and add FILEPATH to focused list. +TESTDIR is the test directory path. +FOCUSED-FILES is the current list of focused files. +Returns: \\='success if added successfully, + \\='no-file if filepath is nil, + \\='not-in-testdir if file is not inside test directory, + \\='already-focused if file is already focused. +Second value is the relative filename if successful." + (cond + ((null filepath) (cons 'no-file nil)) + ((not (string-prefix-p (file-truename testdir) (file-truename filepath))) + (cons 'not-in-testdir nil)) + (t + (let ((relative (file-relative-name filepath testdir))) + (if (member relative focused-files) + (cons 'already-focused relative) + (cons 'success relative)))))) -;;;###autoload (defun cj/test-focus-add-this-buffer-file () "Add the current buffer's file to the focused test list." (interactive) (let ((file (buffer-file-name)) (dir (cj/test--get-test-directory))) - (unless file - (user-error "Current buffer is not visiting a file")) - (unless (string-prefix-p (file-truename dir) (file-truename file)) - (user-error "File is not inside the test directory: %s" dir)) - (let ((relative (file-relative-name file dir))) - (if (member relative cj/test-focused-files) - (message "Already focused: %s" relative) - (push relative cj/test-focused-files) - (message "Added to focus: %s" relative) - (when (called-interactively-p 'interactive) - (cj/test-view-focused)))))) - -;;;###autoload + (pcase (cj/test--do-focus-add-file file dir cj/test-focused-files) + (`(no-file . ,_) + (user-error "Current buffer is not visiting a file")) + (`(not-in-testdir . ,_) + (user-error "File is not inside the test directory: %s" dir)) + (`(already-focused . ,relative) + (message "Already focused: %s" relative)) + (`(success . ,relative) + (push relative cj/test-focused-files) + (message "Added to focus: %s" relative) + (when (called-interactively-p 'interactive) + (cj/test-view-focused)))))) + +(defun cj/test--do-focus-remove (filename focused-files) + "Remove FILENAME from FOCUSED-FILES. +Returns: \\='success if removed successfully, + \\='empty-list if focused-files is empty, + \\='not-found if filename is not in focused-files." + (cond + ((null focused-files) 'empty-list) + ((not (member filename focused-files)) 'not-found) + (t 'success))) + (defun cj/test-focus-remove () "Remove a test file from the focused list." (interactive) @@ -141,13 +247,18 @@ Falls back to =cj/test-global-directory= if not found or not in a project." (let ((selected (completing-read "Remove from focus: " cj/test-focused-files nil t))) - (setq cj/test-focused-files - (delete selected cj/test-focused-files)) - (message "Removed from focus: %s" selected) - (when (called-interactively-p 'interactive) - (cj/test-view-focused))))) + (pcase (cj/test--do-focus-remove selected cj/test-focused-files) + ('success + (setq cj/test-focused-files + (delete selected cj/test-focused-files)) + (message "Removed from focus: %s" selected) + (when (called-interactively-p 'interactive) + (cj/test-view-focused))) + ('not-found + (message "File not in focused list: %s" selected)) + ('empty-list + (user-error "No focused files to remove")))))) -;;;###autoload (defun cj/test-focus-clear () "Clear all focused test files." (interactive) @@ -168,73 +279,82 @@ Returns a list of test name symbols defined in the file." (push (match-string 1) test-names))) test-names)) -;;;###autoload +(defun cj/test--do-get-focused-tests (focused-files test-dir) + "Get test names from FOCUSED-FILES in TEST-DIR. +Returns: (cons \\='success (list test-names loaded-count)) if successful, + (cons \\='no-tests nil) if no tests found, + (cons \\='empty-list nil) if focused-files is empty." + (if (null focused-files) + (cons 'empty-list nil) + (let ((all-test-names '()) + (loaded-count 0)) + (dolist (file focused-files) + (let ((full-path (expand-file-name file test-dir))) + (when (file-exists-p full-path) + (load-file full-path) + (setq loaded-count (1+ loaded-count)) + (let ((test-names (cj/test--extract-test-names full-path))) + (setq all-test-names (append all-test-names test-names)))))) + (if (null all-test-names) + (cons 'no-tests nil) + (cons 'success (list all-test-names loaded-count)))))) + (defun cj/test-run-focused () "Run only the focused test files." (interactive) - (if (null cj/test-focused-files) - (user-error "No focused files set. Use =cj/test-focus-add' first") - (let ((all-test-names '()) - (loaded-count 0) - (dir (cj/test--get-test-directory))) - ;; Load the focused files and collect their test names - (dolist (file cj/test-focused-files) - (let ((full-path (expand-file-name file dir))) - (when (file-exists-p full-path) - (load-file full-path) - (setq loaded-count (1+ loaded-count)) - ;; Extract test names from this file - (let ((test-names (cj/test--extract-test-names full-path))) - (setq all-test-names (append all-test-names test-names)))))) - (if (null all-test-names) - (message "No tests found in focused files") - ;; Build a regexp that matches any of our test names - (let ((pattern (regexp-opt all-test-names))) - (message "Running %d test(s) from %d focused file(s)" - (length all-test-names) loaded-count) - ;; Run only the tests we found - (ert (concat "^" pattern "$"))))))) + (let ((dir (cj/test--get-test-directory))) + (pcase (cj/test--do-get-focused-tests cj/test-focused-files dir) + (`(empty-list . ,_) + (user-error "No focused files set. Use =cj/test-focus-add' first")) + (`(no-tests . ,_) + (message "No tests found in focused files")) + (`(success ,test-names ,loaded-count) + (let ((pattern (regexp-opt test-names))) + (message "Running %d test(s) from %d focused file(s)" + (length test-names) loaded-count) + (ert (concat "^" pattern "$"))))))) (defun cj/test--ensure-test-dir-in-load-path () - "Ensure the directory returned by cj/test--get-test-directory is in `load-path`." + "Ensure test directory is in `load-path'." (let ((dir (cj/test--get-test-directory))) (when (and dir (file-directory-p dir)) (add-to-list 'load-path dir)))) -;;;###autoload +(defun cj/test--extract-test-at-pos () + "Extract test name at current position. +Returns: test name symbol if found, nil otherwise." + (save-excursion + (beginning-of-defun) + (condition-case nil + (let ((form (read (current-buffer)))) + (when (and (listp form) + (eq (car form) 'ert-deftest) + (symbolp (cadr form))) + (cadr form))) + (error nil)))) + (defun cj/run-test-at-point () "Run the ERT test at point. If point is inside an `ert-deftest` definition, run that test only. Otherwise, message that no test is found." (interactive) - (let ((original-point (point))) - (save-excursion - (beginning-of-defun) - (condition-case nil - (let ((form (read (current-buffer)))) - (if (and (listp form) - (eq (car form) 'ert-deftest) - (symbolp (cadr form))) - (ert (cadr form)) - (message "Not in an ERT test method."))) - (error (message "No ERT test methods found at point.")))) - (goto-char original-point))) - -;;;###autoload + (let ((test-name (cj/test--extract-test-at-pos))) + (if test-name + (ert test-name) + (message "Not in an ERT test method.")))) + (defun cj/test-run-all () "Load and run all tests." (interactive) (cj/test-load-all) (ert t)) -;;;###autoload (defun cj/test-toggle-mode () - "Toggle between 'all and 'focused test execution modes." + "Toggle between \\='all and \\='focused test execution modes." (interactive) (setq cj/test-mode (if (eq cj/test-mode 'all) 'focused 'all)) (message "Test mode: %s" cj/test-mode)) -;;;###autoload (defun cj/test-view-focused () "Display test files in focus." (interactive) @@ -243,7 +363,6 @@ Otherwise, message that no test is found." (message "Focused files: %s" (mapconcat 'identity cj/test-focused-files ", ")))) -;;;###autoload (defun cj/test-run-smart () "Run tests based on current mode (all or focused)." (interactive) @@ -265,8 +384,20 @@ Otherwise, message that no test is found." "t" #'cj/test-toggle-mode) (keymap-set cj/custom-keymap "t" cj/testrunner-map) + +;; which-key integration (with-eval-after-load 'which-key - (which-key-add-key-based-replacements "C-; t" "test runner menu")) + (which-key-add-key-based-replacements + "C-; t" "test runner menu" + "C-; t L" "load all tests" + "C-; t R" "run all tests" + "C-; t r" "run smart" + "C-; t ." "run test at point" + "C-; t a" "add to focus" + "C-; t b" "add buffer to focus" + "C-; t c" "clear focus" + "C-; t v" "view focused" + "C-; t t" "toggle mode")) (provide 'test-runner) ;;; test-runner.el ends here diff --git a/modules/text-config.el b/modules/text-config.el index 730e36a3..29db9e0b 100644 --- a/modules/text-config.el +++ b/modules/text-config.el @@ -46,8 +46,7 @@ ;; change inner and outer, just like in vim. (use-package change-inner - :bind (("C-c i" . change-inner) - ("C-c o" . change-outer))) + :commands (change-inner change-outer)) ;; ------------------------------ Delete Selection ----------------------------- ;; delete the region on character insertion diff --git a/modules/transcription-config.el b/modules/transcription-config.el new file mode 100644 index 00000000..5349ade0 --- /dev/null +++ b/modules/transcription-config.el @@ -0,0 +1,397 @@ +;;; transcription-config.el --- Audio transcription workflow -*- lexical-binding: t; -*- + +;; Author: Craig Jennings <c@cjennings.net> +;; Created: 2025-11-04 + +;;; Commentary: +;; +;; Audio transcription workflow with multiple backend options. +;; +;; USAGE: +;; In dired: Press `T` on an audio file to transcribe +;; Anywhere: M-x cj/transcribe-audio +;; View active: M-x cj/transcriptions-buffer +;; Switch backend: C-; T b (or M-x cj/transcription-switch-backend) +;; +;; OUTPUT FILES: +;; audio.m4a → audio.txt (transcript) +;; → audio.log (process logs, conditionally kept) +;; +;; BACKENDS: +;; - 'openai-api: Fast cloud transcription +;; API key retrieved from authinfo.gpg (machine api.openai.com) +;; - 'assemblyai: Cloud transcription with speaker diarization +;; API key retrieved from authinfo.gpg (machine api.assemblyai.com) +;; - 'local-whisper: Local transcription (requires whisper installed) +;; +;; NOTIFICATIONS: +;; - "Transcription started on <file>" +;; - "Transcription complete. Transcript in <file.txt>" +;; - "Transcription errored. Logs in <file.log>" +;; +;; MODELINE: +;; Shows active transcription count: ⏺2 +;; Click to view *Transcriptions* buffer +;; +;;; Code: + +(require 'dired) +(require 'notifications) +(require 'auth-source) +(require 'user-constants) ; For cj/audio-file-extensions + +;; Declare keymap defined in keybindings.el +(eval-when-compile (defvar cj/custom-keymap)) + +;; ----------------------------- Configuration --------------------------------- + +(defvar cj/transcribe-backend 'assemblyai + "Transcription backend to use. +- `openai-api': Fast cloud transcription via OpenAI API +- `assemblyai': Cloud transcription with speaker diarization via AssemblyAI +- `local-whisper': Local transcription using installed Whisper") + +(defvar cj/transcription-keep-log-when-done nil + "Whether to keep log files after successful transcription. +If nil, log files are deleted after successful completion. +If t, log files are always kept. +Log files are always kept on error regardless of this setting.") + +(defvar cj/transcriptions-list '() + "List of active transcriptions. +Each entry: (process audio-file start-time status) +Status: running, complete, error") + +;; ----------------------------- Pure Functions -------------------------------- + +(defun cj/--audio-file-p (file) + "Return non-nil if FILE is an audio file based on extension." + (when (and file (stringp file)) + (when-let ((ext (file-name-extension file))) + (member (downcase ext) cj/audio-file-extensions)))) + +(defun cj/--transcription-output-files (audio-file) + "Return cons cell of (TXT-FILE . LOG-FILE) for AUDIO-FILE." + (let ((base (file-name-sans-extension audio-file))) + (cons (concat base ".txt") + (concat base ".log")))) + +(defun cj/--transcription-duration (start-time) + "Return duration string (MM:SS) since START-TIME." + (let* ((elapsed (float-time (time-subtract (current-time) start-time))) + (minutes (floor (/ elapsed 60))) + (seconds (floor (mod elapsed 60)))) + (format "%02d:%02d" minutes seconds))) + +(defun cj/--should-keep-log (success-p) + "Return non-nil if log file should be kept. +SUCCESS-P indicates whether transcription succeeded." + (or (not success-p) ; Always keep on error + cj/transcription-keep-log-when-done)) + +(defun cj/--transcription-script-path () + "Return absolute path to transcription script based on backend." + (let ((script-name (pcase cj/transcribe-backend + ('openai-api "oai-transcribe") + ('assemblyai "assemblyai-transcribe") + ('local-whisper "local-whisper")))) + (expand-file-name (concat "scripts/" script-name) user-emacs-directory))) + +(defun cj/--get-openai-api-key () + "Retrieve OpenAI API key from authinfo.gpg. +Expects entry in authinfo.gpg: + machine api.openai.com login api password sk-... +Returns the API key string, or nil if not found." + (when-let* ((auth-info (car (auth-source-search + :host "api.openai.com" + :require '(:secret)))) + (secret (plist-get auth-info :secret))) + (if (functionp secret) + (funcall secret) + secret))) + +(defun cj/--get-assemblyai-api-key () + "Retrieve AssemblyAI API key from authinfo.gpg. +Expects entry in authinfo.gpg: + machine api.assemblyai.com login api password <key> +Returns the API key string, or nil if not found." + (when-let* ((auth-info (car (auth-source-search + :host "api.assemblyai.com" + :require '(:secret)))) + (secret (plist-get auth-info :secret))) + (if (functionp secret) + (funcall secret) + secret))) + +;; ---------------------------- Process Management ----------------------------- + +(defun cj/--notify (title message &optional urgency) + "Send desktop notification and echo area message. +TITLE and MESSAGE are strings. URGENCY is normal or critical." + (message "%s: %s" title message) + (when (and (fboundp 'notifications-notify) + (getenv "DISPLAY")) + (notifications-notify + :title title + :body message + :urgency (or urgency 'normal)))) + +(defun cj/--start-transcription-process (audio-file) + "Start async transcription process for AUDIO-FILE. +Returns the process object." + (unless (file-exists-p audio-file) + (user-error "Audio file does not exist: %s" audio-file)) + + (unless (cj/--audio-file-p audio-file) + (user-error "Not an audio file: %s" audio-file)) + + (let* ((script (cj/--transcription-script-path)) + (outputs (cj/--transcription-output-files audio-file)) + (txt-file (car outputs)) + (log-file (cdr outputs)) + (buffer-name (format " *transcribe-%s*" (file-name-nondirectory audio-file))) + (process-name (format "transcribe-%s" (file-name-nondirectory audio-file)))) + + (unless (file-executable-p script) + (user-error "Transcription script not found or not executable: %s" script)) + + ;; Create log file + (with-temp-file log-file + (insert (format "Transcription started: %s\n" (current-time-string)) + (format "Backend: %s\n" cj/transcribe-backend) + (format "Audio file: %s\n" audio-file) + (format "Script: %s\n\n" script))) + + ;; Start process with environment + (let* ((process-environment + ;; Add API key to environment based on backend + (pcase cj/transcribe-backend + ('openai-api + (if-let ((api-key (cj/--get-openai-api-key))) + (cons (format "OPENAI_API_KEY=%s" api-key) + process-environment) + (user-error "OpenAI API key not found in authinfo.gpg for host api.openai.com"))) + ('assemblyai + (if-let ((api-key (cj/--get-assemblyai-api-key))) + (cons (format "ASSEMBLYAI_API_KEY=%s" api-key) + process-environment) + (user-error "AssemblyAI API key not found in authinfo.gpg for host api.assemblyai.com"))) + (_ process-environment))) + (process (make-process + :name process-name + :buffer (get-buffer-create buffer-name) + :command (list script audio-file) + :sentinel (lambda (proc event) + (cj/--transcription-sentinel proc event audio-file txt-file log-file)) + :stderr log-file))) + + ;; Track transcription + (push (list process audio-file (current-time) 'running) cj/transcriptions-list) + (force-mode-line-update t) + + ;; Notify user + (cj/--notify "Transcription" + (format "Started on %s" (file-name-nondirectory audio-file))) + + process))) + +(defun cj/--transcription-sentinel (process event audio-file txt-file log-file) + "Sentinel for transcription PROCESS. +EVENT is the process event string. +AUDIO-FILE, TXT-FILE, and LOG-FILE are the associated files." + (let* ((success-p (and (string-match-p "finished" event) + (= 0 (process-exit-status process)))) + (process-buffer (process-buffer process)) + (entry (assq process cj/transcriptions-list))) + + ;; Write process output to txt file + (when (and success-p (buffer-live-p process-buffer)) + (with-current-buffer process-buffer + (write-region (point-min) (point-max) txt-file nil 'silent))) + + ;; Append process output to log file + (when (buffer-live-p process-buffer) + (with-temp-buffer + (insert-file-contents log-file) + (goto-char (point-max)) + (insert "\n" (format-time-string "[%Y-%m-%d %H:%M:%S] ") event "\n") + (insert-buffer-substring process-buffer) + (write-region (point-min) (point-max) log-file nil 'silent))) + + ;; Update transcription status + (when entry + (setf (nth 3 entry) (if success-p 'complete 'error))) + + ;; Cleanup log file if successful and configured to do so + (when (and success-p (not (cj/--should-keep-log t))) + (delete-file log-file)) + + ;; Kill process buffer + (when (buffer-live-p process-buffer) + (kill-buffer process-buffer)) + + ;; Notify user + (if success-p + (cj/--notify "Transcription" + (format "Complete. Transcript in %s" (file-name-nondirectory txt-file))) + (cj/--notify "Transcription" + (format "Errored. Logs in %s" (file-name-nondirectory log-file)) + 'critical)) + + ;; Clean up completed transcriptions after 10 minutes + (run-at-time 600 nil #'cj/--cleanup-completed-transcriptions) + + ;; Update modeline + (force-mode-line-update t))) + +(defun cj/--cleanup-completed-transcriptions () + "Remove completed/errored transcriptions from tracking list." + (setq cj/transcriptions-list + (seq-filter (lambda (entry) + (eq (nth 3 entry) 'running)) + cj/transcriptions-list)) + (force-mode-line-update t)) + +(defun cj/--count-active-transcriptions () + "Return count of running transcriptions." + (length (seq-filter (lambda (entry) + (eq (nth 3 entry) 'running)) + cj/transcriptions-list))) + +;; ----------------------------- Modeline Integration -------------------------- + +(defun cj/--transcription-modeline-string () + "Return modeline string for active transcriptions." + (let ((count (cj/--count-active-transcriptions))) + (when (> count 0) + (propertize (format " ⏺%d " count) + 'face 'warning + 'help-echo (format "%d active transcription%s (click to view)" + count (if (= count 1) "" "s")) + 'mouse-face 'mode-line-highlight + 'local-map (let ((map (make-sparse-keymap))) + (define-key map [mode-line mouse-1] + #'cj/transcriptions-buffer) + map))))) + +;; Add to mode-line-format (will be activated when module loads) +(add-to-list 'mode-line-misc-info + '(:eval (cj/--transcription-modeline-string)) + t) + +;; --------------------------- Interactive Commands ---------------------------- + +;;;###autoload +(defun cj/transcribe-audio (audio-file) + "Transcribe AUDIO-FILE asynchronously. +Creates AUDIO.txt with transcript and AUDIO.log with process logs. +Uses backend specified by `cj/transcribe-backend'." + (interactive (list (read-file-name "Audio file to transcribe: " + nil nil t nil + #'cj/--audio-file-p))) + (cj/--start-transcription-process (expand-file-name audio-file))) + +;;;###autoload +(defun cj/transcribe-audio-at-point () + "Transcribe audio file at point in dired." + (interactive) + (unless (derived-mode-p 'dired-mode) + (user-error "Not in dired-mode")) + (let ((file (dired-get-filename nil t))) + (unless file + (user-error "No file at point")) + (cj/transcribe-audio file))) + +;;;###autoload +(defun cj/transcriptions-buffer () + "Show buffer with active transcriptions." + (interactive) + (let ((buffer (get-buffer-create "*Transcriptions*"))) + (with-current-buffer buffer + (let ((inhibit-read-only t)) + (erase-buffer) + (insert (propertize "Active Transcriptions\n" 'face 'bold) + (propertize (make-string 50 ?─) 'face 'shadow) + "\n\n") + (if (null cj/transcriptions-list) + (insert "No active transcriptions.\n") + (dolist (entry cj/transcriptions-list) + (let* ((process (nth 0 entry)) + (audio-file (nth 1 entry)) + (start-time (nth 2 entry)) + (status (nth 3 entry)) + (duration (cj/--transcription-duration start-time)) + (status-face (pcase status + ('running 'warning) + ('complete 'success) + ('error 'error)))) + (insert (propertize (format "%-10s" status) 'face status-face) + " " + (file-name-nondirectory audio-file) + (format " (%s)\n" duration)))))) + (goto-char (point-min)) + (special-mode)) + (display-buffer buffer))) + +;;;###autoload +(defun cj/transcription-kill (process) + "Kill transcription PROCESS." + (interactive + (list (let ((choices (mapcar (lambda (entry) + (cons (file-name-nondirectory (nth 1 entry)) + (nth 0 entry))) + cj/transcriptions-list))) + (unless choices + (user-error "No active transcriptions")) + (cdr (assoc (completing-read "Kill transcription: " choices nil t) + choices))))) + (when (process-live-p process) + (kill-process process) + (message "Killed transcription process"))) + +;;;###autoload +(defun cj/transcription-switch-backend () + "Switch transcription backend. +Prompts with completing-read to select from available backends." + (interactive) + (let* ((backends '(("assemblyai" . assemblyai) + ("openai-api" . openai-api) + ("local-whisper" . local-whisper))) + (current (symbol-name cj/transcribe-backend)) + (prompt (format "Transcription backend (current: %s): " current)) + (choice (completing-read prompt backends nil t)) + (new-backend (alist-get choice backends nil nil #'string=))) + (setq cj/transcribe-backend new-backend) + (message "Transcription backend: %s" choice))) + +;; ------------------------------- Dired Integration --------------------------- + +(with-eval-after-load 'dired + (define-key dired-mode-map (kbd "T") #'cj/transcribe-audio-at-point)) + +;; Dirvish inherits dired-mode-map, so T works automatically + +;; ------------------------------- Global Keybindings -------------------------- + +;; Transcription keymap +(defvar-keymap cj/transcribe-map + :doc "Keymap for transcription operations" + "a" #'cj/transcribe-audio + "b" #'cj/transcription-switch-backend + "v" #'cj/transcriptions-buffer + "k" #'cj/transcription-kill) + +;; Only set keybinding if cj/custom-keymap is bound (not in batch mode) +(when (boundp 'cj/custom-keymap) + (keymap-set cj/custom-keymap "T" cj/transcribe-map)) + +(with-eval-after-load 'which-key + (which-key-add-key-based-replacements + "C-; T" "transcription menu" + "C-; T a" "transcribe audio" + "C-; T b" "switch backend" + "C-; T v" "view transcriptions" + "C-; T k" "kill transcription")) + +(provide 'transcription-config) +;;; transcription-config.el ends here diff --git a/modules/ui-config.el b/modules/ui-config.el index 91dbaf31..775aefb2 100644 --- a/modules/ui-config.el +++ b/modules/ui-config.el @@ -36,11 +36,8 @@ "Opacity level for Emacs frames when `cj/enable-transparency' is non-nil. 100 = fully opaque, 0 = fully transparent.") -(defconst cj/cursor-colors - '((read-only . "#f06a3f") ; red – buffer is read-only - (overwrite . "#c48702") ; gold – overwrite mode - (normal . "#64aa0f")) ; green – insert & read/write - "Alist mapping cursor states to their colors.") +;; Use buffer status colors from user-constants +(require 'user-constants) ;; ----------------------------- System UI Settings ---------------------------- @@ -53,7 +50,8 @@ (setq use-file-dialog nil) ;; no file dialog (setq use-dialog-box nil) ;; no dialog boxes either -(column-number-mode 1) ;; show column number in the modeline +(line-number-mode 1) ;; show line number in the modeline (cached) +(column-number-mode 1) ;; show column number in the modeline (cached) (setq switch-to-buffer-obey-display-actions t) ;; manual buffer switching obeys display action rules ;; -------------------------------- Transparency ------------------------------- @@ -99,23 +97,27 @@ When `cj/enable-transparency' is nil, reset alpha to fully opaque." "Last buffer name where cursor color was applied.") (defun cj/set-cursor-color-according-to-mode () - "Change cursor color according to \\='buffer-read-only or \\='overwrite state." - (let* ((state (cond - (buffer-read-only 'read-only) - (overwrite-mode 'overwrite) - (t 'normal))) - (color (alist-get state cj/cursor-colors))) - (unless (and (string= color cj/-cursor-last-color) - (string= (buffer-name) cj/-cursor-last-buffer)) - (set-cursor-color color) - (setq cj/-cursor-last-color color - cj/-cursor-last-buffer (buffer-name))))) - -;; Use more efficient hooks instead of post-command-hook for better performance -(add-hook 'window-buffer-change-functions - (lambda (_window) (cj/set-cursor-color-according-to-mode))) -(add-hook 'read-only-mode-hook #'cj/set-cursor-color-according-to-mode) -(add-hook 'overwrite-mode-hook #'cj/set-cursor-color-according-to-mode) + "Change cursor color according to buffer state (modified, read-only, overwrite). +Only updates for real user buffers, not internal/temporary buffers." + ;; Only update cursor for real buffers (not internal ones like *temp*, *Echo Area*, etc.) + (unless (string-prefix-p " " (buffer-name)) ; Internal buffers start with space + (let* ((state (cond + (buffer-read-only 'read-only) + (overwrite-mode 'overwrite) + ((buffer-modified-p) 'modified) + (t 'unmodified))) + (color (alist-get state cj/buffer-status-colors))) + ;; Only skip if BOTH color AND buffer are the same (optimization) + ;; This allows color to update when buffer state changes + (unless (and (string= color cj/-cursor-last-color) + (string= (buffer-name) cj/-cursor-last-buffer)) + (set-cursor-color color) + (setq cj/-cursor-last-color color + cj/-cursor-last-buffer (buffer-name)))))) + +;; Use post-command-hook to update cursor color after every command +;; This ensures cursor color always matches the current buffer's state +(add-hook 'post-command-hook #'cj/set-cursor-color-according-to-mode) ;; Don’t show a cursor in non-selected windows: (setq cursor-in-non-selected-windows nil) diff --git a/modules/undead-buffers.el b/modules/undead-buffers.el index 50c9bb9c..fa09e04a 100644 --- a/modules/undead-buffers.el +++ b/modules/undead-buffers.el @@ -2,12 +2,12 @@ ;;; Commentary: ;; -;; This library allows for “burying” selected buffers instead of killing them. +;; This library allows for "burying" selected buffers instead of killing them. ;; Since they won't be killed, I'm calling them "undead buffers". ;; The main function cj/kill-buffer-or-bury-alive replaces kill-buffer. ;; ;; Additional helper commands and key bindings: -;; - M-C (=cj/kill-buffer-and-window=): delete this window and bury/kill its buffer. +;; - C-; b k (=cj/kill-buffer-and-window=): delete this window and bury/kill its buffer. ;; - M-O (=cj/kill-other-window=): delete the next window and bury/kill its buffer. ;; - M-M (=cj/kill-all-other-buffers-and-windows=): kill or bury all buffers except ;; the current one and delete all other windows. @@ -65,7 +65,7 @@ ARG is passed to `save-some-buffers'." (unless (one-window-p) (delete-window)) (cj/kill-buffer-or-bury-alive buf))) -(keymap-global-set "M-C" #'cj/kill-buffer-and-window) +;; Keybinding moved to custom-buffer-file.el (C-; b k) (defun cj/kill-other-window () "Delete the next window and kill or bury its buffer." diff --git a/modules/user-constants.el b/modules/user-constants.el index 59129697..3b248ddd 100644 --- a/modules/user-constants.el +++ b/modules/user-constants.el @@ -20,6 +20,15 @@ ;; ;;; Code: +;; -------------------------------- Debug Toggle ------------------------------- + +(defvar cj/debug-modules nil + "List of modules with debug functions enabled. +Possible values: org-agenda, mail, chime, etc. +Set to t to enable all debug modules. +Example: (setq cj/debug-modules '(org-agenda mail)) + (setq cj/debug-modules t) ; Enable all") + ;; -------------------------------- Contact Info ------------------------------- (defvar user-whole-name "Craig Jennings" @@ -29,6 +38,24 @@ (defvar user-mail-address "c@cjennings.net" "The user's email address.") +;; ---------------------------- Buffer Status Colors --------------------------- + +(defconst cj/buffer-status-colors + '((read-only . "#f06a3f") ; red – buffer is read-only + (overwrite . "#c48702") ; gold – overwrite mode + (modified . "#64aa0f") ; green – modified & writeable + (unmodified . "#ffffff")) ; white – unmodified & writeable + "Alist mapping buffer states to their colors. +Used by cursor color, modeline, and other UI elements.") + +;; --------------------------- Media File Extensions --------------------------- + +(defvar cj/audio-file-extensions + '("m4a" "mp3" "wav" "flac" "ogg" "opus" "aac" + "aiff" "aif" "wma" "ape" "alac" "weba") + "File extensions recognized as audio files. +Used by transcription module and other audio-related functionality.") + ;; ------------------------ Directory And File Constants ----------------------- ;; DIRECTORIES @@ -100,8 +127,13 @@ (defvar schedule-file (expand-file-name "schedule.org" org-dir) "The location of the org file containing scheduled events.") -(defvar gcal-file (expand-file-name "gcal.org" org-dir) - "The location of the org file containing Google Calendar information.") +(defvar gcal-file (expand-file-name "data/gcal.org" user-emacs-directory) + "The location of the org file containing Google Calendar information. +Stored in .emacs.d/data/ so each machine syncs independently from Google Calendar.") + +(defvar pcal-file (expand-file-name "data/pcal.org" user-emacs-directory) + "The location of the org file containing Proton Calendar information. +Stored in .emacs.d/data/ so each machine syncs independently from Proton Calendar.") (defvar reference-file (expand-file-name "reference.org" org-dir) "The location of the org file containing reference information.") diff --git a/modules/vc-config.el b/modules/vc-config.el index 3b116cc1..7865d0f4 100644 --- a/modules/vc-config.el +++ b/modules/vc-config.el @@ -35,6 +35,13 @@ (setq magit-clone-set-remote.pushDefault 'ask) ;; ask if origin is default ) ;; end use-package magit +;; Git Clone from Clipboard +(defvar cj/git-clone-dirs + (list code-dir ;; Already configured in your init + "~/projects/" + user-emacs-directory) ;; For cloning Emacs packages + "List of directories to choose from when cloning with prefix argument.") + ;; --------------------------------- Git Gutter -------------------------------- ;; mark changed lines since last commit in the margin @@ -115,23 +122,108 @@ (forge-create-issue) (user-error "Not in a forge repository"))) +(defun cj/goto-git-gutter-diff-hunks () + "Jump to git-gutter diff hunks using consult. +Searches for lines starting with + or - (diff markers) and allows +interactive selection to jump to any changed line in the buffer." + (interactive) + (require 'git-gutter) + (consult-line "^[+\\-]")) + +;; ------------------------------ Git Clone Clipboard ----------------------------- +;; Quick git clone from clipboard URL +;; Based on: https://xenodium.com/bending-emacs-episode-3-git-clone-the-lazy-way + +(defun cj/git-clone-clipboard-url (url target-dir) + "Clone git repository from clipboard URL to TARGET-DIR. + +With no prefix argument: uses first directory in `cj/git-clone-dirs'. +With \\[universal-argument]: choose from `cj/git-clone-dirs'. +With \\[universal-argument] \\[universal-argument]: choose any directory. + +After cloning, opens the repository's README file if found." + (interactive + (list (current-kill 0) ;; Get URL from clipboard + (cond + ;; C-u C-u: Choose any directory + ((equal current-prefix-arg '(16)) + (read-directory-name "Clone to: " code-dir)) + ;; C-u: Choose from configured list + (current-prefix-arg + (completing-read "Clone to: " cj/git-clone-dirs nil t)) + ;; No prefix: Use default (first in list) + (t (car cj/git-clone-dirs))))) + + (let* ((default-directory target-dir) + (repo-name (file-name-sans-extension + (file-name-nondirectory url))) + (clone-dir (expand-file-name repo-name target-dir))) + + ;; Clone the repository + (message "Cloning %s to %s..." url target-dir) + (shell-command (format "git clone %s" (shell-quote-argument url))) + + ;; Find and open README + (when (file-directory-p clone-dir) + (let ((readme (seq-find + (lambda (file) + (string-match-p "^README" (upcase file))) + (directory-files clone-dir)))) + (if readme + (find-file (expand-file-name readme clone-dir)) + (dired clone-dir)))))) + +;; -------------------------------- Difftastic --------------------------------- +;; Structural diffs for better git change visualization +;; Requires: difft binary (installed via pacman -S difftastic) + +(use-package difftastic + :defer t + :commands (difftastic-magit-diff difftastic-magit-show) + :bind (:map magit-blame-read-only-mode-map + ("D" . difftastic-magit-show) + ("S" . difftastic-magit-show)) + :config + (eval-after-load 'magit-diff + '(transient-append-suffix 'magit-diff '(-1 -1) + [("D" "Difftastic diff (dwim)" difftastic-magit-diff) + ("S" "Difftastic show" difftastic-magit-show)]))) + ;; --------------------------------- VC Keymap --------------------------------- ;; Ordering & sorting prefix and keymap (defvar-keymap cj/vc-map :doc "Keymap for version control operations" + "c" #'cj/git-clone-clipboard-url "d" #'cj/goto-git-gutter-diff-hunks - "c" #'cj/forge-create-issue "f" #'forge-pull - "i" #'forge-list-issues "n" #'git-gutter:next-hunk "p" #'git-gutter:previous-hunk "r" #'forge-list-pullreqs "t" #'cj/git-timemachine) +;; Issues submenu under C-; v i +(defvar-keymap cj/vc-issues-map + :doc "Keymap for forge issue operations" + "c" #'cj/forge-create-issue + "l" #'forge-list-issues) + +(keymap-set cj/vc-map "i" cj/vc-issues-map) + (keymap-set cj/custom-keymap "v" cj/vc-map) (with-eval-after-load 'which-key - (which-key-add-key-based-replacements "C-; v" "version control menu")) + (which-key-add-key-based-replacements + "C-; v" "version control menu" + "C-; v c" "clone from clipboard" + "C-; v d" "goto diff hunks" + "C-; v f" "forge pull" + "C-; v i" "issues menu" + "C-; v i c" "create issue" + "C-; v i l" "list issues" + "C-; v n" "next hunk" + "C-; v p" "previous hunk" + "C-; v r" "list pull requests" + "C-; v t" "git timemachine")) (provide 'vc-config) ;;; vc-config.el ends here. diff --git a/modules/video-audio-recording.el b/modules/video-audio-recording.el index fa4c2926..b3151dba 100644 --- a/modules/video-audio-recording.el +++ b/modules/video-audio-recording.el @@ -3,12 +3,56 @@ ;; ;;; Commentary: ;; Use ffmpeg to record desktop video or just audio. -;; with audio from mic and audio from default audio sink -;; Also supports audio-only recording in Opus format. +;; Records audio from both microphone and system audio (for calls/meetings). +;; Audio recordings use M4A/AAC format for best compatibility. ;; ;; Note: video-recordings-dir and audio-recordings-dir are defined ;; (and directory created) in user-constants.el ;; +;; Quick Start +;; =========== +;; 1. Press C-; r a (start/stop audio recording) +;; 2. First time: you'll be prompted for device setup +;; 3. Choose "Bluetooth Headset" (or your device) +;; 4. Recording starts - you'll see 🔴Audio in your modeline +;; 5. Press C-; r a again to stop (🔴 disappears) +;; +;; Device Setup (First Time Only) +;; =============================== +;; C-; r a automatically prompts for device selection on first use. +;; Device selection persists across Emacs sessions. +;; +;; Manual device selection: +;; +;; C-; r c (cj/recording-quick-setup-for-calls) - RECOMMENDED +;; Quick setup: picks one device for both mic and monitor. +;; Perfect for calls, meetings, or when using headset. +;; +;; C-; r s (cj/recording-select-devices) - ADVANCED +;; Manual selection: choose mic and monitor separately. +;; Use when you need different devices for input/output. +;; +;; C-; r d (cj/recording-list-devices) +;; List all available audio devices and current configuration. +;; +;; C-; r w (cj/recording-show-active-audio) - DIAGNOSTIC TOOL +;; Show which apps are currently playing audio and through which device. +;; Use this DURING a phone call to see if the call audio is going through +;; the device you think it is. Helps diagnose "missing one side" issues. +;; +;; Testing Devices Before Important Recordings +;; ============================================ +;; Always test devices before important meetings/calls: +;; +;; C-; r t b (cj/recording-test-both) - RECOMMENDED +;; Guided test: mic only, monitor only, then both together. +;; Catches hardware issues before they ruin recordings! +;; +;; C-; r t m (cj/recording-test-mic) +;; Quick 5-second mic test with playback. +;; +;; C-; r t s (cj/recording-test-monitor) +;; Quick 5-second system audio test with playback. ;; ;; To adjust volumes: ;; - Use =M-x cj/recording-adjust-volumes= (or your keybinding =r l=) @@ -20,6 +64,8 @@ ;; ;;; Code: +(require 'system-lib) + ;; Forward declarations (eval-when-compile (defvar video-recordings-dir)) (eval-when-compile (defvar audio-recordings-dir)) @@ -29,9 +75,10 @@ "Volume multiplier for microphone in recordings. 1.0 = normal volume, 2.0 = double volume (+6dB), 0.5 = half volume (-6dB).") -(defvar cj/recording-system-volume 0.5 +(defvar cj/recording-system-volume 2.0 "Volume multiplier for system audio in recordings. -1.0 = normal volume, 2.0 = double volume (+6dB), 0.5 = half volume (-6dB).") +1.0 = normal volume, 2.0 = double volume (+6dB), 0.5 = half volume (-6dB). +Default is 2.0 because the pan filter reduces by 50%, so final level is 1.0x.") (defvar cj/recording-mic-device nil "PulseAudio device name for microphone input. @@ -47,6 +94,36 @@ If nil, will auto-detect on first use.") (defvar cj/audio-recording-ffmpeg-process nil "Variable to store the process of the ffmpeg audio recording.") +;; Modeline recording indicator +(defun cj/recording-modeline-indicator () + "Return modeline string showing active recordings. +Shows 🔴 when recording (audio and/or video). +Checks if process is actually alive, not just if variable is set." + (let ((audio-active (and cj/audio-recording-ffmpeg-process + (process-live-p cj/audio-recording-ffmpeg-process))) + (video-active (and cj/video-recording-ffmpeg-process + (process-live-p cj/video-recording-ffmpeg-process)))) + (cond + ((and audio-active video-active) " 🔴A+V ") + (audio-active " 🔴Audio ") + (video-active " 🔴Video ") + (t "")))) + +(defun cj/recording-process-sentinel (process event) + "Sentinel for recording processes to clean up and update modeline. +PROCESS is the ffmpeg process, EVENT describes what happened." + (when (memq (process-status process) '(exit signal)) + ;; Process ended - clear the variable + (cond + ((eq process cj/audio-recording-ffmpeg-process) + (setq cj/audio-recording-ffmpeg-process nil) + (message "Audio recording stopped: %s" (string-trim event))) + ((eq process cj/video-recording-ffmpeg-process) + (setq cj/video-recording-ffmpeg-process nil) + (message "Video recording stopped: %s" (string-trim event)))) + ;; Force modeline update + (force-mode-line-update t))) + (defun cj/recording-check-ffmpeg () "Check if ffmpeg is available. Return t if found, nil otherwise." @@ -55,63 +132,332 @@ Return t if found, nil otherwise." nil) t) -(defun cj/recording-detect-mic-device () - "Auto-detect PulseAudio microphone input device. -Returns device name or nil if not found." - (let ((output (shell-command-to-string "pactl list sources short 2>/dev/null"))) - (when (string-match "\\([^\t\n]+\\).*analog.*stereo" output) - (match-string 1 output)))) +;; Auto-detection functions removed - they were unreliable and preferred built-in +;; audio over Bluetooth/USB devices. Use explicit device selection instead: +;; - C-; r c (cj/recording-quick-setup-for-calls) - recommended for most use cases +;; - C-; r s (cj/recording-select-devices) - manual selection of mic + monitor -(defun cj/recording-detect-system-device () - "Auto-detect PulseAudio system audio monitor device. -Returns device name or nil if not found." - (let ((output (shell-command-to-string "pactl list sources short 2>/dev/null"))) - (when (string-match "\\([^\t\n]+\\.monitor\\)" output) - (match-string 1 output)))) +(defun cj/recording--parse-pactl-output (output) + "Internal parser for pactl sources output. Takes OUTPUT string. +Returns list of (device-name driver state) tuples. +Extracted for testing without shell command execution." + (let ((sources nil)) + (dolist (line (split-string output "\n" t)) + (when (string-match "^[0-9]+\t\\([^\t]+\\)\t\\([^\t]+\\)\t\\([^\t]+\\)\t\\([^\t]+\\)" line) + (let ((device (match-string 1 line)) + (driver (match-string 2 line)) + (state (match-string 4 line))) + (push (list device driver state) sources)))) + (nreverse sources))) -(defun cj/recording-get-devices () - "Get or auto-detect audio devices. -Returns (mic-device . system-device) or nil on error." - ;; Auto-detect if not already set +(defun cj/recording-parse-sources () + "Parse pactl sources output into structured list. +Returns list of (device-name driver state) tuples." + (cj/recording--parse-pactl-output + (shell-command-to-string "pactl list sources short 2>/dev/null"))) + +(defun cj/recording-friendly-state (state) + "Convert technical state name to user-friendly label. +STATE is the raw state from pactl (SUSPENDED, RUNNING, IDLE, etc.)." + (pcase state + ("SUSPENDED" "Ready") + ("RUNNING" "Active") + ("IDLE" "Ready") + (_ state))) ; fallback to original if unknown + +(defun cj/recording-list-devices () + "Show all available audio sources in a readable format. +Opens a buffer showing devices with their states." + (interactive) + (let ((sources (cj/recording-parse-sources))) + (with-current-buffer (get-buffer-create "*Recording Devices*") + (erase-buffer) + (insert "Available Audio Sources\n") + (insert "========================\n\n") + (insert "Note: 'Ready' devices are available and will activate when recording starts.\n\n") + (insert "Current Configuration:\n") + (insert (format " Microphone: %s\n" (or cj/recording-mic-device "Not set"))) + (insert (format " System Audio: %s\n\n" (or cj/recording-system-device "Not set"))) + (insert "Available Devices:\n\n") + (if sources + (dolist (source sources) + (let ((device (nth 0 source)) + (driver (nth 1 source)) + (state (nth 2 source)) + (friendly-state (cj/recording-friendly-state (nth 2 source)))) + (insert (format "%-10s [%s]\n" friendly-state driver)) + (insert (format " %s\n\n" device)))) + (insert " No audio sources found. Is PulseAudio/PipeWire running?\n")) + (goto-char (point-min)) + (special-mode)) + (switch-to-buffer-other-window "*Recording Devices*"))) + +(defun cj/recording-show-active-audio () + "Show which audio sinks are currently PLAYING audio in real-time. +Useful for diagnosing why phone call audio isn't being captured - helps identify +which device the phone app is actually using for output." + (interactive) + (let ((output (shell-command-to-string "pactl list sink-inputs"))) + (with-current-buffer (get-buffer-create "*Active Audio Playback*") + (erase-buffer) + (insert "Active Audio Playback (Updated: " (format-time-string "%H:%M:%S") ")\n") + (insert "======================================================\n\n") + (insert "This shows which applications are CURRENTLY playing audio and through which device.\n") + (insert "If you're on a phone call, you should see the phone app listed here.\n") + (insert "The 'Sink' line shows which output device it's using.\n\n") + (if (string-match-p "Sink Input" output) + (progn + (insert output) + (insert "\n\nTIP: The '.monitor' device corresponding to the 'Sink' above is what\n") + (insert "you need to select for system audio to capture the other person's voice.\n\n") + (insert "For example, if Sink is 'alsa_output.usb...Jabra...analog-stereo',\n") + (insert "then you need 'alsa_output.usb...Jabra...analog-stereo.monitor'\n")) + (insert "No active audio playback detected.\n\n") + (insert "This means no applications are currently playing audio.\n") + (insert "If you're on a phone call and see this, the phone app might be:\n") + (insert " 1. Using a different audio system (not PulseAudio/PipeWire)\n") + (insert " 2. Using a Bluetooth device directly (bypassing system audio)\n") + (insert " 3. Not actually playing audio (check if you can hear the other person)\n")) + (goto-char (point-min)) + (special-mode)) + (switch-to-buffer-other-window "*Active Audio Playback*") + (message "Showing active audio playback. Press 'g' to refresh, 'q' to quit."))) + +(defun cj/recording-select-device (prompt device-type) + "Interactively select an audio device. +PROMPT is shown to user. DEVICE-TYPE is 'mic or 'monitor for filtering. +Returns selected device name or nil." + (let* ((sources (cj/recording-parse-sources)) + (filtered (if (eq device-type 'monitor) + (seq-filter (lambda (s) (string-match-p "\\.monitor$" (car s))) sources) + (seq-filter (lambda (s) (not (string-match-p "\\.monitor$" (car s)))) sources))) + (choices (mapcar (lambda (s) + (let ((device (nth 0 s)) + (driver (nth 1 s)) + (state (nth 2 s)) + (friendly-state (cj/recording-friendly-state (nth 2 s)))) + (cons (format "%-10s %s" friendly-state device) device))) + filtered))) + (if choices + (cdr (assoc (completing-read prompt choices nil t) choices)) + (user-error "No %s devices found" (if (eq device-type 'monitor) "monitor" "input"))))) + +(defun cj/recording-select-devices () + "Interactively select microphone and system audio devices. +Sets cj/recording-mic-device and cj/recording-system-device." + (interactive) + (setq cj/recording-mic-device + (cj/recording-select-device "Select microphone device: " 'mic)) + (setq cj/recording-system-device + (cj/recording-select-device "Select system audio monitor: " 'monitor)) + (message "Devices set - Mic: %s, System: %s" + cj/recording-mic-device + cj/recording-system-device)) + +(defun cj/recording-group-devices-by-hardware () + "Group audio sources by hardware device. +Returns alist of (device-name . (mic-source . monitor-source))." + (let ((sources (cj/recording-parse-sources)) + (devices (make-hash-table :test 'equal)) + (result nil)) + ;; Group sources by base device name + (dolist (source sources) + (let* ((device (nth 0 source)) + (driver (nth 1 source)) + ;; Extract hardware ID (the unique part that identifies the physical device) + (base-name (cond + ;; USB devices: extract usb-XXXXX-XX part + ((string-match "\\.\\(usb-[^.]+\\-[0-9]+\\)\\." device) + (match-string 1 device)) + ;; Built-in (pci) devices: extract pci-XXXXX part + ((string-match "\\.\\(pci-[^.]+\\)\\." device) + (match-string 1 device)) + ;; Bluetooth devices: extract and normalize MAC address + ;; (input uses colons, output uses underscores - normalize to colons) + ((string-match "bluez_\\(?:input\\|output\\)\\.\\([^.]+\\)" device) + (replace-regexp-in-string "_" ":" (match-string 1 device))) + (t device))) + (is-monitor (string-match-p "\\.monitor$" device)) + (device-entry (gethash base-name devices))) + (unless device-entry + (setf device-entry (cons nil nil)) + (puthash base-name device-entry devices)) + ;; Store mic or monitor in the pair + (if is-monitor + (setcdr device-entry device) + (setcar device-entry device)))) + + ;; Convert hash table to alist with friendly names + (maphash (lambda (base-name pair) + (when (and (car pair) (cdr pair)) ; Only include if we have both mic and monitor + (let ((friendly-name + (cond + ((string-match-p "usb.*[Jj]abra" base-name) "Jabra SPEAK 510 USB") + ((string-match-p "^usb-" base-name) "USB Audio Device") + ((string-match-p "^pci-" base-name) "Built-in Laptop Audio") + ((string-match-p "^[0-9A-Fa-f:]+$" base-name) "Bluetooth Headset") + (t base-name)))) + (push (cons friendly-name pair) result)))) + devices) + (nreverse result))) + +(defun cj/recording-quick-setup-for-calls () + "Quick setup for recording call/meetings. +Detects available audio devices and lets you pick one device to use for +both microphone (your voice) and monitor (remote person + sound effects). +Perfect for recording video calls, phone calls, or presentations." + (interactive) + (let* ((grouped-devices (cj/recording-group-devices-by-hardware)) + (choices (mapcar #'car grouped-devices))) + (if (null choices) + (user-error "No complete audio devices found (need both mic and monitor)") + (let* ((choice (completing-read "Which device are you using for the call? " choices nil t)) + (device-pair (cdr (assoc choice grouped-devices))) + (mic (car device-pair)) + (monitor (cdr device-pair))) + (setq cj/recording-mic-device mic) + (setq cj/recording-system-device monitor) + (message "Call recording ready! Using: %s\n Mic: %s\n Monitor: %s" + choice + (file-name-nondirectory mic) + (file-name-nondirectory monitor)))))) + +(defun cj/recording-test-mic () + "Test microphone by recording 5 seconds and playing it back. +Records from configured mic device, saves to temp file, plays back. +Useful for verifying mic hardware works before important recordings." + (interactive) (unless cj/recording-mic-device - (setq cj/recording-mic-device (cj/recording-detect-mic-device))) + (user-error "No microphone configured. Run C-; r c first")) + + (let* ((temp-file (make-temp-file "mic-test-" nil ".wav")) + (duration 5)) + (message "Recording from mic for %d seconds... SPEAK NOW!" duration) + (shell-command + (format "ffmpeg -f pulse -i %s -t %d -y %s 2>/dev/null" + (shell-quote-argument cj/recording-mic-device) + duration + (shell-quote-argument temp-file))) + (message "Playing back recording...") + (shell-command (format "ffplay -autoexit -nodisp %s 2>/dev/null &" + (shell-quote-argument temp-file))) + (message "Mic test complete. Temp file: %s" temp-file))) + +(defun cj/recording-test-monitor () + "Test system audio monitor by recording 5 seconds and playing it back. +Records from configured monitor device (system audio output). +Play some audio/video during test. Useful for verifying you can capture +conference call audio, YouTube, etc." + (interactive) (unless cj/recording-system-device - (setq cj/recording-system-device (cj/recording-detect-system-device))) + (user-error "No system monitor configured. Run C-; r c first")) + + (let* ((temp-file (make-temp-file "monitor-test-" nil ".wav")) + (duration 5)) + (message "Recording system audio for %d seconds... PLAY SOMETHING NOW!" duration) + (shell-command + (format "ffmpeg -f pulse -i %s -t %d -y %s 2>/dev/null" + (shell-quote-argument cj/recording-system-device) + duration + (shell-quote-argument temp-file))) + (message "Playing back recording...") + (shell-command (format "ffplay -autoexit -nodisp %s 2>/dev/null &" + (shell-quote-argument temp-file))) + (message "Monitor test complete. Temp file: %s" temp-file))) - ;; Validate devices +(defun cj/recording-test-both () + "Test both mic and monitor together with guided prompts. +This simulates a real recording scenario: +1. Tests mic only (speak into it) +2. Tests monitor only (play audio/video) +3. Tests both together (speak while audio plays) + +Run this before important recordings to verify everything works!" + (interactive) (unless (and cj/recording-mic-device cj/recording-system-device) - (user-error "Could not detect audio devices. Set cj/recording-mic-device and cj/recording-system-device manually")) + (user-error "Devices not configured. Run C-; r c first")) + + (when (y-or-n-p "Test 1: Record from MICROPHONE only (5 sec). Ready? ") + (cj/recording-test-mic) + (sit-for 6)) ; Wait for playback + + (when (y-or-n-p "Test 2: Record from SYSTEM AUDIO only (5 sec). Start playing audio/video, then press y: ") + (cj/recording-test-monitor) + (sit-for 6)) ; Wait for playback + + (when (y-or-n-p "Test 3: Record BOTH mic + system audio (5 sec). Speak while audio plays, then press y: ") + (let* ((temp-file (make-temp-file "both-test-" nil ".wav")) + (duration 5)) + (message "Recording BOTH for %d seconds... SPEAK + PLAY AUDIO NOW!" duration) + (shell-command + (format "ffmpeg -f pulse -i %s -f pulse -i %s -filter_complex \"[0:a]volume=%.1f[mic];[1:a]volume=%.1f[sys];[mic][sys]amix=inputs=2:duration=longest\" -t %d -y %s 2>/dev/null" + (shell-quote-argument cj/recording-mic-device) + (shell-quote-argument cj/recording-system-device) + cj/recording-mic-boost + cj/recording-system-volume + duration + (shell-quote-argument temp-file))) + (message "Playing back recording...") + (shell-command (format "ffplay -autoexit -nodisp %s 2>/dev/null &" + (shell-quote-argument temp-file))) + (sit-for 6) + (message "All tests complete! Temp file: %s" temp-file))) + + (message "Device testing complete. If you heard audio in all tests, recording will work!")) + +(defun cj/recording-get-devices () + "Get audio devices, prompting user if not already configured. +Returns (mic-device . system-device) or nil on error." + ;; If devices not set, prompt user to select them + (unless (and cj/recording-mic-device cj/recording-system-device) + (if (y-or-n-p "Audio devices not configured. Use quick setup for calls? ") + (cj/recording-quick-setup-for-calls) + (cj/recording-select-devices))) + + ;; Final validation + (unless (and cj/recording-mic-device cj/recording-system-device) + (user-error "Audio devices not configured. Run C-; r c (quick setup) or C-; r s (manual select)")) (cons cj/recording-mic-device cj/recording-system-device)) -(defun cj/video-recording-start (arg) - "Start the ffmpeg video recording. +(defun cj/video-recording-toggle (arg) + "Toggle video recording: start if not recording, stop if recording. +On first use (or when devices not configured), runs quick setup (C-; r c). With prefix ARG, prompt for recording location. Otherwise use the default location in `video-recordings-dir'." (interactive "P") - (let* ((location (if arg - (read-directory-name "Enter recording location: ") - video-recordings-dir)) - (directory (file-name-directory location))) - (unless (file-directory-p directory) - (make-directory directory t)) - (cj/ffmpeg-record-video location))) - -(defun cj/audio-recording-start (arg) - "Start the ffmpeg audio recording. + (if cj/video-recording-ffmpeg-process + ;; Recording in progress - stop it + (cj/video-recording-stop) + ;; Not recording - start it + (let* ((location (if arg + (read-directory-name "Enter recording location: ") + video-recordings-dir)) + (directory (file-name-directory location))) + (unless (file-directory-p directory) + (make-directory directory t)) + (cj/ffmpeg-record-video location)))) + +(defun cj/audio-recording-toggle (arg) + "Toggle audio recording: start if not recording, stop if recording. +On first use (or when devices not configured), runs quick setup (C-; r c). With prefix ARG, prompt for recording location. Otherwise use the default location in `audio-recordings-dir'." (interactive "P") - (let* ((location (if arg - (read-directory-name "Enter recording location: ") - audio-recordings-dir)) - (directory (file-name-directory location))) - (unless (file-directory-p directory) - (make-directory directory t)) - (cj/ffmpeg-record-audio location))) + (if cj/audio-recording-ffmpeg-process + ;; Recording in progress - stop it + (cj/audio-recording-stop) + ;; Not recording - start it + (let* ((location (if arg + (read-directory-name "Enter recording location: ") + audio-recordings-dir)) + (directory (file-name-directory location))) + (unless (file-directory-p directory) + (make-directory directory t)) + (cj/ffmpeg-record-audio location)))) (defun cj/ffmpeg-record-video (directory) - "Start an ffmpeg video recording. Save output to DIRECTORY." + "Start an ffmpeg video recording. Save output to DIRECTORY." (cj/recording-check-ffmpeg) (unless cj/video-recording-ffmpeg-process (let* ((devices (cj/recording-get-devices)) @@ -140,41 +486,54 @@ Otherwise use the default location in `audio-recordings-dir'." "*ffmpeg-video-recording*" ffmpeg-command)) (set-process-query-on-exit-flag cj/video-recording-ffmpeg-process nil) + (set-process-sentinel cj/video-recording-ffmpeg-process #'cj/recording-process-sentinel) + (force-mode-line-update t) (message "Started video recording to %s (mic: %.1fx, system: %.1fx)." filename cj/recording-mic-boost cj/recording-system-volume)))) (defun cj/ffmpeg-record-audio (directory) - "Start an ffmpeg audio recording. Save output to DIRECTORY." + "Start an ffmpeg audio recording. Save output to DIRECTORY. +Records from microphone and system audio monitor (configured device), mixing them together. +Use C-; r c to configure which device to use - it must match the device your phone call uses." (cj/recording-check-ffmpeg) (unless cj/audio-recording-ffmpeg-process (let* ((devices (cj/recording-get-devices)) (mic-device (car devices)) + ;; Use the explicitly configured monitor device + ;; This must match the device your phone call/audio is using (system-device (cdr devices)) (location (expand-file-name directory)) (name (format-time-string "%Y-%m-%d-%H-%M-%S")) - (filename (expand-file-name (concat name ".opus") location)) + (filename (expand-file-name (concat name ".m4a") location)) (ffmpeg-command (format (concat "ffmpeg " - "-f pulse -i %s " - "-ac 1 " - "-f pulse -i %s " - "-ac 2 " - "-filter_complex \"[0:a]volume=%.1f[mic];[1:a]volume=%.1f[sys];[mic][sys]amerge=inputs=2\" " - "-c:a libopus " - "-b:a 96k " + "-f pulse -i %s " ; Input 0: Microphone (specific device) + "-f pulse -i %s " ; Input 1: System audio monitor + "-filter_complex \"" + "[0:a]volume=%.1f[mic];" ; Apply mic boost + "[1:a]volume=%.1f[sys];" ; Apply system volume + "[mic][sys]amix=inputs=2:duration=longest[out]\" " ; Mix both inputs + "-map \"[out]\" " + "-c:a aac " + "-b:a 64k " "%s") mic-device system-device cj/recording-mic-boost cj/recording-system-volume filename))) + ;; Log the command for debugging + (message "Recording from mic: %s + ALL system outputs" mic-device) + (cj/log-silently "Audio recording ffmpeg command: %s" ffmpeg-command) ;; start the recording (setq cj/audio-recording-ffmpeg-process (start-process-shell-command "ffmpeg-audio-recording" "*ffmpeg-audio-recording*" ffmpeg-command)) (set-process-query-on-exit-flag cj/audio-recording-ffmpeg-process nil) - (message "Started audio recording to %s (mic: %.1fx, system: %.1fx)." + (set-process-sentinel cj/audio-recording-ffmpeg-process #'cj/recording-process-sentinel) + (force-mode-line-update t) + (message "Started recording to %s (mic: %.1fx, all system audio: %.1fx)" filename cj/recording-mic-boost cj/recording-system-volume)))) (defun cj/video-recording-stop () @@ -187,6 +546,7 @@ Otherwise use the default location in `audio-recordings-dir'." ;; Give ffmpeg a moment to finalize the file (sit-for 0.2) (setq cj/video-recording-ffmpeg-process nil) + (force-mode-line-update t) (message "Stopped video recording.")) (message "No video recording in progress."))) @@ -200,6 +560,7 @@ Otherwise use the default location in `audio-recordings-dir'." ;; Give ffmpeg a moment to finalize the file (sit-for 0.2) (setq cj/audio-recording-ffmpeg-process nil) + (force-mode-line-update t) (message "Stopped audio recording.")) (message "No audio recording in progress."))) @@ -217,15 +578,37 @@ Otherwise use the default location in `audio-recordings-dir'." ;; Recording operations prefix and keymap (defvar cj/record-map (let ((map (make-sparse-keymap))) - (define-key map (kbd "V") #'cj/video-recording-stop) - (define-key map (kbd "v") #'cj/video-recording-start) - (define-key map (kbd "A") #'cj/audio-recording-stop) - (define-key map (kbd "a") #'cj/audio-recording-start) + (define-key map (kbd "v") #'cj/video-recording-toggle) + (define-key map (kbd "a") #'cj/audio-recording-toggle) (define-key map (kbd "l") #'cj/recording-adjust-volumes) + (define-key map (kbd "d") #'cj/recording-list-devices) + (define-key map (kbd "w") #'cj/recording-show-active-audio) ; "w" for "what's playing" + (define-key map (kbd "s") #'cj/recording-select-devices) + (define-key map (kbd "c") #'cj/recording-quick-setup-for-calls) + (define-key map (kbd "t m") #'cj/recording-test-mic) + (define-key map (kbd "t s") #'cj/recording-test-monitor) + (define-key map (kbd "t b") #'cj/recording-test-both) map) "Keymap for video/audio recording operations.") -(keymap-set cj/custom-keymap "r" cj/record-map) +;; Only set keybinding if cj/custom-keymap is bound (not in batch mode) +(when (boundp 'cj/custom-keymap) + (keymap-set cj/custom-keymap "r" cj/record-map)) + +(with-eval-after-load 'which-key + (which-key-add-key-based-replacements + "C-; r" "recording menu" + "C-; r v" "toggle video recording" + "C-; r a" "toggle audio recording" + "C-; r l" "adjust levels" + "C-; r d" "list devices" + "C-; r w" "what's playing (diagnostics)" + "C-; r s" "select devices" + "C-; r c" "quick setup for calls" + "C-; r t" "test devices" + "C-; r t m" "test microphone" + "C-; r t s" "test system audio" + "C-; r t b" "test both (guided)")) (provide 'video-audio-recording) ;;; video-audio-recording.el ends here. diff --git a/modules/weather-config.el b/modules/weather-config.el index 526a0b41..0259d4a9 100644 --- a/modules/weather-config.el +++ b/modules/weather-config.el @@ -11,30 +11,33 @@ ;; ----------------------------------- Wttrin ---------------------------------- (use-package wttrin - :defer t - :load-path ("~/code/wttrin") - :ensure nil ;; local package + ;; Uncomment the next line to use vc-install instead of local directory: + ;; :vc (:url "https://github.com/cjennings/emacs-wttrin" :rev :newest) + :demand t ;; REQUIRED: mode-line must start at Emacs startup + :load-path "/home/cjennings/code/wttrin" :preface - ;; dependency for wttrin - (use-package xterm-color - :demand t) + ;; Change this to t to enable debug logging + ;; (setq wttrin-debug t) :bind ("M-W" . wttrin) - :custom - (wttrin-unit-system "u") :config + (setopt wttrin-unit-system "u") + (setopt wttrin-favorite-location "New Orleans, LA") + (setopt wttrin-mode-line-refresh-interval (* 30 60)) ;; thirty minutes (setq wttrin-default-locations '( - "New Orleans, LA" - "Athens, GR" - "Berkeley, CA" - "Bury St Edmunds, UK" - "Kyiv, UA" - "Littlestown, PA" - "Soufrière, St Lucia" - "London, GB" - "Naples, IT" - "New York, NY" - ))) + "New Orleans, LA" + "Berkeley, CA" + "Huntington Beach, CA" + "Bury St Edmunds, UK" + "New York, NY" + "Littlestown, PA" + "Soufrière, St Lucia" + "London, GB" + "Naples, IT" + "Athens, GR" + "Kyiv, UA" + )) + (wttrin-mode-line-mode 1)) (provide 'weather-config) ;;; weather-config.el ends here. diff --git a/modules/wip.el b/modules/wip.el index 314881d2..93c799fb 100644 --- a/modules/wip.el +++ b/modules/wip.el @@ -14,134 +14,6 @@ ;; ;;; Code: -(eval-when-compile (require 'user-constants)) -(eval-when-compile (require 'keybindings)) -(eval-when-compile (require 'subr-x)) ;; for system commands -(require 'rx) ;; for system commands - -;; ------------------------------ System Commands ------------------------------ - -(defun cj/system-cmd--resolve (cmd) - "Return (values symbol-or-nil command-string label) for CMD." - (cond - ((symbolp cmd) - (let ((val (and (boundp cmd) (symbol-value cmd)))) - (unless (and (stringp val) (not (string-empty-p val))) - (user-error "Variable %s is not a non-empty string" cmd)) - (list cmd val (symbol-name cmd)))) - ((stringp cmd) - (let ((s (string-trim cmd))) - (when (string-empty-p s) (user-error "Command string is empty")) - (list nil s "command"))) - (t (user-error "Error: cj/system-cmd expects a string or a symbol")))) - -;;;###autoload -(defun cj/system-cmd (cmd) - "Run CMD (string or symbol naming a string) detached via the shell. -Shell expansions like $(...) are supported. Output is silenced. -If CMD is deemed dangerous, ask for confirmation." - (interactive (list (read-shell-command "System command: "))) - (pcase-let ((`(,sym ,cmdstr ,label) (cj/system-cmd--resolve cmd))) - (when (and sym (get sym 'cj/system-confirm) - (memq (read-char-choice - (format "Run %s now (%s)? (Y/n) " label camdstr) - '(?y ?Y ?n ?N ?\r ?\n ?\s)) - '(?n ?N))) - (user-error "Aborted")) - (let ((proc (start-process-shell-command "cj/system-cmd" nil - (format "nohup %s >/dev/null 2>&1 &" cmdstr)))) - (set-process-query-on-exit-flag proc nil) - (set-process-sentinel proc #'ignore) - (message "Running %s..." label)))) - -(defmacro cj/defsystem-command (name var cmdstr &optional confirm) - "Define VAR with CMDSTR and interactive command NAME to run it. -If CONFIRM is non-nil, mark VAR to always require confirmation." - (declare (indent defun)) - `(progn - (defvar ,var ,cmdstr) - ,(when confirm `(put ',var 'cj/system-confirm t)) - (defun ,name () - ,(format "Run %s via `cj/system-cmd'." var) - (interactive) - (cj/system-cmd ',var)))) - -;; Define system commands -(cj/defsystem-command cj/system-cmd-logout logout-cmd "loginctl terminate-user $(whoami)" t) -(cj/defsystem-command cj/system-cmd-lock lockscreen-cmd "slock") -(cj/defsystem-command cj/system-cmd-suspend suspend-cmd "systemctl suspend" t) -(cj/defsystem-command cj/system-cmd-shutdown shutdown-cmd "systemctl poweroff" t) -(cj/defsystem-command cj/system-cmd-reboot reboot-cmd "systemctl reboot" t) - -(defun cj/system-cmd-exit-emacs () - "Exit Emacs server and all clients." - (interactive) - (when (memq (read-char-choice - "Exit Emacs? (Y/n) " - '(?y ?Y ?n ?N ?\r ?\n ?\s)) - '(?n ?N)) - (user-error "Aborted")) - (kill-emacs)) - -(defun cj/system-cmd-restart-emacs () - "Restart Emacs server after saving buffers." - (interactive) - (when (memq (read-char-choice - "Restart Emacs? (Y/n) " - '(?y ?Y ?n ?N ?\r ?\n ?\s)) - '(?n ?N)) - (user-error "Aborted")) - (save-some-buffers) - ;; Start the restart process before killing Emacs - (run-at-time 0.5 nil - (lambda () - (call-process-shell-command - "systemctl --user restart emacs.service && emacsclient -c" - nil 0))) - (run-at-time 1 nil #'kill-emacs) - (message "Restarting Emacs...")) - -;; (defvar-keymap cj/system-command-map -;; :doc "Keymap for system commands." -;; "L" #'cj/system-cmd-logout -;; "r" #'cj/system-cmd-reboot -;; "s" #'cj/system-cmd-shutdown -;; "S" #'cj/system-cmd-suspend -;; "l" #'cj/system-cmd-lock -;; "E" #'cj/system-cmd-exit-emacs -;; "e" #'cj/system-cmd-restart-emacs) -;; (keymap-set cj/custom-keymap "!" cj/system-command-map) - -(defun cj/system-command-menu () - "Present system commands via \='completing-read\='." - (interactive) - (let* ((commands '(("Logout System" . cj/system-cmd-logout) - ("Lock Screen" . cj/system-cmd-lock) - ("Suspend System" . cj/system-cmd-suspend) - ("Shutdown System" . cj/system-cmd-shutdown) - ("Reboot System" . cj/system-cmd-reboot) - ("Exit Emacs" . cj/system-cmd-exit-emacs) - ("Restart Emacs" . cj/system-cmd-restart-emacs))) - (choice (completing-read "System command: " commands nil t))) - (when-let ((cmd (alist-get choice commands nil nil #'equal))) - (call-interactively cmd)))) - -(keymap-set cj/custom-keymap "!" #'cj/system-command-menu) - - -;; --------------------------- Org Upcoming Modeline --------------------------- - -;; (use-package org-upcoming-modeline -;; :after org -;; :load-path "~/code/org-upcoming-modeline/org-upcoming-modeline.el" -;; :config -;; (setq org-upcoming-modeline-keep-late 300) -;; (setq org-upcoming-modeline-ignored-keywords '("DONE" "CANCELLED" "FAILED")) -;; (setq org-upcoming-modeline-trim 30) -;; (setq org-upcoming-modeline-days-ahead 5) -;; (setq org-upcoming-modeline-format (lambda (ms mh) (format "📅 %s %s" ms mh))) -;; (org-upcoming-modeline-mode)) - ;; ----------------------------------- Efrit ----------------------------------- ;; not working as of Wednesday, September 03, 2025 at 12:44:09 AM CDT @@ -184,30 +56,5 @@ If CONFIRM is non-nil, mark VAR to always require confirmation." :bind ("M-p" . pomm) :commands (pomm pomm-third-time)) -;; ----------------------------------- Popper ---------------------------------- - -;; (use-package popper -;; :bind (("C-`" . popper-toggle) -;; ("M-`" . popper-cycle) -;; ("C-M-`" . popper-toggle-type)) -;; :custom -;; (popper-display-control-nil) -;; :init -;; (setq popper-reference-buffers -;; '("\\*Messages\\*" -;; "Output\\*$" -;; "\\*Async Shell Command\\*" -;; ;; "\\*scratch\\*" -;; help-mode -;; compilation-mode)) -;; (add-to-list 'display-buffer-alist -;; '(popper-display-control-p ; Predicate to match popper buffers -;; (display-buffer-in-side-window) -;; (side . bottom) -;; (slot . 0) -;; (window-height . 0.5))) ; Half the frame height -;; (popper-mode +1) -;; (popper-echo-mode +1)) - (provide 'wip) ;;; wip.el ends here. diff --git a/modules/wrap-up.el b/modules/wrap-up.el index b00d56a8..523d55b2 100644 --- a/modules/wrap-up.el +++ b/modules/wrap-up.el @@ -5,6 +5,8 @@ ;;; Code: +(require 'system-lib) + ;; -------------------------------- Bury Buffers ------------------------------- ;; wait a few seconds then bury compile-related buffers. |