meh yoke

4 files changed, 205 insertions, 53 deletions

@@ -108,12 +108,10 @@ Do this only if the buffer is not visiting a file."
  regexp-search-ring-max 200
  save-interprogram-paste-before-kill t
  save-some-buffers-default-predicate #'+save-some-buffers-p
- scroll-conservatively 101
- scroll-down-aggressively 0.01
- scroll-margin 2
+ scroll-conservatively 25
+ scroll-margin 0
  scroll-preserve-screen-position 1
  scroll-step 1
- scroll-up-aggressively 0.01
  search-ring-max 200
  search-ring-max 200
  sentence-end-double-space t
@@ -1,7 +1,5 @@
 ;;; acdw.el -- bits and bobs  -*- lexical-binding: t; -*-
 ;; by C. Duckworth <acdw@acdw.net>
-(provide 'acdw)
-
 (require 'cl-lib)
 
 ;;; Define both a directory and a function expanding to a file in that directory
@@ -30,7 +28,6 @@ the filesystem, unless INHIBIT-MKDIR is non-nil."
 
 ;;; 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."
@@ -78,12 +75,12 @@ Convenience wrapper around `define-key'."
 (unless (fboundp 'ensure-list)
   ;; Just in case we're using an old version of Emacs.
   (defun ensure-list (object)
-  "Return OBJECT as a list.
+    "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))))
+    (if (listp object)
+        object
+      (list object))))
 
 (defun add-to-list* (lists &rest things)
   "Add THINGS to LISTS.
@@ -130,8 +127,8 @@ without any separator."
 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)))
+      (dolist (feature features)
+        (apply #'require (ensure-list feature)))
     (:success (mapcar (lambda (f) (car (ensure-list f))) features))
     (t (signal (car e) (cdr e)))))
 
@@ -153,22 +150,33 @@ pass to `require', which see."
          (add-hook 'before-save-hook #',internal-name nil :local))
        (add-hook ',hook #',external-name))))
 
