:;;; acdw.el -*- lexical-binding: t; coding: utf-8-unix -*-
;; Author: Case Duckworth <acdw@acdw.net>
;; Created: Sometime during Covid-19, 2020
;; Keywords: configuration
;; URL: https://tildegit.org/acdw/emacs

;; This file is NOT part of GNU Emacs.

;;; License:
;; Everyone is permitted to do whatever with this software, without
;; limitation.  This software comes without any warranty whatsoever,
;; but with two pieces of advice:
;; - Don't hurt yourself.
;; - Make good choices.

;;; Commentary:
;; `acdw.el' contains `acdw/map', its mode, and assorted ease-of-life
;; functions for me, acdw.

;;; Code:

;;; Utilities

(defconst acdw/system (pcase system-type
                        ('gnu/linux :home)
                        ((or 'msdos 'windows-nt) :work)
                        (_ :other))
  "Which system is currently being used.")

(defun acdw/when-unfocused (func &rest args)
  "Call FUNC, with ARGS, iff all Emacs frames are out of focus.

Ready for use with `after-focus-change-function'."
  (when (seq-every-p #'null (mapcar #'frame-focus-state (frame-list)))
    (apply func args)))

(defun acdw/sunrise-sunset (sunrise-command sunset-command)
  "Run commands at sunrise and sunset."
  (let* ((times-regex (rx (* nonl)
                          (: (any ?s ?S) "unrise") " "
                          (group (repeat 1 2 digit) ":"
                                 (repeat 1 2 digit)
                                 (: (any ?a ?A ?p ?P) (any ?m ?M)))
                          (* nonl)
                          (: (any ?s ?S) "unset") " "
                          (group (repeat 1 2 digit) ":"
                                 (repeat 1 2 digit)
                                 (: (any ?a ?A ?p ?P) (any ?m ?M)))
                          (* nonl)))
         (ss (sunrise-sunset))
         (_m (string-match times-regex ss))
         (sunrise-time (match-string 1 ss))
         (sunset-time (match-string 2 ss)))
    (run-at-time sunrise-time (* 60 60 24) sunrise-command)
    (run-at-time sunset-time (* 60 60 24) sunset-command)
    (run-at-time "12:00am" (* 60 60 24) sunset-command)))

;;; Garbage collection hacks

(defconst acdw/gc-cons-threshold-basis (* 800 1024 1024)
  "Basis value for `gc-cons-threshold' to return to after jumping.
800 KB is Emacs's default.")

(defconst acdw/gc-cons-percentage-basis 0.1
  "Basis value for `gc-cons-percentage' to return to after jumping.
0.1 is Emacs's default.")

(defun acdw/gc-disable ()
  "Disable garbage collection by setting relevant variables to their maxima."
  (setq gc-cons-threshold most-positive-fixnum
        gc-cons-percentage 0.8))

(defun acdw/gc-enable ()
  "Re-enable garbage collection by setting relevant variables back to bases."
  (setq gc-cons-threshold acdw/gc-cons-threshold-basis
        gc-cons-percentage acdw/gc-cons-percentage-basis))

;;; Directories (think `no-littering')

(defvar acdw/dir (expand-file-name
                  (convert-standard-filename "var/")
                  user-emacs-directory)
  "A directory to hold extra configuration and emacs data.")

(defun acdw/in-dir (file &optional make-directory)
  "Expand FILE relative to `acdw/dir', optionally creating its
directory."
  (let ((f (expand-file-name (convert-standard-filename file)
                             acdw/dir)))
    (when make-directory
      (make-directory (file-name-directory f) 'parents))
    f))

;;; Settings

;; (defun acdw/set (assignments)
;;   "Perform `customize-set-variable' on each of ASSIGNMENTS.

;; ASSIGNMENTS is a list where each element is of the form
;; (VARIABLE VALUE [COMMENT])."
;;   (let (setting)			; for return value
;;     (dolist (assignment assignments setting)
;;       (customize-set-variable (car assignment)
;;                   (cadr assignment)
;;                   (if (and (caddr assignment)
;;                        (stringp (caddr assignment)))
;;                   (caddr assignment)
;;                 "Customized by `acdw/set'."))
;;       (setq setting (car assignment)))))

;;; Faces

;; (defun acdw/set-face (face spec)
;;   "Customize FACE according to SPEC, and register it with `customize'.
;; SPEC is as for `defface'."
;;   (put face 'customized-face spec)
;;   (face-spec-set face spec))

;; (defmacro acdw/set-faces (face-specs)
;;   "Run `acdw/set-face' over each face in FACE-SPECS."
;;   (let (face-list)
;;     (dolist (face face-specs)
;;       (push `(acdw/set-face ',(car face) ',(cdr face)) face-list))
;;     `(progn
;;        ,@face-list)))

;;; Hooks
;; (defmacro acdw/hooks (hook-specs &rest args)
;;   "Add functions to hooks, according to HOOK-SPECS.

;; Each HOOK-SPEC is of the following format: (HOOKS FUNCS [DEPTH] [LOCAL]).
;; Either HOOKS or FUNCS can also be a list, in which case `add-hook' is called
;; over the Cartesian product of HOOKS and FUNCS.  In each HOOK-SPEC, DEPTH and
;; LOCAL apply to all hooks defined; if finer control is needed, either pass the
;; same hooks and functions in different HOOK-SPECs, or just use `add-hook'.

;; ARGS accept the following keywords:

;; :after FEATURE .. `autoload' all functions after FEATURE."
;;   (let ((after (plist-get args :after))
;;     (command-list))
;;     (dolist (spec hook-specs)
;;       (let* ((hooks (car spec))
;;          (funcs (cadr spec))
;;          (depth (or (caddr spec) 0))
;;          (local (cadddr spec)))
;;     (when (not (listp hooks)) (setq hooks (list hooks)))
;;     (when (not (listp funcs)) (setq funcs (list funcs)))
;;     (dolist (hook hooks)
;;       (dolist (func funcs)
;;         (push `(add-hook ',hook #',func ,depth ,local) command-list)
;;         (when after
;;           (push `(autoload #',func ,after) command-list))))))
;;     `(progn
;;        ,@command-list)))

;;; Keybindings

;; (defvar acdw/bind-default-map 'acdw/map
;;   "The default keymap to use with `acdw/bind'.")

;; (defmacro acdw/bind (key command &rest args)
;;   "A simple key-binding macro to take care of the repetitive stuff
;; automatically.

;; If KEY is a vector, it's passed directly to `define-key',
;; otherwise it's wrapped in `kbd'.

;; The following keywords are recognized:

;; :after ARGS .. call `autoload' on COMMAND using ARGS before
;;     binding the key.  ARGS can be just the filename to
;;     load; in that case it's wrapped in a list.  

;; :map KEYMAP .. define KEY in KEYMAP instead of the
;;    default `acdw/bind-default-map'.  If `:after' is also supplied,
;;    run `autoload' on KEYMAP (except when using `:map-after', see).

;; :map-after FILE .. run the underlying `define-key' command in an
;;   `with-eval-after-load'.  For the rare occasion when the keymap is
;;   defined in a different file than the command it binds (looking
;;   at you, `org-mode')."
;;   (let ((after (when-let (sym (plist-get args :after))
;;                  (if (not (listp sym))
;;                      (list sym)
;;                    sym)))
;;         (map-after (plist-get args :map-after))
;;         (keymap (or (plist-get args :map) acdw/bind-default-map))
;;         (keycode (if (vectorp key) key (kbd key)))
;;         (command-list))
;;     (let ((define-key-command `(define-key ,keymap ,keycode ',command)))
;;       (if map-after
;;           (push `(with-eval-after-load ,map-after
;;                    ,define-key-command)
;;                 command-list)
;;         (push define-key-command command-list)))
;;     (when after
;;       (unless (fboundp command)
;;         (push `(autoload ',command ,@after) command-list))
;;       (unless (or map-after
;;                   (eq keymap acdw/bind-default-map))
;;         (push `(autoload ',keymap ,(car after) nil nil 'keymap) command-list)))
;;     `(progn
;;        ,@command-list)))

;; (defmacro acdw/binds (bindings)
;;   "Bind multiple keys at once."
;;   (let (bind-list)
;;     (dolist (bind bindings)
;;       (push `(acdw/bind ,@bind) bind-list))
;;     `(progn
;;        ,@bind-list)))

;; convenience
;; (defmacro acdw/bind-after-map (file keymap bindings)
;;   "Wrap multiple calls of `acdw/bind' after FILE and with KEYMAP.
;; KEYMAP can be nil."
;;   (declare (indent 2))
;;   (let ((bind-list)
;;     (extra-args (if keymap
;;             `(:after ,file :map ,keymap)
;;               `(:after ,file))))
;;     (dolist (binding bindings)
;;       (push `(acdw/bind ,@binding ,@extra-args) bind-list))
;;     `(progn
;;        ,@bind-list)))

;;; Packages

;; (defmacro acdw/pkg (package &rest args)
;;   "Set up a package using `straight.el'.

;; ARGS can include the following keywords:

;; :local BOOL   .. if BOOL is non-nil, don't run `straight-use-package' on
;;          PACKAGE.  Good for using `acdw/pkg' on local features.
;; :require BOOL .. if BOOL is non-nil, run `require' on PACKAGE before anything.
;; :now FORMS    .. run FORMS immediately.
;; :then FORMS   .. run FORMS after loading PACKAGE, using `with-eval-after-load'.
;; :set SETTINGS .. pass SETTINGS to `acdw/set', right after `:now' forms.
;;          SETTINGS should be properly quoted, just like they'd be passed
;;          to the function.
;; :binds BINDS  .. run `acdw/bind-after-map' on BINDS.
;; :hooks HOOKS  .. run `acdw/hooks' on HOOKS."
;;   (declare (indent 1))
;;   (let ((local-pkg (plist-get args :local))
;;     (require-pkg (plist-get args :require))
;;     (now-forms (plist-get args :now))
;;     (settings (plist-get args :set))
;;     (binds (plist-get args :binds))
;;     (hooks (plist-get args :hooks))
;;     (then-forms (plist-get args :then))
;;     (requirement (if (listp package)
;;              (car package)
;;                package))
;;     (final-form))
;;     (when then-forms
;;       (push `(with-eval-after-load ',requirement ,@then-forms) final-form))
;;     (when hooks
;;       (push `(acdw/hooks ,hooks :after ,(symbol-name requirement)) final-form))
;;     (when binds
;;       (push `(acdw/bind-after-map ,(symbol-name requirement) nil ,binds)
;;         final-form))
;;     (when settings
;;       (push `(acdw/set ,settings) final-form))
;;     (when now-forms
;;       (push `(progn ,@now-forms) final-form))
;;     (unless local-pkg
;;       (push `(straight-use-package ',package) final-form))
;;     (when require-pkg
;;       (push `(require ',requirement) final-form))
;;     `(progn
;;        ,@final-form)))

;;; Reading mode

(define-minor-mode acdw/reading-mode
    "A mode for reading."
  :init-value t
  :lighter " Read"
  (if acdw/reading-mode
      (progn ;; turn on
        (display-fill-column-indicator-mode -1)
        (dolist (mode '(visual-fill-column-mode
                        iscroll-mode))
          (when (fboundp mode)
            (funcall mode +1))))
    ;; turn off
    (display-fill-column-indicator-mode +1)
    (dolist (mode '(visual-fill-column-mode
                    iscroll-mode))
      (when (fboundp mode)
        (funcall mode -1)))))

;;; Keymap & Mode

(defvar acdw/map (make-sparse-keymap)
  "A keymap for my custom bindings.")

(define-minor-mode acdw/mode
    "A mode for `acdw/map'."
  :init-value t
  :lighter " acdw"
  :keymap acdw/map)
(define-globalized-minor-mode acdw/global-mode acdw/mode acdw/mode)

;; Disable `acdw/mode' in the minibuffer
(defun acdw/mode--disable ()
  "Disable `acdw/mode'."
  (acdw/mode -1))
(add-hook 'minibuffer-setup-hook #'acdw/mode--disable)

;; Set up a leader key for `acdw/mode'
(defvar acdw/leader
  (let ((map (make-sparse-keymap))
        (c-z (global-key-binding "\C-z")))
    (define-key acdw/map "\C-z" map)
    (define-key map "\C-z" c-z)
    map))

(provide 'acdw)
;;; acdw.el ends here

;;; Elephant graveyard

;; XXX NOT WORKING -- And is this even necessary?
;; (defmacro acdw/defun-hook (hook docstring &optional depth local &rest forms)
;;   "Add FORMS to a function described by DOCSTRING, then add that
;;  function to HOOK.  DOCSTRING is converted to a function name by
;;  calling `docstring-to-symbol', if it's a string, or used as-is
;;  otherwise.  The optional DEPTH and LOCAL are passed to
;;  `add-hook', if they're present (i.e., not a list).

;; This macro aims to split the difference between the syntax of
;; lambdas in hooks and the ability to easily disable hooks."
;;   (declare (indent 2))
;;   (let ((name (if (stringp docstring)
;;		  (docstring-to-symbol docstring "hook-")
;;		docstring)))
;;     (when (listp local) (push local forms) (setq local nil))
;;     (when (listp depth) (push depth forms) (setq depth 0))
;;     `(progn
;;        (defun ,name () ,@forms)
;;        (add-hook ,hook #',name ,depth ,local))))

;; Utilities XXX related to `acdw/defun-hook'
;; (defun docstring-to-symbol (docstring &optional prefix)
;;   "Convert a DOCSTRING to a symbol by lowercasing the string,
;; converting non-symbol-safe characters to '-', and calling
;;   `intern'.  Returns the created symbol."
;;   (let ((str (split-string (downcase docstring) "[ \f\t\n\r\v'\"`,]+"
;;			   :omit-nulls)))
;;     (when prefix (push prefix str))
;;     (intern (mapconcat #'identity str "-"))))