Moving things one level deeper

To ease gnu stow usage. Now we can do

stow -t ~ emacs

1 files changed, 263 insertions, 0 deletions

diff --git a/emacs/.emacs.d/lisp/my/my-package.el b/emacs/.emacs.d/lisp/my/my-package.el
new file mode 100644
index 0000000..1f35a5e
--- /dev/null
+++ b/emacs/.emacs.d/lisp/my/my-package.el
@@ -0,0 +1,263 @@
+;;; my-package.el -- Package related extensions for emacs core -*- lexical-binding: t -*-
+
+;; Copyright (C) 2023 Free Software Foundation.
+
+;; Author: Yuchen Pei <id@ypei.org>
+;;         Protesilaos Stavrou <info@protesilaos.com>
+;; Maintainer: Yuchen Pei <id@ypei.org>
+;; Package-Requires: ((emacs "28.2"))
+
+;; This file is part of dotfiles.
+
+;; dotfiles is free software: you can redistribute it and/or modify it under
+;; the terms of the GNU Affero General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; dotfiles 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 Affero General
+;; Public License for more details.
+
+;; You should have received a copy of the GNU Affero General Public
+;; License along with dotfiles.  If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Package related extensions for emacs core.
+
+;;; Code:
+
+
+;;; Needed by `my-keybind' for barebone profiles like "emms".
+(require 'cl-lib)
+;;; Much of the following is adapted from prot-dotfiles
+(defcustom my-omit-packages nil
+  "List of package names to not load.
+This instructs the relevant macros to not `require' the given
+package."
+  :group 'my
+  :type '(repeat symbol))
+
+(defcustom my-allowed-packages nil
+  "List of package names to load.
+This instructs the relevant macros to not `require' packages not
+in this list. Nil means all packages can be required."
+  :group 'my
+  :type '(repeat symbol))
+
+(defun my-package-install (package &optional method)
+  "Install PACKAGE with optional METHOD.
+
+If METHOD is nil or the `builtin' symbol, PACKAGE is not
+installed as it is considered part of Emacs.
+
+If METHOD is any non-nil value, install PACKAGE using
+`package-install'."
+  (unless (or (eq method 'builtin) (null method))
+    (unless (package-installed-p package)
+      (unless package-archive-contents
+        (package-refresh-contents))
+      (package-install package))))
+
+(defmacro my-package (package &rest body)
+  "Require PACKAGE with BODY configurations.
+
+PACKAGE is an unquoted symbol that is passed to `require'.  It
+thus conforms with `featurep'.
+
+BODY consists of ordinary Lisp expressions.  There are,
+nevertheless, two unquoted plists that are treated specially:
+
+1. (:install METHOD)
+2. (:delay NUMBER)
+
+These plists can be anywhere in BODY and are not part of its
+final expansion.
+
+The :install property is the argument passed to
+`my-package-install' and has the meaning of METHOD
+described therein.
+
+The :delay property makes the evaluation of PACKAGE with the
+expanded BODY happen with `run-with-timer'.
+
+Also see `my-configure'."
+  (declare (indent 1))
+  (when (or (not my-allowed-packages)
+            (memq package my-allowed-packages))
+    (unless (memq package my-omit-packages)
+      (let (install delay)
+        (dolist (element body)
+          (when (let ((len (proper-list-p element)))
+                  (and len (zerop (% len 2))))
+            (pcase (car element)
+              (:install (setq install (cdr element)
+                              body (delq element body)))
+              (:delay (setq delay (cadr element)
+                            body (delq element body))))))
+        (let ((common `(,(when install
+                           `(my-package-install ',package ,@install))
+                        (require ',package)
+                        ,@body
+                        )))
+          (cond
+           ((featurep package)
+            `(progn ,@body))
+           (delay
+            `(run-with-timer ,delay nil (lambda () ,@(delq nil common))))
+           (t
+            `(progn ,@(delq nil common)))))))))
+
+(defmacro my-keybind (keymap &rest definitions)
+  "Expand key binding DEFINITIONS for the given KEYMAP.
+DEFINITIONS is a sequence of string and command pairs."
+  (declare (indent 1))
+  (unless (zerop (% (length definitions) 2))
+    (error "Uneven number of key+command pairs"))
+  (let ((keys (seq-filter #'stringp definitions))
+        ;; We do accept nil as a definition: it unsets the given key.
+        (commands (seq-remove #'stringp definitions)))
+    `(when-let (((keymapp ,keymap))
+                (map ,keymap))
+       ,@(mapcar
+          (lambda (pair)
+            (unless (and (null (car pair))
+                         (null (cdr pair)))
+              `(define-key map (kbd ,(car pair)) ,(cdr pair))))
+          (cl-mapcar #'cons keys commands)))))
+
+(defmacro my-configure (&rest body)
+  "Evaluate BODY as a `progn'.
+BODY consists of ordinary Lisp expressions.  The sole exception
+is an unquoted plist of the form (:delay NUMBER) which evaluates
+BODY with NUMBER seconds of `run-with-timer'.
+
+Note that `my-configure' does not try to autoload
+anything.  Use it only for forms that evaluate regardless.
+
+Also see `my-package'."
+  (declare (indent 0))
+  (let (delay)
+    (dolist (element body)
+      (when (let ((len (proper-list-p element)))
+              (and len (zerop (% len 2))))
+        (pcase (car element)
+          (:delay (setq delay (cadr element)
+                        body (delq element body))))))
+    (if delay
+        `(run-with-timer ,delay nil (lambda () ,@body))
+      `(progn ,@body))))
+
+(defvar my-local-config-file
+  (locate-user-emacs-file "local-config")
+  "Local emacs-lisp-data config file for machine-specific and personal
+  information. The content of the file should be an alist of (var-name
+  . var-value)")
+
+(defun my-read-local-config ()
+  "Read local-config.
+
+Read from `my-local-config-file' into `local-config'."
+  (interactive)
+  (setq my-local-config
+        (with-temp-buffer
+          (insert-file-contents my-local-config-file)
+          (read (current-buffer)))))
+
+(defmacro my-setq-from-local (&rest var-names)
+  "Set variables with values from `local-config'.
+
+Does not set variables that do not appear in `local-config'.
+Note that symbols or list values in `local-config' need to be
+quoted."
+  (cons 'setq
+        (mapcan
+         (lambda (var-name)
+           (when-let ((pair (assoc `,var-name my-local-config)))
+             `(,(car pair) ',(cdr pair))))
+         var-names)))
+
+(defmacro my-setq-from-local-1 (&rest var-names)
+  "Update the local config before calling `my-setq-from-local'"
+  `(progn (my-read-local-config)
+          (my-setq-from-local ,@var-names)))
+
+(defmacro my-get-from-local (var-name)
+  "Get the value of a variable from `local-config'"
+  `(alist-get ',var-name my-local-config))
+
+(defmacro my-get-from-local-1 (var-name)
+  "Update the local config before calling `my-get-from-local'"
+  `(progn (my-read-local-config)
+          (my-get-from-local ,var-name)))
+
+(defmacro my-override (func-name)
+  "Override a function named foo with a function named my-foo"
+  `(advice-add ',func-name :override #',(intern (format "my-%s" func-name))))
+
+(defmacro my-server-idle-timer (var-name secs repeat function)
+  "Create an idle timer if we are in an emacsclient.
+
+The timer has name VAR-NAME. If there is an existing time with the
+same name, cancel that one first."
+
+  `(when (my-server-p)
+     (when (and (boundp ',var-name) (timerp ,var-name))
+       (cancel-timer ,var-name))
+     (setq ,var-name (run-with-idle-timer ,secs ,repeat ,function))))
+
+(defmacro my-server-timer (var-name secs repeat function)
+  "Create a timer if we are in an emacsclient.
+
+The timer has name VAR-NAME. If there is an existing time with the
+same name, cancel that one first."
+
+  `(when (my-server-p)
+     (when (and (boundp ',var-name) (timerp ,var-name))
+       (cancel-timer ,var-name))
+     (setq ,var-name (run-with-timer ,secs ,repeat ,function))))
+
+(defun my-describe-package-from-url (url)
+  (interactive "sUrl: ")
+  (when (string-match
+         "\\b\\(?:elpa.gnu.org/packages/\\|elpa.gnu.org/devel/\\|elpa.nongnu.org/nongnu/\\)\\(.*\\).html"
+         url)
+    (describe-package (intern (match-string 1 url)))))
+
+(defun my-generate-local-config ()
+  "Generate a local config and insert it to a buffer named *local-config*"
+  (with-current-buffer (get-buffer-create "*local-config*")
+    (erase-buffer)
+    (insert
+     (pp
+      (seq-map
+       (lambda (var)
+         (cons var (when (boundp var) (symbol-value var))))
+       (seq-uniq
+        (my-collect-my-setqd-vars
+         (with-temp-buffer
+           (insert "(progn ")
+           (dolist (el (directory-files "~/.emacs.d/init" t
+                                        directory-files-no-dot-files-regexp))
+             (insert-file-contents el)
+             (goto-char (point-max)))
+           (insert ")")
+           (goto-char (point-min))
+           (read (current-buffer))
+           )))))))
+  (pop-to-buffer "*local-config*")
+  )
+
+(defun my-collect-my-setqd-vars (xs)
+  "Collect vars that have been `my-setq-from-local''d"
+  (cond
+   ((not (listp xs)) nil)
+   ((not xs) nil)
+   ((eq (car xs) 'my-setq-from-local)
+    (cdr xs))
+   (t (append (my-collect-my-setqd-vars (car xs))
+              (my-collect-my-setqd-vars (cdr xs))))))
+
+(provide 'my-package)
+;;; my-package.el ends here