emacs.d/bundle/bundle--mk.el

533 lines
23 KiB
EmacsLisp

;;; bundle-mk.el --- Personal functions -*- lexical-binding: t; -*-
;; Copyright (C) 2024 Marcus Kammer
;; Author: Marcus Kammer <marcus.kammer@mailbox.org>
;; Keywords:
;; This program is free software; you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <https://www.gnu.org/licenses/>.
;;; Commentary:
;; Personal functions library
;;; Code:
(defun org-agenda-log-mode-colorize-block ()
"Set different line spacing based on clock time duration."
(save-excursion
(let* ((colors (cl-case (alist-get 'background-mode (frame-parameters))
('light (list "#d8dee9" "#e5e9f0" "#eceff4"))
('dark (list "#bf616a" "#d08770" "#ebcb8b" "#a3be8c" "#b48ead"))))
pos
duration)
(nconc colors colors)
(goto-char (point-min))
(while (setq pos (next-single-property-change (point) 'duration))
(goto-char pos)
(when (and (not (equal pos (point-at-eol)))
(setq duration (org-get-at-bol 'duration)))
;; larger duration bar height
(let ((line-height (if (< duration 15) 1.0 (+ 0.5 (/ duration 30))))
(ov (make-overlay (point-at-bol) (1+ (point-at-eol)))))
(overlay-put ov 'face `(:background ,(car colors) :foreground "black"))
(setq colors (cdr colors))
(overlay-put ov 'line-height line-height)
(overlay-put ov 'line-spacing (1- line-height))))))))
(add-hook 'org-agenda-finalize-hook #'org-agenda-log-mode-colorize-block)
(defun mk/extract-headlines-by-tag (tag)
"Extract headlines and their content from current buffer by TAG."
(interactive "sEnter tag: ")
(save-excursion
(let ((result-buffer (generate-new-buffer (concat "*Extracted Headlines " tag "*"))))
(with-current-buffer result-buffer
(org-mode)
(insert "* Extracted Headlines by Tag: " tag " *\n\n"))
(org-element-map (org-element-parse-buffer) 'headline
(lambda (headline)
(when (member tag (org-element-property :tags headline))
(with-current-buffer result-buffer
(insert (org-element-interpret-data headline) "\n")))))
(pop-to-buffer result-buffer))))
;; (load "bundle--mk")
(defvar mk/useful-websites
'(("https://regexr.com/" regex debug)
("https://regex101.com/" regex debug)
("https://www.regextester.com/" regex debug)
("https://extendsclass.com/regex-tester.html#python" regex debug)
("https://everything.curl.dev/" curl tool))
"I often forgot useful websites. So this is meant to be some kind of bookmark list.")
(defvar mk/mirror-website
"Locally mirror a website using `wget -mkEpnp <url>`")
(defvar mk/useful-regex
'(("match any word or space that precedes the :" . "[\\w\\s]+:")
("search for anything in square brackets" . "\\[.*\\]")
("upper and lowercase English alphabet" . "[A-Za-z]+")
("numbers from 0 to 9" . "[0-9]")
("upper and lowercase English alphabet, - and ." . "[A-Za-z\\-\\.]+")
("a, - and z" . "(a-z)")
("spaces or a comma" . "(\\s+|,)")
("find hashtags" . "#\\w+")
("matches both mentions (@) and hashtags" . "([@|#]\\w+)")
("email regex" . "^[a-zA-Z0-9_.+-]+@[a-zA-Z0-9-]+\\.[a-zA-Z0-9-.]+$")
("matching decimal numbers" . "-?\\d+(\\.\\d*)?")
("matching urls" . "(?:http|https|ftp|mailto|file|data|irc):\\/\\/[A-Za-z0-9\\-]{0,63}(\\.[A-Za-z0-9\\-]{0,63})+(:\\d{1,4})?\\/*(\\/*[A-Za-z0-9\\-._]+\\/*)*(\\?.*)?(#.*)?")
("matching dates yyyy/mm/dd" . "^\\d{4}/(0[1-9]|1[0-2])/(0[1-9]|[12][0-9]|3[01])$")
("matching dates mm/dd/yyyy" . "^(0[1-9]|1[0-2])/(0[1-9]|[12][0-9]|3[01])/\\d{4}$")
("matching dates dd/mm/yyyy" . "^(0[1-9]|[12][0-9]|3[01])/(0[1-9]|1[0-2])/\\d{4}$")
("matching HTML" . "<.+>")
("matching specific tags" . "</?(?:p|a|b|img)(?: /)?>")
("ISO 8601 Date Format (YYYY-MM-DD)" . "\\([0-9]{4}\\)-\\([0-1][0-9]\\)-\\([0-3][0-9]\\)")))
(defun mk/split-windows-horizontal (count-windows)
"Split windows horizontal by equal width."
(interactive "nHow many splits? ")
(delete-other-windows)
(let ((width (/ (window-total-width) count-windows)))
(dotimes (i (1- count-windows))
(split-window-right (- width)))))
(defun mk/split-windows-vertical (count-windows)
"Split windows vertical by equal width."
(interactive "nHow many splits? ")
(delete-other-windows)
(let ((height (/ (window-total-height) count-windows)))
(dotimes (i (1- count-windows))
(split-window-below (- height)))))
(defun mk/split ()
(mk/split-h3))
(defun mk/split-h3 ()
(interactive)
(mk/split-windows-horizontal 3))
(defun mk/split-v3 ()
(interactive)
(mk/split-windows-vertical 3))
;; Set transparency of emacs
(defun transparency (value)
"Sets the transparency of the frame window. 0=transparent/100=opaque"
(interactive "nTransparency Value 0 - 100 opaque: ")
(set-frame-parameter (selected-frame) 'alpha value))
(defun mk/show-agenda-list ()
(if (display-graphic-p)
(add-hook 'after-init-hook (lambda () (org-agenda-list) (mk/split-h3)))
(org-agenda-list)))
(defun mk/list-files (folder suffix)
(let ((regexp (concat "\\." suffix "$")))
(directory-files folder nil regexp)))
(defun mk/build-file-suffix ())
(defun mk/copy-files (src-dir dst-dir suffix)
(let ((src-files '())
(src-dir (expand-file-name src-dir))
(dst-dir (expand-file-name dst-dir)))
(dolist (file (mk/list-files src-dir suffix) src-files)
(let ((src-file (expand-file-name (concat src-dir "/" file)))
(dst-file (expand-file-name (concat dst-dir "/" file))))
(add-to-list 'src-files src-file)
(copy-file src-file dst-file t)))))
(defun mk/delete-files (lst)
(dolist (file lst)
(delete-file file t)))
(defun mk/get-current-time-formatted ()
(concat "#+DATE: "
(format "[%s]" (format-time-string "%Y-%m-%d %R" (current-time)))))
(defun mk/generate-unique-id ()
(interactive)
(let ((random-number-1 (random 9999))
(random-number-2 (random 9999)))
(let ((unique-id (format "DE-%04d-%04d" random-number-1 random-number-2)))
(message "ID: %s" unique-id) unique-id)))
(defmacro mk/open-html-page (name path buffer-name)
"Make interactive functions to call important docs"
`(defun ,name ()
(interactive)
(eww (concat "file://"
(and (eq system-type 'windows-nt)
"/")
(expand-file-name ,path)))
(rename-buffer ,buffer-name)))
(mk/open-html-page mk/clsite-clm
"~/cl-sites/www.cs.cmu.edu/Groups/AI/html/cltl/clm/node1.html"
"*mk/clsite-clm*")
(mk/open-html-page mk/clsite-pcl
"~/cl-sites/gigamonkeys.com/book/index.html"
"*mk/clsite-pcl*")
(mk/open-html-page mk/clsite-clcb
"~/cl-sites/lispcookbook.github.io/cl-cookbook/index.html"
"*mk/clsite-clcb*")
(mk/open-html-page mk/clsite-sqlite
"~/cl-sites/sqlite-doc-3440000/index.html"
"*mk/clsite-sqlite*")
(mk/open-html-page mk/clsite-asdf
"~/cl-sites/asdf.common-lisp.dev/index.html"
"*mk/clsite-asdf*")
(mk/open-html-page mk/clsite-lisp-docs
"~/cl-sites/lisp-docs.github.io/index.html"
"*mk/clsite-lisp-docs*")
(mk/open-html-page mk/clsite-bgnet
"~/cl-sites/bgnet/index.html"
"*mk/clsite-bgnet*")
(mk/open-html-page mk/clsite-tbnl
"~/cl-sites/edicl.github.io/hunchentoot/index.html"
"*mk/clsite-tbnl*")
(defun mk/wget-mirror-site (url)
"Use wget to mirror a website for offline use. Takes a URL as argument."
(interactive "sEnter the URL to mirror: ")
(let ((cmd (format "wget --mirror --convert-links --adjust-extension --page-requisites --no-parent %s" url)))
(async-shell-command cmd)))
(defun mk/get-auth-source-key (host key)
"Retrieve the API key using 'auth-source'."
(require 'auth-source)
(let* ((auth-source-creation-prompts
'((secret . (format "API key for %s@%s: " key host))))
(found (nth 0 (auth-source-search
:max 1
:host host
:user key
:require '(:secret)
:create t)))
(secret (plist-get found :secret)))
(if (functionp secret)
(funcall secret)
secret)))
;; (load "bundle--linux")
(defvar linux-filesystem-alist
'(( "/" . "Root directory, the base of the filesystem hierarchy")
("/bin" . "Essential command binaries, needed for booting")
("/boot" . "Bootloader files, kernel, and other files needed during booting")
("/dev" . "Device files representing hardware components")
("/etc" . "System-wide configuration files")
("/home" . "User home directories")
("/lib" . "Shared libraries and kernel modules")
("/media" . "Mount points for removable media like CDs and USBs")
("/mnt" . "Temporary mount points for filesystems")
("/opt" . "Optional application software packages")
("/proc" . "Virtual filesystem providing info about processes and system")
("/root" . "Home directory for the root user")
("/sbin" . "Essential system binaries, usually for the root user")
("/srv" . "Data directories for services like HTTP, FTP, etc.")
("/sys" . "Virtual filesystem for kernel objects")
("/tmp" . "Temporary files, cleared on reboot")
("/usr" . "User binaries, documentation, libraries, etc.")
("/var" . "Variable files like logs, databases, etc."))
"Alist mapping Linux directories to their descriptions.")
(defun describe-linux-directory (dirname)
"Describe the purpose of a Linux directory.
Takes DIRNAME as an argument and prints its description."
(interactive "sEnter Linux directory name (e.g., /bin): ")
(let ((description (assoc-default dirname linux-filesystem-alist)))
(if description
(message "%s: %s" dirname description)
(message "Unknown directory: %s" dirname))))
(defvar bash-regex-alist
'(("empty line" . "^$")
("backslash" . "\\\\")
("line starts with a dot" . "^\\.")
("line ends with a dot" . "\\.$")
("line starts with a dollar sign" . "^\\$")
("line starts with a caret" . "^\\^")
("left square bracket" . "\\[")
("right square bracket" . "\\]")
("entire line" . "^.*$")
("any alphanumeric character" . "[a-zA-Z0-9]")
("IP Address" . "\\b(?:[0-9]{1,3}\\.){3}[0-9]{1,3}\\b")
("email" . "[a-zA-Z0-9._%+-]+@[a-zA-Z0-9.-]+\\.[a-zA-Z]{2,}")
("hex color code" . "#[a-fA-F0-9]{6}")
("date in yyyy-mm-dd" . "\\b\\d{4}-\\d{2}-\\d{2}\\b")
("time in hh:mm:ss" . "\\b\\d{2}:\\d{2}:\\d{2}\\b")
("words without vowels" . "\\b[^aeiou\s]+\\b"))
"Alist mapping Bash regular expressions to their descriptions.")
(defun describe-bash-regex (regex)
"Describe the purpose of a Bash regular expression.
Takes REGEX as an argument and prints its description."
(interactive "sEnter Bash regex (e.g., empty line): ")
(let ((description (assoc-default regex bash-regex-alist)))
(if description
(message "%s: %s" regex description)
(message "Unknown regular expression: %s" regex))))
(defvar linux-process-commands-alist
'(("ps" . "Shows a snapshot of the current processes")
("top" . "Displays dynamic real-time view of system stats and processes")
("htop" . "An interactive process viewer, similar to top but more feature-rich")
("pgrep" . "Looks up processes based on name and other attributes")
("pstree" . "Displays the process tree in a tree-like diagram")
("ps -e" . "Lists all the processes running on the system")
("ps aux" . "Displays detailed information about all processes")
("kill" . "Terminates processes by sending signals")
("killall" . "Kills all processes that match the given name")
("pkill" . "Send signals to processes based on name and other attributes"))
"Alist mapping Linux process-checking commands to their descriptions.")
(defun describe-linux-process-command (command)
"Describe the purpose of a Linux process-checking command.
Takes COMMAND as an argument and prints its description."
(interactive "sEnter Linux process command (e.g., ps): ")
(let ((description (assoc-default command linux-process-commands-alist)))
(if description
(message "%s: %s" command description)
(message "Unknown command: %s" command))))
(defvar linux-logfiles-alist
'(("/var/log/syslog" . "System messages, including the messages that are logged during system startup")
("/var/log/auth.log" . "Security/authorization information, including user logins and authentication")
("/var/log/kern.log" . "Kernel logs")
("/var/log/cron.log" . "Logs for cron jobs")
("/var/log/messages" . "General system activity logs")
("/var/log/boot.log" . "System boot log")
("/var/log/daemon.log" . "Background daemon log messages")
("/var/log/dpkg.log" . "Logs for package installations and removals")
("/var/log/mail.log" . "Mail server logs")
("/var/log/user.log" . "User-level messages"))
"Alist mapping Linux log files to their descriptions.")
(defun describe-linux-logfile (logfile)
"Describe the purpose of a Linux log file.
Takes LOGFILE as an argument and prints its description."
(interactive "sEnter Linux log file path (e.g., /var/log/syslog): ")
(let ((description (assoc-default logfile linux-logfiles-alist)))
(if description
(message "%s: %s" logfile description)
(message "Unknown log file: %s" logfile))))
(defvar linux-basic-commands-alist
'(("list directory contents" . "ls")
("change directory" . "cd")
("move or rename files" . "mv")
("copy files" . "cp")
("remove files or directories" . "rm")
("print working directory" . "pwd")
("display variable value" . "echo")
("create an empty file" . "touch")
("change file permissions" . "chmod")
("change file ownership" . "chown"))
"Alist mapping basic Linux command descriptions to their commands.")
(defun describe-basic-linux-command (command)
"Describe the purpose of a basic Linux command.
Takes COMMAND as an argument and prints its description."
(interactive "sEnter basic Linux command (e.g., ls): ")
(let ((description (assoc-default command linux-basic-commands-alist)))
(if description
(message "%s: %s" command description)
(message "Unknown command: %s" command))))
(defvar chown-options-alist
'(("-R" . "Operate on files and directories recursively")
("--from" . "Change the owner and/or group of each file only if its current owner and/or group match specified values")
("--no-dereference" . "Affect symbolic links instead of the files they point to")
("--preserve-root" . "Fail when attempting to operate recursively on '/'")
("--reference" . "Use owner and group of a reference file")
("-c" . "Report when a change is made")
("-f" . "Suppress most error messages")
("-v" . "Output a diagnostic for every file processed"))
"Alist mapping chown command options to their descriptions.")
(defun describe-chown-option (option)
"Describe the purpose of a chown option.
Takes OPTION as an argument and prints its description."
(interactive "sEnter chown option (e.g., -R): ")
(let ((description (assoc-default option chown-options-alist)))
(if description
(message "%s: %s" option description)
(message "Unknown chown option: %s" option))))
(defvar chmod-options-alist
'(("-R" . "Operate on files and directories recursively")
("--preserve-root" . "Avoid operating recursively on '/'")
("-c" . "Report when a change is made")
("-f" . "Suppress most error messages")
("-v" . "Output a diagnostic for every file processed")
("--reference" . "Use mode of a reference file")
("-w" . "Remove write permission")
("-x" . "Remove execute permission")
("-u" . "Set user ID on execution")
("-g" . "Set group ID on execution"))
"Alist mapping chmod command options to their descriptions.")
(defun describe-chmod-option (option)
"Describe the purpose of a chmod option.
Takes OPTION as an argument and prints its description."
(interactive "sEnter chmod option (e.g., -R): ")
(let ((description (assoc-default option chmod-options-alist)))
(if description
(message "%s: %s" option description)
(message "Unknown chmod option: %s" option))))
(defvar ssh-use-cases-alist
'(("remote login" . "ssh user@host")
("run command" . "ssh user@host 'command'")
("file transfer" . "scp file.txt user@host:/path/")
("secure ftp" . "sftp user@host")
("port forwarding" . "ssh -L local_port:remote_host:remote_port user@host")
("dynamic port forwarding" . "ssh -D port user@host")
("remote port forwarding" . "ssh -R remote_port:local_host:local_port user@host")
("tunneling" . "ssh -L local_port:remote_host:remote_port user@host -f -N")
("agent forwarding" . "ssh -A user@host")
("ssh multiplexing" . "ssh -M -S /tmp/ssh_socket user@host; ssh -S /tmp/ssh_socket user@host"))
"Alist mapping SSH use cases to their corresponding commands.")
(defun describe-ssh-use-case (use-case)
"Describe the SSH command for a given use case."
(interactive "sEnter the SSH use case: ")
(let ((command (assoc-default use-case ssh-use-cases-alist)))
(if command
(message "Command for %s: %s" use-case command)
(message "Use case not found"))))
(defvar mk/remote-*host-aliases*
'(("website" . "marcus@www.marcuskammer.dev")
("survey" . "cl@survey.metalisp.dev")
("pihole" . "ubuntu@pi-hole.fritz.box"))
"Alist mapping friendly host names to actual SSH-compatible host strings.")
(defun mk/remote--get-real-host (alias)
"Lookup the real host name based on a given ALIAS."
(or (cdr (assoc alias mk/remote-*host-aliases*)) alias))
(defun mk/remote--systemctl-service (alias service command)
"Execute a systemctl COMMAND on a systemd SERVICE on a remote host identified by ALIAS.
ALIAS is a string that specifies the remote host; it can be an
alias defined in `mk/remote-*host-aliases*'.
SERVICE is the name of the systemd service to operate on.
COMMAND is the systemctl command to execute on the service (e.g.,
'start', 'stop', 'status')."
(let* ((host (mk/remote--get-real-host alias))
(buffer (generate-new-buffer (format "*%s-%s-%s*" alias service command)))
(process-name (format "systemctl-%s-%s" command service)))
(make-process :name process-name
:buffer buffer
:command `("ssh" ,host "sudo" "systemctl" ,command ,service)
:sentinel (lambda (process signal)
(when (memq (process-status process) '(exit signal))
(message "Process: %s %s" process signal))))))
(defmacro mk/remote-define-systemctl-functions (&rest actions)
"Dynamically create functions to interact with systemd services on a remote host.
Each function will be named `mk/remote-ACTION-service', where
ACTION is one of the symbols in ACTIONS. The functions will take
an ALIAS and SERVICE as arguments and call
`mk/remote--systemctl-service' accordingly."
`(progn
,@(mapcar
(lambda (action)
`(defun ,(intern (format "mk/remote-%s-service" action)) (alias service)
(interactive "sEnter the host alias or name: \nsEnter the service name: ")
(mk/remote--systemctl-service alias service ,(symbol-name action))))
actions)))
(mk/remote-define-systemctl-functions start stop status)
(defun mk/remote--log (alias service filename)
(let* ((filepath (concat "/var/log/" service (unless (string-empty-p filename) (concat "/" filename))))
(host (mk/remote--get-real-host alias))
(buffer (generate-new-buffer (format "*%s-%s-%s*" alias service filename)))
(process-name (format "log-%s-%s" service filename)))
(make-process :name process-name
:buffer buffer
:command `("ssh" ,host "sudo" "tail -f" ,filepath)
:sentinel (lambda (process signal)
(when (memq (process-status process) '(exit signal))
(message "Process: %s %s" process signal))))))
(defmacro mk/define-remote-log-function (alias service &optional filename)
"Define a function to asynchronously tail a remote log file."
(let ((fname (if filename filename "")))
`(defun ,(intern (format "mk/remote-log-%s-%s-%s" alias service filename)) ()
,(format "Tail the remote log file: %s" filename)
(interactive)
(mk/remote--log ,alias ,service ,fname))))
(mk/define-remote-log-function "website" "nginx" "access.csv")
(mk/define-remote-log-function "website" "nginx" "error.log")
(mk/define-remote-log-function "website" "syslog")
(mk/define-remote-log-function "survey" "nginx" "access.csv")
(mk/define-remote-log-function "survey" "syslog")
(mk/define-remote-log-function "pihole" "pihole" "pihole.log")
(defun mk/babel-ansi ()
(when-let ((beg (org-babel-where-is-src-block-result nil nil)))
(save-excursion
(goto-char beg)
(when (looking-at org-babel-result-regexp)
(let ((end (org-babel-result-end))
(ansi-color-context-region nil))
(ansi-color-apply-on-region beg end))))))
(add-hook 'org-babel-after-execute-hook 'mk/babel-ansi)
(defun mk/toggle-frame-decorations ()
"Toggle the window decorations (title bar, menu bar, tool bar, scroll bar) for the current frame."
(interactive)
(let* ((frame (selected-frame))
(current-undecorated (frame-parameter frame 'undecorated))
(new-undecorated (not current-undecorated)))
(set-frame-parameter frame 'undecorated new-undecorated)
(if new-undecorated
(progn
(menu-bar-mode -1)
(tool-bar-mode -1)
(scroll-bar-mode -1)))
(message "Window decorations %s" (if new-undecorated "disabled" "enabled"))))
(global-set-key (kbd "<f12>") 'mk/toggle-frame-decorations)
(defun mk/set-frame-size-85x50 ()
"Set the current frame's size to 85 columns by 50 rows."
(interactive)
(set-frame-size (selected-frame) 92 53))
(global-set-key (kbd "M-<f11>") #'mk/set-frame-size-85x50)
(defun shell-new-bottom ()
"Open a shell window in the bottom third of the current window."
(interactive)
(let* ((current-window (selected-window))
(new-window (split-window-below (- (window-height) (/ (window-height) 3)))))
(select-window new-window)
(shell)
(select-window current-window)))
(provide 'bundle-mk)
;;; bundle-mk.el ends here