-(defmacro setq-local-hook (hook &rest args)
-  "Run `setq-local' on ARGS when running HOOK."
+(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))
-  (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)
-       (add-hook ',hook #',fn))))
+  `(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.
@@ -182,6 +190,13 @@ If body executes without errors, MESSAGE...Done will be displayed."
          (: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)))))))
+
 ;; https://emacs.stackexchange.com/a/39324/37239
 ;; XXX: This shit don't work rn
 (defun ignore-invisible-overlays (fn)
@@ -189,13 +204,13 @@ If body executes without errors, MESSAGE...Done will be displayed."
 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))
+    (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 ...
@@ -217,3 +232,6 @@ When called with prefix ARG, unconditionally switch buffer."
   (if (or arg (one-window-p))
       (switch-to-buffer (other-buffer) nil t)
     (other-window 1)))
+
+(provide 'acdw)
+;;; acdw.el ends here
@@ -0,0 +1,84 @@
+;;; dawn.el --- Do things at dawn (and dusk) -*- lexical-binding: t; -*-
+
+;;; Commentary:
+
+;; There is also circadian.el, but it doesn't quite work for me.
+;; This code comes mostly from https://gnu.xyz/auto_theme.html, but also
+;; somewhere else (which I've forgotten) and my own brain :)
+
+;;; Code:
+
+(require 'calendar)
+(require 'cl-lib)
+(require 'solar)
+
+(defvar dawn--dawn-timer nil
+  "Timer for dawn-command.")
+
+(defvar dawn--dusk-timer nil
+  "Timer for dusk-command.")
+
+(defvar dawn--reset-timer nil
+  "Timer to reset dawn at midnight.")
+
+(defun dawn-encode-time (f)
+  "Encode fractional time F."
+  (let ((hhmm (cl-floor f))
+        (date (cdddr (decode-time))))
+    (encode-time
+     (append (list 0
+                   (round (* 60 (cadr hhmm)))
+                   (car hhmm)
+                   )
+             date))))
+
+(defun dawn-midnight ()
+  "Return the time of the /next/ midnight."
+  (let ((date (cdddr (decode-time))))
+    (encode-time
+     (append (list 0 0 0 (1+ (car date))) (cdr date)))))
+
+(defun dawn-sunrise ()
+  "Return the time of today's sunrise."
+  (dawn-encode-time (caar (solar-sunrise-sunset (calendar-current-date)))))
+
+(defun dawn-sunset ()
+  "Return the time of today's sunset."
+  (dawn-encode-time (caadr (solar-sunrise-sunset (calendar-current-date)))))
+
+(defun dawn-schedule (dawn-command dusk-command)
+  "Run DAWN-COMMAND at sunrise, and DUSK-COMMAND at dusk.
+RESET is an argument for internal use."
+  (when (or (null calendar-longitude)
+            (null calendar-latitude))
+    (user-error "`dawn' won't work without setting %s!"
+                (cond ((and (null calendar-longitude)
+                            (null calendar-latitude))
+                       "`calendar-longitude' and `calendar-latitude'")
+                      ((null calendar-longitude)
+                       "`calendar-longitude'")
+                      ((null calendar-latitude)
+                       "`calendar-latitude'"))))
+  (let ((dawn (dawn-sunrise))
+        (dusk (dawn-sunset)))
+    (cond
+     ((time-less-p nil dawn)
+      ;; If it isn't dawn yet, it's still dark.  Run DUSK-COMMAND and schedule
+      ;; DAWN-COMMAND and DUSK-COMMAND for later.
+      (funcall dusk-command)
+      (run-at-time dawn nil dawn-command)
+      (run-at-time dusk nil dusk-command))
+     ((time-less-p nil dusk)
+      ;; If it isn't dusk yet, it's still light.  Run DAWN-COMMAND and schedule
+      ;; DUSK-COMMAND.
+      (funcall dawn-command)
+      (run-at-time dusk nil dusk-command))
+     (t ;; Otherwise, it's past dusk, so run DUSK-COMMAND.
+      (funcall dusk-command)))
+    ;; Schedule a reset at midnight, to re-calculate dawn/dusk times.
+    ;(unless reset)
+    (run-at-time (dawn-midnight) nil
+                 #'dawn-schedule dawn-command dusk-command)))
+
+(provide 'dawn)
+;;; dawn.el ends here
@@ -64,8 +64,8 @@ Execute BODY afterward.
          (url (cond ((consp package) (cdr package))
                     (:else nil)))
          (pname (intern (format "yoke:%s" pkg)))
-         (dirvar (gensym "yoke-dir-"))
-         ;; Keyword args
+         (dirvar '$yoke-dir)
+         ;; Keyword args --- TODO: Naming could probably be better.
          (after (plist-get body :after))
          (depends (plist-get body :depends))
          (whenp (plist-member body :when))
@@ -77,6 +77,7 @@ Execute BODY afterward.
          (autoload (cond ((plist-member body :autoload)
                           (plist-get body :autoload))
                          (:else t)))
+         (pre (plist-get body :pre))
          ;; Body
          (body (cl-loop for (this next) on body by #'cddr
                         unless (keywordp this)
@@ -102,12 +103,17 @@ Execute BODY afterward.
                  `((when ,unless (cl-return-from ,pname
                                    (format "%s (abort) :unless %S"
                                            ',pname ',unless))))))
+             ;; Evaluate `:pre' forms
+             ,@pre
              ;; Get prerequisite packages
              ,@(cl-loop
                 for (pkg* . yoke-get-args) in depends
                 collect `(or
-                          (let ((dir (yoke-get ,@yoke-get-args
-                                               :dir ,(format "%s" pkg*))))
+                          (let* ((pkg-spec (yoke-get ,@yoke-get-args
+                                                     :dir ,(format "%s" pkg*)))
+                                 (dir (expand-file-name (or (plist-get (cdr pkg-spec) :load)
+                                                            "")
+                                                        (car pkg-spec))))
                             (and dir
                                  ,@(if autoload
                                        `((yoke-generate-autoloads ',pkg* dir))
@@ -118,13 +124,16 @@ Execute BODY afterward.
                                     ',pkg*))))
              ;; Download the package, generate autoloads
              ,@(when url
-                 `((let ((,dirvar (yoke-get ,@url :dir ,(format "%s" pkg))))
+                 `((let* ((pkg-spec (yoke-get ,@url :dir ,(format "%s" pkg)))
+                          (,dirvar  (expand-file-name (or (plist-get (cdr pkg-spec) :load)
+                                                            "")
+                                                        (car pkg-spec))))
                      ,@(when autoload
                          `((yoke-generate-autoloads ',pkg ,dirvar)))
                      (add-to-list 'yoke-dirs ,dirvar nil #'string=))))
              ;; Evaluate the body, optionally after the features in `:after'
              ,@(cond (after
-                      `((eval-after ,after ,@body)))
+                      `((yoke-eval-after ,after ,@body)))
                      (:else body)))
          (:success ',package)
          (t (message "%s: %s (%s)" ',pname (car err) (cdr err))
@@ -144,7 +153,7 @@ ARGS is a plist with the following possible keys:
                     download URL."
   (let* ((dir (plist-get args :dir))
          (load (plist-get args :load))
-         (type (plist-get args :type))
+         (type (or (plist-get args :type)))
          (path (cond
                 ((eq type 'http) (yoke-get-http url dir))
                 ((or (eq type 'git)
@@ -159,7 +168,7 @@ ARGS is a plist with the following possible keys:
     (cond
      ((file-exists-p path)
       (add-to-list 'load-path (expand-file-name (or load "") path))
-      path)
+      (cons path args))
      (:else (error "Directory \"%s\" doesn't exist." path)
             nil))))
 
@@ -178,7 +187,18 @@ If DIR isn't given, it's guessed from the final component of the
 URL's path and placed under `yoke-dir'."
   (let* ((dir (yoke-get--guess-directory url dir))
          (basename (file-name-nondirectory url))
-         (filename (expand-file-name basename dir)))
+         ;; XXX: Is this the best idea?? PROBABLY NOT!!!  Ideally I'd have
+         ;; a parameter (either dynamic var or passed in) that would give the
+         ;; name of the downloaded file.  But that would take a bit of
+         ;; re-engineering, I think.  So for now, it stays thus.
+         (filename (expand-file-name
+                    (replace-regexp-in-string
+                     (rx "-" (+ digit)             ; major version
+                         (+ (group "." (+ digit))) ; following version numbers
+                         (group "." (+ (not space)))) ; extension
+                     "\\2"
+                     basename)
+                    dir)))
     (cond ((file-exists-p filename)
            dir)
           (:else
@@ -187,6 +207,8 @@ URL's path and placed under `yoke-dir'."
                                   (url-retrieve-synchronously url))
              (condition-case e
                  (progn
+                   (goto-char (point-min))
+                   (delete-region (point) (+ 1 (re-search-forward "^$")))
                    (make-directory dir :parents)
                    (write-file filename 1)
                    (message "Downloading %s... Done" url))
@@ -264,7 +286,7 @@ BODY after Emacs is finished initializing."
            (rest (cdr features)))
       (cond ((eq this 'init)
              `(yoke--eval-after-init
-               (lambda () (eval-after ,rest ,@body))))
+               (lambda () (yoke-eval-after ,rest ,@body))))
             (:else
              `(with-eval-after-load ',this
                 (yoke-eval-after ,rest ,@body)))))))
@@ -277,21 +299,51 @@ BODY after Emacs is finished initializing."
   (setf (alist-get "Yoke" imenu-generic-expression nil nil #'equal)
         (list (rx (: "(yoke" (+ space) (? "(")
                      (group (+ (not (or "(" " " "\t" "\n"))))
-                     (+ space)
-                     (group (+ (not space)))))
+                     (* any)))
               1)))
 
-(defun yoke-compile ()
+;;; Package maintenance
+
+(defvar yoke--all "*all*"
+  "Value that `yoke--prompt-for-package' uses for all packages.")
+
+(defun yoke--choose-packages (prompt &optional onep)
+  "Choose from all of yoke's installed packages."
+  (funcall (if onep #'completing-read #'completing-read-multiple)
+           prompt
+           (cons yoke--all yoke-dirs)
+           nil :require-match nil nil
+           (unless onep yoke--all)))
+
+(defun yoke--choices (&optional selections)
+  "Either the SELECTIONS given, or all of `yoke-dirs'.
+If `yoke--all' is part of SELECTIONS, or if it's not given,
+return the full list of `yoke-dirs'."
+  (cond ((or (null selections)
+             (member yoke--all selections))
+         yoke-dirs)
+        (:else selections)))
+
+(defun yoke-compile (&rest packages)
   "Compile all elisp files in `yoke-dirs'."
-  (interactive)
-  (dolist (dir yoke-dirs)
+  (interactive (yoke--choose-packages "Compile packages: "))
+  (dolist (dir (yoke--choices packages))
     (byte-recompile-directory dir 0)))
 
+(defun yoke-update-autoloads (&rest packages)
+  "Update the autoloads in PACKAGES' directories."
+  (interactive (yoke--choose-packages "Generate autoloads for packages: "))
+  (dolist (dir (yoke--choices packages))
+    (message "Generating autoloads for %s..." dir)
+    (yoke-generate-autoloads (file-name-nondirectory dir) dir)
+    (message "Generating autoloads for %s... Done" dir)))
+
 (defun yoke-remove (dir)
+  "Remove DIR from `yoke-dir'."
   (interactive
-   (completing-read "Remove: " yoke-dirs
-                    nil :require-match))
-  (delete-file dir :trash))
+   (list (completing-read "Remove: " yoke-dirs
+                          nil :require-match)))
+  (delete-directory dir :recursive :trash))
 
 (provide 'yoke)
 ;;; yoke.el ends here