From 59a1f58695d09ab29ddf992b2c0711c94a4039ea Mon Sep 17 00:00:00 2001 From: Case Duckworth Date: Tue, 3 Jan 2023 23:03:03 -0600 Subject: Switch to use-package --- lisp/acdw.el | 345 +++++++++++++---------------------------------------------- 1 file changed, 76 insertions(+), 269 deletions(-) (limited to 'lisp/acdw.el') diff --git a/lisp/acdw.el b/lisp/acdw.el index a9ef893..30c4f44 100644 --- a/lisp/acdw.el +++ b/lisp/acdw.el @@ -1,272 +1,79 @@ -;;; acdw.el -- bits and bobs -*- lexical-binding: t; -*- -;; by C. Duckworth -(require 'cl-lib) -;; def.el is here -(require 'def) - -;;; Define both a directory and a function expanding to a file in that directory - -(defmacro +define-dir (name directory &optional docstring inhibit-mkdir) - "Define a variable and function NAME expanding to DIRECTORY. -DOCSTRING is applied to the variable. Ensure DIRECTORY exists in -the filesystem, unless INHIBIT-MKDIR is non-nil." - (declare (indent 2) - (doc-string 3)) - (unless inhibit-mkdir - (make-directory (eval directory) :parents)) - `(progn - (defvar ,name ,directory - ,(concat docstring (when docstring "\n") - "Defined by `/define-dir'.")) - (defun ,name (file &optional mkdir) - ,(concat "Expand FILE relative to variable `" (symbol-name name) "'.\n" - "If MKDIR is non-nil, the directory is created.\n" - "Defined by `/define-dir'.") - (let ((file-name (expand-file-name (convert-standard-filename file) - ,name))) - (when mkdir - (make-directory (file-name-directory file-name) :parents)) - file-name)))) - -;;; Evaluating things after other things - -(defun eval-after-init (fn) - "Evaluate FN after inititation, or now if Emacs is initialized. -FN is called with no arguments." - (if after-init-time - (funcall fn) - (add-hook 'after-init-hook fn))) - -(defmacro eval-after (features &rest body) - "Evaluate BODY, but only after loading FEATURES. -FEATURES can be an atom or a list; as an atom it works like -`with-eval-after-load'. The special feature `init' will evaluate -BODY after Emacs is finished initializing." - (declare (indent 1) - (debug (form def-body))) - (unless (listp features) - (setf features (list features))) - (if (null features) - (macroexp-progn body) - (let* ((this (car features)) - (rest (cdr features))) - (cond ((eq this 'init) - `(eval-after-init - (lambda () (eval-after ,rest ,@body)))) - (:else - `(with-eval-after-load ',this - (eval-after ,rest ,@body))))))) - -;;; Convenience functions - -(defun define-key* (maps &rest keydefs) - "Define KEYDEFS in MAPS. -Convenience wrapper around `define-key'." - (unless (zerop (mod (length keydefs) 2)) - (user-error "Wrong number of arguments: %S" (length keydefs))) - (dolist (map (if (or (atom maps) (eq (car maps) 'keymap)) - (list maps) - maps)) - (cl-loop for (key def) on keydefs by #'cddr - do (let ((key (if (stringp key) (kbd key) key))) - (define-key (if (symbolp map) - (symbol-value map) - map) - key def))))) - -(unless (fboundp 'ensure-list) - ;; Just in case we're using an old version of Emacs. - (defun ensure-list (object) - "Return OBJECT as a list. -If OBJECT is already a list, return OBJECT itself. If it's -not a list, return a one-element list containing OBJECT." - (if (listp object) - object - (list object)))) - -(defun add-to-list* (lists &rest things) - "Add THINGS to LISTS. -LISTS can be one list variable or a list. Each thing of THINGS -can be either a variable (the thing), or a list of the form -(ELEMENT &optional APPEND COMPARE-FN), which is passed to -`add-to-list'." - (declare (indent 1)) - (dolist (l (ensure-list lists)) - (dolist (thing things) - (apply #'add-to-list l (ensure-list thing))))) - -(defun add-hook* (hooks &rest functions) - "Add FUNCTIONS to HOOKS. -Each function in FUNCTIONS can be a singleton or a list of the -form (FUNCTION &optional DEPTH LOCAL)." - (declare (indent 1)) - (dolist (hook (ensure-list hooks)) - (dolist (fn functions) - (apply #'add-hook hook (ensure-list fn))))) - -(defun +concat (&rest strings) - "Concat STRINGS separated by SEPARATOR. -SEPARATOR is \"\\n\" unless the keyword argument `:separator' is -given, followed by the separator to use. Each item in STRINGS is -either a string or a list or strings, which is concatenated -without any separator." - (let (ret - ;; I don't know why a `cl-defun' with - ;; (&rest strings &key (separator "\n")) doesn't work - (separator (or (cl-loop for i from 0 upto (length strings) - if (eq (nth i strings) :separator) - return (nth (1+ i) strings)) - "\n"))) - (while strings - (let ((string (pop strings))) - (cond ((eq string :separator) (pop strings)) - ((listp string) (push (apply #'concat string) ret)) - ((stringp string) (push string ret))))) - (mapconcat #'identity (nreverse ret) separator))) - -(defun require* (&rest features) - "Require FEATURES in order. -Each feature of FEATURES can also be a list of the arguments to -pass to `require', which see." - (condition-case e - (dolist (feature features) - (apply #'require (ensure-list feature))) - (:success (mapcar (lambda (f) (car (ensure-list f))) features)) - (t (signal (car e) (cdr e))))) - -;;; Convenience macros - -(defmacro define-local-before-save-hook (mode-or-hook &rest body) - "Add a local `before-save-hook' to MODE-OR-HOOK." - (declare (indent 1)) - (let* ((name (format "%s" mode-or-hook)) - (external-name (intern (format "%s@before-save" name))) - (internal-name (intern (format "before-save@%s" name))) - (hook (if (string-suffix-p "-hook" name) - mode-or-hook - (intern (format "%s-hook" name))))) - `(progn - (defun ,internal-name () - ,@body) - (defun ,external-name () - (add-hook 'before-save-hook #',internal-name nil :local)) - (add-hook ',hook #',external-name)))) - -(defmacro setq-local-hook (hooks &rest args) - "Run `setq-local' on ARGS when running HOOKs." - ;; FIXME: this is pretty messy, i think... - ;; The settings should be stored in an alist so that they can be deduplicated - (declare (indent 1)) - `(progn - ,@(cl-loop for hook in (ensure-list hooks) - collect - (let ((fn (intern (format "%s-setq-local" hook)))) - (when (and (fboundp fn) - (functionp fn)) - (setf args (append (function-get fn 'setq-local-hook-settings) args))) - (unless (and (< 0 (length args)) - (zerop (mod (length args) 2))) - (user-error "Wrong number of arguments: %S" (length args))) - `(progn - (defun ,fn () - ,(format "Set local variables after `%s'." hook) - (setq-local ,@args)) - (function-put ',fn 'setq-local-hook-settings ',args) - (dolist (buf (buffer-list)) - (with-current-buffer buf - (when (derived-mode-p - ',(intern (replace-regexp-in-string - "-hook" "" (format "%s" hook)))) - (,fn)))) - (add-hook ',hook #',fn)))))) - -(defmacro with-message (message &rest body) - "Execute BODY, with MESSAGE. -If body executes without errors, MESSAGE...Done will be displayed." - (declare (indent 1)) - (let ((msg (gensym))) - `(let ((,msg ,message)) - (condition-case e - (progn (message "%s..." ,msg) - ,@body) - (:success (message "%s...done" ,msg)) - (t (signal (car e) (cdr e))))))) - -(defmacro either (&rest clauses) - "Return the first of CLAUSES that returns non-nil." - (let* ((this (gensym "either"))) - (unless (null clauses) - `(let* ((,this ,(car clauses))) - (if ,this ,this (either ,@(cdr clauses))))))) - -(defun mapc-buffers (fn &optional pred) - "Perform FN on buffers matching PRED. -If PRED is nil or absent, perform FN on all buffers. Both FN and -PRED are called within a `with-current-buffer' form and without -arguments." - (let ((pred (cond - ((listp pred) - (lambda () (apply #'derived-mode-p pred))) - ((functionp pred) pred) - ((null pred) (lambda () t)) - (:else (user-error "Bad predicate"))))) - (dolist (buf (buffer-list)) - (with-current-buffer buf - (when (funcall pred) - (funcall fn)))))) - -;; https://emacs.stackexchange.com/a/39324/37239 -;; XXX: This shit don't work rn -(defun ignore-invisible-overlays (fn) - "Execute FN, ignoring invisible overlays. -FN should return a point." - (let ((overlay nil) - (point nil)) - (setq point (and (funcall fn) (point))) - (setq overlay (car (overlays-at (point)))) - (while (and overlay (member 'invisible (overlay-properties overlay))) - (goto-char (overlay-end overlay)) - (setq point (and (funcall fn) (point))) - (setq overlay (car (overlays-at (point))))) - point)) - -;;; Extras -;; Trying to avoid a whole install of crux ... - -(defun kill-and-join-forward (&optional arg) - "Kill the line or, if at the end of a line, join with the next. -This command is `visual-line-mode'-aware. If ARG is provided, -it's passed on to kill a line, but not to delete indentation. -When joining, this command deletes whitespace." - (interactive "P") - (if (and (eolp) (not (bolp))) - (delete-indentation 1) - (funcall (if visual-line-mode #'kill-visual-line #'kill-line) arg))) - -(defun other-window|switch-buffer (arg) - "Call `other-window' or `switch-buffer' depending on windows. -When called with prefix ARG, unconditionally switch buffer." - (interactive "P") - (if (or arg (one-window-p)) - (switch-to-buffer (other-buffer) nil t) - (other-window 1))) - -;;; Set variables more better-er -;; Now this doesn't do `setf'-style stuff. - -(defmacro setc (&rest args) - "Customize user options using ARGS like `setq'." - (declare (debug setq)) - (unless (zerop (mod (length args) 2)) - (user-error "Dangling argument: %S" var)) - (let (form) - (while args - (push `(customize-set-variable - ',(pop args) - ,(pop args) - "Set by `setc'.") - form)) - `(progn ,@(nreverse form)))) +;;; acdw.el --- Basic emacs shit for acdw -*- lexical-binding: t -*- + +;;; Code: + +(require 'acdw-funs) ; Extra functions +(require 'acdw-macs) ; Extra macros + +(defdir etc/ (locate-user-emacs-file "etc") + "Directory for package configuration files. +See `no-littering' for examples.") + +(defdir var/ etc/ + "Directory for package data file. +See `no-littering' for examples.") + +(defdir cache/ (if-let ((xdg-cache (getenv "XDG_CACHE_HOME"))) + (expand-file-name "emacs/" xdg-cache) + etc/) + "Directory for cache files.") + +(setq native-compile-target-directory (cache/ "eln" t)) +(when (fboundp 'startup-redirect-eln-cache) + (startup-redirect-eln-cache (cache/ "eln" t))) + +(defdir sync/ (expand-file-name "/home/case/Sync") + "My Syncthing directory.") + +(defdir private/ (sync/ "emacs/private")) +(add-to-list 'load-path private/) + +(require 'acdw-defaults) ; Sane defaults +(require '_acdw) ; Private stuff +(require '+lisp) ; Lispy goodness + +(setc enable-recursive-minibuffers t + completions-detailed t + completion-ignore-case t + read-buffer-completion-ignore-case t + read-file-name-completion-ignore-case t + initial-buffer-choice #'+initial-buffer + initial-scratch-message + (format "%s\n\n" + (comment-lines + (shell-command-to-string "fortune") + ";; ")) + sentence-end-double-space nil + save-silently t) + +(defkeys t + "M-o" #'other-window|switch-buffer + "C-x 0" #'delete-window|bury-buffer + "C-M-;" #'+lisp-comment-or-uncomment-sexp + "M-SPC" #'+cycle-spacing + "C-x C-k" #'kill-this-buffer) + +(defkeys t + "M-u" #'universal-argument) + +(defkeys universal-argument-map + "M-u" #'universal-argument-more) + +(define-advice switch-to-buffer (:after (&rest _) normal-mode) + "Automatically determine the mode for created non-file buffers." + (when-let ((_ (and (eq major-mode 'fundamental-mode))) + (buffer-file-name (buffer-name))) + (normal-mode))) + +(define-advice canonically-space-region + (:around (orig &rest args) double-space-sentences) + (let ((sentence-end-double-space t)) + (apply orig args))) + +(with-region-or-buffer indent-region) + +(winner-mode) (provide 'acdw) + ;;; acdw.el ends here -- cgit 1.4.1-21-gabe81