From d77ca19cf7106a0eecbff1588c13b8b52b98b85f Mon Sep 17 00:00:00 2001 From: Craig Jennings Date: Mon, 27 Oct 2025 21:05:06 -0500 Subject: refactor: Rename custom-file-buffer to custom-buffer-file Renamed the module 'custom-file-buffer' to 'custom-buffer-file' to ensure consistency across the codebase. This change affects module imports and test files. Additionally, new module 'system-commands.el' has been created to handle system power and session management commands, removing these functionalities from 'wip.el'. --- modules/custom-buffer-file.el | 260 ++++++++++++++++++++++++++++++++++++++++++ modules/custom-file-buffer.el | 260 ------------------------------------------ modules/system-commands.el | 138 ++++++++++++++++++++++ modules/wip.el | 154 ------------------------- 4 files changed, 398 insertions(+), 414 deletions(-) create mode 100644 modules/custom-buffer-file.el delete mode 100644 modules/custom-file-buffer.el create mode 100644 modules/system-commands.el (limited to 'modules') diff --git a/modules/custom-buffer-file.el b/modules/custom-buffer-file.el new file mode 100644 index 00000000..9438e8ed --- /dev/null +++ b/modules/custom-buffer-file.el @@ -0,0 +1,260 @@ +;;; 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 +;; - 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 &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/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" + "C-; b m" "move file" + "C-; b r" "rename file" + "C-; b p" "print to PS" + "C-; b d" "delete file" + "C-; b c" "copy buffer" + "C-; b n" "copy buffer name" + "C-; b t" "clear to top" + "C-; b b" "clear to bottom" + "C-; b x" "erase buffer" + "C-; b s" "save as" + "C-; b l" "copy file link" + "C-; b P" "copy file path")) + + +(provide 'custom-buffer-file) +;;; custom-buffer-file.el ends here. diff --git a/modules/custom-file-buffer.el b/modules/custom-file-buffer.el deleted file mode 100644 index 08f974fd..00000000 --- a/modules/custom-file-buffer.el +++ /dev/null @@ -1,260 +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 &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/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" - "C-; b m" "move file" - "C-; b r" "rename file" - "C-; b p" "print to PS" - "C-; b d" "delete file" - "C-; b c" "copy buffer" - "C-; b n" "copy buffer name" - "C-; b t" "clear to top" - "C-; b b" "clear to bottom" - "C-; b x" "erase buffer" - "C-; b s" "save as" - "C-; b l" "copy file link" - "C-; b P" "copy file path")) - - -(provide 'custom-file-buffer) -;;; custom-file-buffer.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 +;; +;;; 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/wip.el b/modules/wip.el index db94cdb1..93c799fb 100644 --- a/modules/wip.el +++ b/modules/wip.el @@ -14,135 +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")))) - -(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) - -(with-eval-after-load 'which-key - (which-key-add-key-based-replacements "C-; !" "system commands")) - -;; --------------------------- 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 @@ -185,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. -- cgit v1.2.3