From 88ce9336138822d41b9b03a642bb92be4f54d987 Mon Sep 17 00:00:00 2001 From: Case Duckworth Date: Wed, 10 Jul 2024 21:17:26 -0500 Subject: Updates! --- emacs | 9 +- emacs.d/bob-theme.el | 7 +- emacs.d/brianna-theme.el | 114 +++++----- emacs.d/early-init.el | 539 ++++++++++++++++++++++++----------------------- exwm | 3 + 5 files changed, 343 insertions(+), 329 deletions(-) diff --git a/emacs b/emacs index 26e5bbb..9d467a1 100644 --- a/emacs +++ b/emacs @@ -19,7 +19,7 @@ (set-file-modes user-private-file #o600)) (load user-private-file :no-error) -(load-theme 'bob :no-confirm) ; see ~/.emacs.d/bob-theme.el +(load-theme 'brianna :no-confirm) ; see ~/.emacs.d/brianna-theme.el (add-hook 'after-init-hook #'setup-faces) (define-advice startup-echo-area-message (:override ()) @@ -93,7 +93,8 @@ (define-globalized-minor-mode auto-fixed-pitch-mode fixed-pitch-mode fixed-pitch-mode :predicate '(special-mode - prog-mode)) + prog-mode + comint-mode)) (setopt cursor-type 'bar) (hide-minor-mode 'buffer-face-mode) @@ -495,8 +496,8 @@ (locate-user-emacs-file "early-init.el")) "c" (find-user-file custom custom-file) "p" (find-user-file private) - "t" (find-user-file bob - (locate-user-emacs-file "bob-theme.el")) + "t" (find-user-file brianna + (locate-user-emacs-file "brianna-theme.el")) "x" (find-user-file exwm (expand-file-name "~/.exwm")) "s" #'scratch-buffer)) diff --git a/emacs.d/bob-theme.el b/emacs.d/bob-theme.el index 63c84db..b3efc9a 100644 --- a/emacs.d/bob-theme.el +++ b/emacs.d/bob-theme.el @@ -37,7 +37,7 @@ `(font-lock-escape-face ,fclear) `(font-lock-function-call-face ,fclear) `(font-lock-function-name-face ,fclear) - ;; `(font-lock-keyword-face ,fclear) + `(font-lock-keyword-face ,fclear) `(font-lock-misc-punctuation-face ,fclear) `(font-lock-negation-char-face ,fclear) `(font-lock-number-face ,fclear) @@ -59,17 +59,16 @@ '(font-lock-comment-delimiter-face ((t (:slant italic)))) '(font-lock-comment-face ((t (:slant italic)))) '(font-lock-doc-face ((t (:slant italic)))) - '(font-lock-keyword-face ((t (:weight bold)))) ;; Propertized text '(bold ((t (:weight bold)))) '(error ((t (:foreground "red" :slant italic)))) '(highlight ((t (:background "yellow")))) - '(isearch ((t (:background "yellow")))) + '(isearch ((t (:background "yellow" :foreground "black")))) '(isearch-fail ((t (:inherit error)))) '(italic ((t (:slant italic)))) '(lazy-highlight ((t (:background "#808080")))) - '(link ((t (:foreground "000080" :underline t)))) + '(link ((t (:foreground "#000080" :underline t)))) '(match ((t (:background "yellow")))) '(pulse-highlight-start-face ((t (:background "#000080")))) '(query-replace ((t (:background "yellow")))) diff --git a/emacs.d/brianna-theme.el b/emacs.d/brianna-theme.el index 43223f6..a4cd74d 100644 --- a/emacs.d/brianna-theme.el +++ b/emacs.d/brianna-theme.el @@ -17,7 +17,11 @@ ;; :inverse-video nil :extend nil))) "Specification to clear a given face.") -(defface brianna-prompt '((t (:foreground "purple"))) +(defun fclear (face) + "Set FACE spec to `fclear' --- inside `custom-theme-set-faces'." + (list face fclear)) + +(defface brianna-prompt '((t (:inherit bold))) "A face for prompts.") (defface brianna-input-field '((t ( :background "lavender" @@ -31,40 +35,37 @@ :background "alice blue")))) ;; Font lock -- clear - `(font-lock-bracket-face ,fclear) - `(font-lock-builtin-face ,fclear) - ;; `(font-lock-comment-delimiter-face ,fclear) - ;; `(font-lock-comment-face ,fclear) - `(font-lock-constant-face ,fclear) - `(font-lock-delimiter-face ,fclear) - ;; `(font-lock-doc-face ,fclear) - `(font-lock-doc-markup-face ,fclear) - `(font-lock-escape-face ,fclear) - `(font-lock-function-call-face ,fclear) - `(font-lock-function-name-face ,fclear) - ;; `(font-lock-keyword-face ,fclear) - `(font-lock-misc-punctuation-face ,fclear) - `(font-lock-negation-char-face ,fclear) - `(font-lock-number-face ,fclear) - `(font-lock-operator-face ,fclear) - `(font-lock-preprocessor-face ,fclear) - `(font-lock-property-name-face ,fclear) - `(font-lock-property-use-face ,fclear) - `(font-lock-punctuation-face ,fclear) - `(font-lock-regexp-face ,fclear) - `(font-lock-regexp-grouping-backslash ,fclear) - `(font-lock-regexp-grouping-construct ,fclear) - `(font-lock-string-face ,fclear) - `(font-lock-type-face ,fclear) - `(font-lock-variable-name-face ,fclear) - `(font-lock-variable-use-face ,fclear) - `(font-lock-warning-face ,fclear) + (fclear 'font-lock-bracket-face) + (fclear 'font-lock-builtin-face) + (fclear 'font-lock-constant-face) + (fclear 'font-lock-delimiter-face) + (fclear 'font-lock-doc-markup-face) + (fclear 'font-lock-escape-face) + (fclear 'font-lock-function-call-face) + (fclear 'font-lock-function-name-face) + (fclear 'font-lock-keyword-face) + (fclear 'font-lock-misc-punctuation-face) + (fclear 'font-lock-negation-char-face) + (fclear 'font-lock-number-face) + (fclear 'font-lock-operator-face) + (fclear 'font-lock-preprocessor-face) + (fclear 'font-lock-property-name-face) + (fclear 'font-lock-property-use-face) + (fclear 'font-lock-punctuation-face) + (fclear 'font-lock-regexp-face) + (fclear 'font-lock-regexp-grouping-backslash) + (fclear 'font-lock-regexp-grouping-construct) + (fclear 'font-lock-type-face) + (fclear 'font-lock-variable-name-face) + (fclear 'font-lock-variable-use-face) + (fclear 'font-lock-warning-face) ;; Font lock '(font-lock-comment-delimiter-face ((t (:slant italic)))) '(font-lock-comment-face ((t (:slant italic)))) - '(font-lock-doc-face ((t (:slant italic)))) - '(font-lock-keyword-face ((t (:weight bold)))) + '(font-lock-string-face ((t (:weight bold)))) + '(font-lock-doc-face ((t (:inherit (font-lock-string-face + font-lock-comment-face))))) ;; Propertized text '(bold ((t (:weight bold)))) @@ -105,6 +106,16 @@ '(vertical-border ((t (:foreground "gray")))) ;;; Specific modes &c + ;; Outline --- these go first b/c so many other headlines inherit from them + '(outline-1 ((t (:inherit (bold underline italic) :extend t)))) + '(outline-2 ((t (:inherit (bold underline))))) + '(outline-3 ((t (:inherit (italic underline))))) + '(outline-3 ((t (:inherit (italic underline))))) + '(outline-4 ((t (:inherit (italic underline))))) + '(outline-5 ((t (:inherit (italic underline))))) + '(outline-6 ((t (:inherit (italic underline))))) + '(outline-7 ((t (:inherit (italic underline))))) + '(outline-8 ((t (:inherit (italic underline))))) ;; Dired '(dired-header ((t (:underline t :extend t)))) ;; Elastic indent @@ -114,17 +125,14 @@ ;; Eww '(eww-form-text ((t (:inherit brianna-input-field)))) ;; Gemtext mode - '(gemtext-face-heading1 ((t ( :weight bold - :inherit variable-pitch)))) - '(gemtext-face-heading2 ((t ( :weight bold - :inherit variable-pitch)))) - '(gemtext-face-heading3 ((t ( :weight bold - :inherit variable-pitch)))) + '(gemtext-face-heading1 ((t (:inherit outline-1)))) + '(gemtext-face-heading2 ((t (:inherit outline-2)))) + '(gemtext-face-heading3 ((t (:inherit outline-3)))) ;; Info - '(info-title-1 ((t (:inherit variable-pitch)))) - '(info-title-2 ((t (:inherit variable-pitch)))) - '(info-title-3 ((t (:inherit variable-pitch)))) - '(info-title-4 ((t (:inherit variable-pitch)))) + '(info-title-1 ((t (:inherit outline-1)))) + '(info-title-2 ((t (:inherit outline-2)))) + '(info-title-3 ((t (:inherit outline-3)))) + '(info-title-4 ((t (:inherit outline-4)))) ;; Jabber '(jabber-activity-face ((t (:inherit italic)))) '(jabber-activity-personal-face ((t (:inherit rcirc-track-nick)))) @@ -136,23 +144,13 @@ '(jabber-chat-text-local ((t (:inherit default)))) '(jabber-muc-presence-dim ((t (:inherit shadow)))) '(jabber-rare-time-face ((t (:inherit shadow)))) - '(jabber-title-large ((t (:inherit (variable-pitch outline-1))))) - '(jabber-title-medium ((t (:inherit (variable-pitch outline-2))))) - '(jabber-title-small ((t (:inherit (variable-pitch outline-3))))) - ;; Outline - '(outline-1 ((t (:inherit (bold underline italic) :extend t)))) - '(outline-2 ((t (:inherit (bold underline))))) - '(outline-3 ((t (:inherit (italic underline))))) - '(outline-3 ((t (:inherit (italic underline))))) - '(outline-4 ((t (:inherit (italic underline))))) - '(outline-5 ((t (:inherit (italic underline))))) - '(outline-6 ((t (:inherit (italic underline))))) - '(outline-7 ((t (:inherit (italic underline))))) - '(outline-8 ((t (:inherit (italic underline))))) + '(jabber-title-large ((t (:inherit outline-1)))) + '(jabber-title-medium ((t (:inherit outline-2)))) + '(jabber-title-small ((t (:inherit outline-3)))) ;; Org - '(org-document-info-keyword ((t (:inherit default)))) - '(org-document-info ((t (:foreground "navy")))) - '(org-document-title ((t (:inherit org-document-info)))) + (fclear 'org-document-info-keyword) + (fclear 'org-document-info) + (fclear 'org-document-title) '(org-drawer ((t (:inherit font-lock-comment-face)))) ;; RCIRC '(rcirc-my-nick ((t (:weight bold :slant italic)))) @@ -165,7 +163,7 @@ ;; Sh '(sh-heredoc ((t ( :background "azure" :extend t :inherit font-lock-string-face)))) - '(sh-quoted-exec ((t ()))) + (fclear 'sh-quoted-exec) ;; Widgets '(widget-field ((t (:inherit brianna-input-field)))) '(widget-single-line-field ((t (:inherit brianna-input-field)))) diff --git a/emacs.d/early-init.el b/emacs.d/early-init.el index bbf9464..1a5d9a5 100644 --- a/emacs.d/early-init.el +++ b/emacs.d/early-init.el @@ -1,40 +1,103 @@ ;;; ~/.emacs.d/early-init.el -*- lexical-binding: t; -*- ;; Author: Case Duckworth +;; In this file there are custom functions and macros and early-init settings, +;; all alphabetically ordered. -(setopt frame-inhibit-implied-resize t) -(setopt frame-resize-pixelwise t) -(setopt window-resize-pixelwise t) -(setopt default-frame-alist - '((menu-bar-lines . 0) - (tool-bar-lines . 0) - ;;(vertical-scroll-bars) - (horizontal-scroll-bars))) +;; There is a bug in M-x finger +(define-advice finger (:override (user host) acdw-fix) + "Finger USER on HOST. +This command uses `finger-X.500-host-regexps' +and `network-connection-service-alist', which see." + ;; One of those great interactive statements that's actually + ;; longer than the function call! The idea is that if the user + ;; uses a string like "pbreton@cs.umb.edu", we won't ask for the + ;; host name. If we don't see an "@", we'll prompt for the host. + (interactive + (let* ((answer (let ((default (ffap-url-at-point))) + (read-string (format-prompt "Finger User" default) + nil nil default))) + (index (string-match (regexp-quote "@") answer))) + (if index + (list (substring answer 0 index) + (substring answer (1+ index))) + (list answer + (let ((default (ffap-machine-at-point))) + (read-string (format-prompt "At Host" default) + nil nil default)))))) + (let* ((user-and-host (concat user "@" host)) + (process-name (concat "Finger [" user-and-host "]")) + (regexps finger-X.500-host-regexps) + ) ;; found + (and regexps + (while (not (string-match (car regexps) host)) + (setq regexps (cdr regexps)))) + (when regexps + (setq user-and-host user)) + (run-network-program + process-name + host + (cdr (assoc 'finger network-connection-service-alist)) + user-and-host))) -(when (getenv "IN_EXWM") - (add-to-list 'default-frame-alist '(fullscreen . fullboth))) +(defmacro after (event &rest body) + "Do BODY after EVENT, which can be: +- A feature +- A hook -- if it requires arguments they'll be in the list `args' +- The symbol 'init, which runs on after-init-hook" + (declare (indent 1)) + (let ((lambda-form `(lambda (&rest args) ,@body))) + (pcase event + (`(timer ,ev) `(run-with-timer ,ev nil ,lambda-form)) + (`(idle ,ev) `(run-with-idle-timer ,ev nil ,lambda-form)) + (`(hook ,ev) `(add-hook ',ev ,lambda-form)) + (`init `(after (hook after-init-hook) ,@body)) + ((pred numberp) `(after (timer ,event) ,@body)) + ((pred (lambda (ev) + (and (symbolp ev) + (or (string-suffix-p "-hook" (symbol-name ev)) + (string-suffix-p "-function" (symbol-name ev)) + (string-suffix-p "-functions" (symbol-name ev)))))) + `(after (hook ,event) ,@body)) + ((pred symbolp) `(with-eval-after-load ',event ,@body)) -(defvar *fonts* - (let ((fixed "Recursive Mono Casual Static") - (variable "Recursive Sans Casual Static")) - `((default - :family ,variable - :height 100) - (variable-pitch - :family ,variable) - (fixed-pitch - :family ,fixed) - (fixed-pitch-serif - :family "Recursive Mono Linear Static")))) - -(require 'package) -(add-to-list 'package-archives '("melpa" . "https://melpa.org/packages/")) -(package-initialize) - -;;; Custom functions + (_ (error "Can't determine event type" event))))) -(defun pulse@eval (start end &rest _) - "ADVICE: makes `pulse-momentary-highlight-region' accept other arities." - (pulse-momentary-highlight-region start end)) +(defmacro find-user-file (name &optional file-name) + "Template macro to generate user file finding functions." + (declare (indent 1)) + (let ((file-name (or file-name (intern (format "user-%s-file" name)))) + (func-name (intern (format "find-user-%s-file" name)))) + `(defun ,func-name (&optional arg) + ,(format "Edit `%s' in the current window. +With ARG, edit in the other window." file-name) + (interactive "P") + (funcall (if arg #'find-file-other-window #'find-file) + ,file-name)))) + +(defmacro inhibit-messages (&rest body) + "Inhibit all messages in BODY." + (declare (indent defun)) + `(cl-letf (((symbol-function 'message) #'ignore)) + ,@body)) + +;; This needs to be a macro to take advantage of setf magic +(defmacro setf/alist (alist key val &optional testfn) + `(setf (alist-get ,key ,alist nil nil (or ,testfn #'equal)) + ,val)) + +(defun ^local-hook (hook fn) + "Hook FN to HOOK locally in a lambda. +Good for adding to an add-hook." + (lambda () (add-hook hook fn t))) + +(defun ^local-unhook (hook fn) + "Remove FN from HOOK locally." + (lambda () (remove-hook hook fn t))) + +(defun ^turn-off (mode) + "Higher-order function: returns a lambda to turn off MODE." + (lambda () + (funcall mode -1))) (defun create-missing-directories () "Automatically create missing directories." @@ -42,6 +105,20 @@ (unless (file-exists-p target-dir) (make-directory target-dir :parents)))) +(defun custom-show-all-widgets () + "toggle all \"More/Hide\" widgets in the current buffer." + ;; From unpackaged + (interactive) + (widget-map-buttons (lambda (widget _) + (pcase (widget-get widget :off) + ("More" (widget-apply-action widget))) + nil))) + +(defun cycle-spacing* (&optional n) + "Negate N argument on `cycle-spacing'." + (interactive "*p") + (cycle-spacing (- n))) + (defun delete-trailing-whitespace-except-current-line () "Delete all trailing whitespace except current line." (save-excursion @@ -50,6 +127,14 @@ (delete-trailing-whitespace (line-end-position) (point-max)))) +(defun delete-window-dwim () + "Delete the current window or bury its buffer. +If the current window is alone in its frame, bury the buffer +instead." + (interactive) + (unless (ignore-errors (delete-window) t) + (bury-buffer))) + (defun first-found-font (&rest cands) "Return the first font of CANDS that is installed, or nil." (cl-loop with ffl = (font-family-list) @@ -57,56 +142,29 @@ if (member font ffl) return font)) -(defun setup-faces () - "Setup Emacs faces." - ;; Default faces - (cl-loop for (face . spec) in *fonts* - do (set-face-attribute face nil - :family (plist-get spec :family) - :height (or (plist-get spec :height) - 'unspecified))) - ;; Specialized fonts - (cl-loop with ffl = (font-family-list) - for (charset . font) - in '((latin . "Noto Sans") - (han . "Noto Sans CJK SC Regular") - (kana . "Noto Sans CJK JP Regular") - (hangul . "Noto Sans CJK KR Regular") - (cjk-misc . "Noto Sans CJK KR Regular") - (khmer . "Noto Sans Khmer") - (lao . "Noto Sans Lao") - (burmese . "Noto Sans Myanmar") - (thai . "Noto Sans Thai") - (ethiopic . "Noto Sans Ethiopic") - (hebrew . "Noto Sans Hebrew") - (arabic . "Noto Sans Arabic") - (gujarati . "Noto Sans Gujarati") - (devanagari . "Noto Sans Devanagari") - (kannada . "Noto Sans Kannada") - (malayalam . "Noto Sans Malayalam") - (oriya . "Noto Sans Oriya") - (sinhala . "Noto Sans Sinhala") - (tamil . "Noto Sans Tamil") - (telugu . "Noto Sans Telugu") - (tibetan . "Noto Sans Tibetan") - ;; emojis - (symbol . "Noto Emoji") - (symbol . "Noto Color Emoji") - (symbol . "Segoe UI Emoji") - (symbol . "Apple Color Emoji") - (symbol . "FreeSans") - (symbol . "FreeMono") - (symbol . "FreeSerif") - (symbol . "Unifont") - (symbol . "Symbola")) - if (member font ffl) - do (set-fontset-font t charset font))) +(defun fixup-whitespace () + "Indent the current buffer and (un)`tabify'. +Whether it tabifies or untabifies depends on `space-indent-modes'." + (interactive) + (save-mark-and-excursion + (indent-region (point-min) (point-max)) + (if indent-tabs-mode + (tabify (point-min) (point-max)) + (untabify (point-min) (point-max))) + (replace-regexp-in-region " $" "" (point-min) (point-max)))) -(defmacro inhibit-messages (&rest body) - "Inhibit all messages in BODY." - (declare (indent defun)) - `(cl-letf (((symbol-function 'message) #'ignore)) - ,@body)) +(defun hide-minor-mode (mode &optional hook) + "Hide MODE from the mode-line. +HOOK is used to trigger the action, and defaults to MODE-hook." + (setf (alist-get mode minor-mode-alist) (list "")) + (add-hook (intern (or hook (format "%s-hook" mode))) + (lambda () (hide-minor-mode mode)))) + +(defun keyboard-quit* (arg) + (interactive "P") + (if arg + (quit-minibuffer) + (keyboard-quit))) (defun kill-buffer-dwim (&optional buffer-or-name) "Kill BUFFER-OR-NAME or the current buffer." @@ -119,6 +177,30 @@ (:else (kill-buffer (read-buffer "Kill: " nil :require-match))))) +(defun minibuffer-delete-directory (&optional n) + "Delete the last directory in a file-completing minibuffer." + ;; Cribbed from `vertico-directory-up' (github.com/minad/vertico) + (interactive "p") + (let ((here (point)) + (meta (completion-metadata + "" minibuffer-completion-table + minibuffer-completion-predicate))) + (when (and (> (point) (minibuffer-prompt-end)) + (eq 'file (completion-metadata-get meta 'category))) + (let ((path (buffer-substring-no-properties (minibuffer-prompt-end) + (point))) + found) + (when (string-match-p "\\`~[^/]*/\\'" path) + (delete-minibuffer-contents) + (insert (expand-file-name path))) + (dotimes (_ (or n 1) found) + (save-excursion + (let ((end (point))) + (goto-char (1- end)) + (when (search-backward "/" (minibuffer-prompt-end) t) + (delete-region (1+ (point)) end) + (setq found t))))))))) + (defun other-window-dwim (&optional arg) "Switch to another window/buffer. Calls `other-window', which see, unless @@ -130,42 +212,6 @@ In these cases, switch to the last-used buffer." (switch-to-buffer (other-buffer) nil t) (other-window 1))) -(defun delete-window-dwim () - "Delete the current window or bury its buffer. -If the current window is alone in its frame, bury the buffer -instead." - (interactive) - (unless (ignore-errors (delete-window) t) - (bury-buffer))) - -(defun cycle-spacing* (&optional n) - "Negate N argument on `cycle-spacing'." - (interactive "*p") - (cycle-spacing (- n))) - -(defmacro find-user-file (name &optional file-name) - "Template macro to generate user file finding functions." - (declare (indent 1)) - (let ((file-name (or file-name (intern (format "user-%s-file" name)))) - (func-name (intern (format "find-user-%s-file" name)))) - `(defun ,func-name (&optional arg) - ,(format "Edit `%s' in the current window. -With ARG, edit in the other window." file-name) - (interactive "P") - (funcall (if arg #'find-file-other-window #'find-file) - ,file-name)))) - -(defun fixup-whitespace () - "Indent the current buffer and (un)`tabify'. -Whether it tabifies or untabifies depends on `space-indent-modes'." - (interactive) - (save-mark-and-excursion - (indent-region (point-min) (point-max)) - (if indent-tabs-mode - (tabify (point-min) (point-max)) - (untabify (point-min) (point-max))) - (replace-regexp-in-region " $" "" (point-min) (point-max)))) - (defun package-ensure (pkgspec &optional require) "Install PKG if it's not already installed. REQUIRE means require it after ensuring it's installed." @@ -190,83 +236,6 @@ REQUIRE means require it after ensuring it's installed." (package-vc-install pkgspec)) (when require (require pkg)))) -(defun minibuffer-delete-directory () - "Delete the last directory in a file-completing minibuffer." - (interactive) - (let ((here (point)) - (meta (completion-metadata - "" minibuffer-completion-table - minibuffer-completion-predicate))) - (if (eq (completion-metadata-get meta 'category) 'file) - (when (search-backward "/" (minibuffer-prompt-end) t) - (delete-region (point) here)) - (backward-kill-word 1)))) - -(defun save-buffers-kill* (arg) - "Save all the buffers and kill ... something. -If ARG is 1 (called normally), kill the current terminal. -If ARG is 4 (with C-u), kill emacs but ask if there are processes running. -If ARG is 16, kill emacs without asking about processes." - (interactive "p") - (pcase arg - (1 (save-buffers-kill-terminal)) - (4 (save-buffers-kill-emacs t)) - (16 (let ((confirm-kill-processes nil) - (kill-emacs-query-functions nil) - (confirm-kill-emacs nil)) - (save-buffers-kill-emacs t))))) - -(defun regexp-concat (&rest regexps) - (string-join regexps "\\|")) - -;; There is a bug in M-x finger -(defun acdw/finger (user host) - "Finger USER on HOST. -This command uses `finger-X.500-host-regexps' -and `network-connection-service-alist', which see." - ;; One of those great interactive statements that's actually - ;; longer than the function call! The idea is that if the user - ;; uses a string like "pbreton@cs.umb.edu", we won't ask for the - ;; host name. If we don't see an "@", we'll prompt for the host. - (interactive - (let* ((answer (let ((default (ffap-url-at-point))) - (read-string (format-prompt "Finger User" default) nil nil default))) - (index (string-match (regexp-quote "@") answer))) - (if index - (list (substring answer 0 index) - (substring answer (1+ index))) - (list answer - (let ((default (ffap-machine-at-point))) - (read-string (format-prompt "At Host" default) nil nil default)))))) - (let* ((user-and-host (concat user "@" host)) - (process-name (concat "Finger [" user-and-host "]")) - (regexps finger-X.500-host-regexps) - ) ;; found - (and regexps - (while (not (string-match (car regexps) host)) - (setq regexps (cdr regexps)))) - (when regexps - (setq user-and-host user)) - (run-network-program - process-name - host - (cdr (assoc 'finger network-connection-service-alist)) - user-and-host))) - -(advice-add 'finger :override #'acdw-finger) - -(defun hide-minor-mode (mode &optional hook) - "Hide MODE from the mode-line. -HOOK is used to trigger the action, and defaults to MODE-hook." - (setf (alist-get mode minor-mode-alist) (list "")) - (add-hook (intern (or hook (format "%s-hook" mode))) - (lambda () (hide-minor-mode mode)))) - -(defun switch-to-other-buffer () - "Switch to the `other-buffer'." - (interactive) - (switch-to-buffer nil)) - (defun popup-eshell (arg) "Popup an eshell buffer in the current window." (interactive "P") @@ -280,34 +249,76 @@ HOOK is used to trigger the action, and defaults to MODE-hook." (insert "# ")) (eshell-send-input)))) -(defun vc-jump (arg) - "Jump to the current project's VC buffer. -With ARG, prompt for the directory." - (interactive "P") - (if arg - (let ((current-prefix-arg nil)) - (call-interactively #'vc-dir)) - (project-vc-dir))) - -(defun custom-show-all-widgets () - "toggle all \"More/Hide\" widgets in the current buffer." - ;; From unpackaged - (interactive) - (widget-map-buttons (lambda (widget _) - (pcase (widget-get widget :off) - ("More" (widget-apply-action widget))) - nil))) +(defun pulse@eval (start end &rest _) + "ADVICE: makes `pulse-momentary-highlight-region' accept other arities." + (pulse-momentary-highlight-region start end)) (defun quit-minibuffer () (interactive) (switch-to-minibuffer) (minibuffer-keyboard-quit)) -(defun keyboard-quit* (arg) - (interactive "P") - (if arg - (quit-minibuffer) - (keyboard-quit))) +(defun regexp-concat (&rest regexps) + (string-join regexps "\\|")) + +(defun save-buffers-kill* (arg) + "Save all the buffers and kill ... something. +If ARG is 1 (called normally), kill the current terminal. +If ARG is 4 (with C-u), kill emacs but ask if there are processes running. +If ARG is 16, kill emacs without asking about processes." + (interactive "p") + (pcase arg + (1 (save-buffers-kill-terminal)) + (4 (save-buffers-kill-emacs t)) + (16 (let ((confirm-kill-processes nil) + (kill-emacs-query-functions nil) + (confirm-kill-emacs nil)) + (save-buffers-kill-emacs t))))) + +(defun setup-faces () + "Setup Emacs faces." + ;; Default faces + (cl-loop for (face . spec) in *fonts* + do (set-face-attribute face nil + :family (plist-get spec :family) + :height (or (plist-get spec :height) + 'unspecified))) + ;; Specialized fonts + (cl-loop with ffl = (font-family-list) + for (charset . font) + in '((latin . "Noto Sans") + (han . "Noto Sans CJK SC Regular") + (kana . "Noto Sans CJK JP Regular") + (hangul . "Noto Sans CJK KR Regular") + (cjk-misc . "Noto Sans CJK KR Regular") + (khmer . "Noto Sans Khmer") + (lao . "Noto Sans Lao") + (burmese . "Noto Sans Myanmar") + (thai . "Noto Sans Thai") + (ethiopic . "Noto Sans Ethiopic") + (hebrew . "Noto Sans Hebrew") + (arabic . "Noto Sans Arabic") + (gujarati . "Noto Sans Gujarati") + (devanagari . "Noto Sans Devanagari") + (kannada . "Noto Sans Kannada") + (malayalam . "Noto Sans Malayalam") + (oriya . "Noto Sans Oriya") + (sinhala . "Noto Sans Sinhala") + (tamil . "Noto Sans Tamil") + (telugu . "Noto Sans Telugu") + (tibetan . "Noto Sans Tibetan") + ;; emojis + (symbol . "Noto Emoji") + ;; (symbol . "Noto Color Emoji") + (symbol . "Segoe UI Emoji") + (symbol . "Apple Color Emoji") + (symbol . "FreeSans") + (symbol . "FreeMono") + (symbol . "FreeSerif") + (symbol . "Unifont") + (symbol . "Symbola")) + if (member font ffl) + do (set-fontset-font t charset font))) (defun sort-sexps (beg end) "Sort sexps in region. @@ -357,34 +368,10 @@ Comments stay with the code below." (insert-before-markers real) (delete-region (point) (marker-position end))))))))) -(defun ^turn-off (mode) - "Higher-order function: returns a lambda to turn off MODE." - (lambda () - (funcall mode -1))) - -(defun ^local-hook (hook fn) - "Hook FN to HOOK locally in a lambda. -Good for adding to an add-hook." - (lambda () (add-hook hook fn t))) - -(defun ^local-unhook (hook fn) - "Remove FN from HOOK locally." - (lambda () (remove-hook hook fn t))) - -;; This needs to be a macro to take advantage of setf magic -(defmacro setf/alist (alist key val &optional testfn) - `(setf (alist-get ,key ,alist nil nil (or ,testfn #'equal)) - ,val)) - -(defun unfill-region (beg end) - (interactive "*r") - (let ((fill-column most-positive-fixnum)) - (fill-region beg end))) - -(defun unfill-paragraph () +(defun switch-to-other-buffer () + "Switch to the `other-buffer'." (interactive) - (let ((fill-column most-positive-fixnum)) - (fill-paragraph beg end))) + (switch-to-buffer nil)) (defun unfill-buffer () (interactive) @@ -396,25 +383,51 @@ Good for adding to an add-hook." (unfill-buffer) (visual-line-mode t))) -(defmacro after (event &rest body) - "Do BODY after EVENT, which can be: -- A feature -- A hook -- if it requires arguments they'll be in the list `args' -- The symbol 'init, which runs on after-init-hook" - (declare (indent 1)) - (let ((lambda-form `(lambda (&rest args) ,@body))) - (pcase event - (`(timer ,ev) `(run-with-timer ,ev nil ,lambda-form)) - (`(idle ,ev) `(run-with-idle-timer ,ev nil ,lambda-form)) - (`(hook ,ev) `(add-hook ',ev ,lambda-form)) - (`init `(after (hook after-init-hook) ,@body)) - ((pred numberp) `(after (timer ,event) ,@body)) - ((pred (lambda (ev) - (and (symbolp ev) - (or (string-suffix-p "-hook" (symbol-name ev)) - (string-suffix-p "-function" (symbol-name ev)) - (string-suffix-p "-functions" (symbol-name ev)))))) - `(after (hook ,event) ,@body)) - ((pred symbolp) `(with-eval-after-load ',event ,@body)) +(defun unfill-paragraph () + (interactive) + (let ((fill-column most-positive-fixnum)) + (fill-paragraph beg end))) - (_ (error "Can't determine event type" event))))) +(defun unfill-region (beg end) + (interactive "*r") + (let ((fill-column most-positive-fixnum)) + (fill-region beg end))) + +(defun vc-jump (arg) + "Jump to the current project's VC buffer. +With ARG, prompt for the directory." + (interactive "P") + (if arg + (let ((current-prefix-arg nil)) + (call-interactively #'vc-dir)) + (project-vc-dir))) + +(progn (defvar *fonts* + (let ((fixed "Recursive Mono Casual Static") + (variable "Recursive Sans Linear Static")) + `((default + :family ,variable + :height 100) + (variable-pitch :family ,variable) + (fixed-pitch :family ,fixed) + (fixed-pitch-serif :family ,fixed) + (font-lock-string-face :family "Recursive Mono Linear Static")))) + ;; (setup-faces) + ) + +(setopt default-frame-alist + '((menu-bar-lines . 0) + (tool-bar-lines . 0) + ;;(vertical-scroll-bars) + (horizontal-scroll-bars))) + +(setopt frame-inhibit-implied-resize t) +(setopt frame-resize-pixelwise t) +(setopt window-resize-pixelwise t) + +(when (getenv "IN_EXWM") + (add-to-list 'default-frame-alist '(fullscreen . fullboth))) + +(when (require 'package) + (add-to-list 'package-archives '("melpa" . "https://melpa.org/packages/")) + (package-initialize)) diff --git a/exwm b/exwm index 08d410f..55f33fb 100644 --- a/exwm +++ b/exwm @@ -109,6 +109,9 @@ BUFFER-NAME defaults to the first word of COMMAND." ;;; Window management +(after exwm-mode-hook + (setq-local mode-line-format nil)) + (after exwm-update-class-hook (exwm-workspace-rename-buffer exwm-class-name)) -- cgit 1.4.1-21-gabe81