From 259363fd4f21d796c3c6a35be6398aed3f493a73 Mon Sep 17 00:00:00 2001 From: Case Duckworth Date: Tue, 3 Jan 2023 23:02:26 -0600 Subject: bleh --- lisp/+emacs.el | 6 +- lisp/+org.el | 56 ++++++++++ lisp/acdw.el | 35 ++++++ lisp/dawn.el | 67 +++++++---- lisp/def.el | 142 +++++++++++++++++++++++ lisp/org-word-count.el | 297 +++++++++++++++++++++++++++++++++++++++++++++++++ lisp/yoke.el | 111 +++++++++--------- 7 files changed, 636 insertions(+), 78 deletions(-) create mode 100644 lisp/def.el create mode 100644 lisp/org-word-count.el (limited to 'lisp') diff --git a/lisp/+emacs.el b/lisp/+emacs.el index 870e4e2..97377a3 100644 --- a/lisp/+emacs.el +++ b/lisp/+emacs.el @@ -55,7 +55,7 @@ Do this only if the buffer is not visiting a file." cursor-type 'bar custom-file (.etc "custom.el") delete-old-versions t - echo-keystrokes 0.1 + echo-keystrokces 0.1 ediff-window-setup-function 'ediff-setup-windows-plain eldoc-echo-area-use-multiline-p nil eldoc-idle-delay 0.1 @@ -103,7 +103,7 @@ Do this only if the buffer is not visiting a file." ;; 'command-completion-default-include-p) ;; 'command-completion-default-include-p) read-process-output-max 1048576 ; We’re in the future man. Set that to at least a megabyte - recenter-positions '(top middle bottom) + recenter-positions '(top 2 middle bottom) regexp-search-ring-max 100 regexp-search-ring-max 200 save-interprogram-paste-before-kill t @@ -239,7 +239,7 @@ spaces. If N is negative, it will not delete newlines and leave N spaces. See docstring of `cycle-spacing' for the meaning of PRESERVE-NL-BACK and MODE." (interactive "*p") - (cycle-spacing (- n) preserve-nl-back mode)) + (cycle-spacing (- n))) (defun +save-buffers-quit (&optional arg) "Silently save each buffer, then kill the current connection. diff --git a/lisp/+org.el b/lisp/+org.el index 70962d6..7698ec9 100644 --- a/lisp/+org.el +++ b/lisp/+org.el @@ -208,4 +208,60 @@ and POST-PROCESS are passed to `org-export-to-file'." ;; `org-verbatim' and `org-code' are apparently already things, so we skip them ;; here. +;;; Inhibit hooks on `org-agenda' +;; It's really annoying when I call `org-agenda' and five hundred Ispell +;; processes are created because I have `flyspell-mode' in the hook. This mode +;; inhibits those hooks when entering the agenda, but runs them when opening the +;; actual buffer. + +(defun +org-agenda-inhibit-hooks (fn &rest r) + "Advice to inhibit hooks when entering `org-agenda'." + (let ((org-mode-hook nil)) + (apply fn r))) + +(defvar-local +org-hook-has-run-p nil + "Whether `org-mode-hook' has run in the current buffer.") + +(defun +org-agenda-switch-run-hooks (&rest _) + "Advice to run `org-mode-hook' when entering org-mode. +This should only fire when switching to a buffer from `org-agenda'." + (unless +org-hook-has-run-p + (run-hooks 'org-mode-hook) + (setq +org-hook-has-run-p t))) + +(define-minor-mode +org-agenda-inhibit-hooks-mode + "Inhibit `org-mode-hook' when opening `org-agenda'." + :lighter " A/h" + :global t + (cond (+org-agenda-inhibit-hooks-mode + (advice-add 'org-agenda :around #'+org-agenda-inhibit-hooks) + (advice-add 'org-agenda-switch-to :after #'+org-agenda-switch-run-hooks)) + (:else + (advice-remove 'org-agenda #'+org-agenda-inhibit-hooks) + (advice-remove 'org-agenda-switch-to #'+org-agenda-switch-run-hooks)))) + +;;; Drawers +(defun +org-hide-drawers-except-point () + "Hide all drawers except for the one point is in." + ;; Most of this bit is taken from `org-fold--hide-drawers'. + (let ((pt (point)) + (begin (point-min)) + (end (point-max))) + (save-excursion + (goto-char begin) + (while (and (< (point) end) + (re-search-forward org-drawer-regexp end t)) + (if (org-fold-folded-p nil 'drawer) + (goto-char (org-fold-next-folding-state-change 'drawer nil end)) + (let* ((drawer (org-element-at-point)) + (type (org-element-type drawer)) + (el-begin (org-element-property :begin drawer)) + (el-end (org-element-property :end drawer))) + (when (memq type '(drawer property-drawer)) + (org-fold-hide-drawer-toggle + (if (< el-begin pt el-end) 'off 'on) + nil drawer) + (goto-char el-end)))))))) + + (provide '+org) diff --git a/lisp/acdw.el b/lisp/acdw.el index 75e1755..a9ef893 100644 --- a/lisp/acdw.el +++ b/lisp/acdw.el @@ -1,6 +1,8 @@ ;;; 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 @@ -197,6 +199,22 @@ If body executes without errors, MESSAGE...Done will be displayed." `(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) @@ -233,5 +251,22 @@ When called with prefix ARG, unconditionally switch buffer." (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)))) + (provide 'acdw) ;;; acdw.el ends here diff --git a/lisp/dawn.el b/lisp/dawn.el index 806c422..30aab7c 100644 --- a/lisp/dawn.el +++ b/lisp/dawn.el @@ -1,4 +1,13 @@ -;;; dawn.el --- Do things at dawn (and dusk) -*- lexical-binding: t; -*- +;;; dawn.el --- Lightweight dawn/dusk task scheduling -*- lexical-binding: t; -*- + +;; Copyright (C) 2022 Case Duckworth + +;; Author: Case Duckworth +;; Maintainer: Case Duckworth +;; URL: https://codeberg.org/acdw/dusk.el +;; Version: 0.3.0 +;; Keywords: calendar, themes, convenience +;; Package-Requires: ((emacs "24.3")) ;;; Commentary: @@ -12,6 +21,8 @@ (require 'cl-lib) (require 'solar) +;;; Timers + (defvar dawn--dawn-timer nil "Timer for dawn-command.") @@ -21,16 +32,19 @@ (defvar dawn--reset-timer nil "Timer to reset dawn at midnight.") +;;; Functions + (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)))) + "Encode fractional time F. +If F is nil, return nil." + (when 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." @@ -46,22 +60,34 @@ "Return the time of today's sunset." (dawn-encode-time (caadr (solar-sunrise-sunset (calendar-current-date))))) +;;; Interface + +;;;###autoload (defun dawn-schedule (dawn-command dusk-command) "Run DAWN-COMMAND at sunrise, and DUSK-COMMAND at dusk. -RESET is an argument for internal use." +Requires `calendar-longitude' and `calendar-latitude' to be set; +if they're not, it will prompt the user for them or error." (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'")))) + (null calendar-latitude)) + (or (solar-setup) + (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 + ((or (null dawn) (null dusk)) + ;; There is no sunrise or sunset, due to how close we are to the poles. + ;; In this case, we must figure out whether it's day or night. + (pcase (caddr (solar-sunrise-sunset (calendar-current-date))) + ("0:00" (funcall dusk-command)) ; 0 hours of daylight + ("24:00" (funcall dawn-command)) ; 24 hours of daylight + )) ((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. @@ -76,7 +102,6 @@ RESET is an argument for internal use." (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))) diff --git a/lisp/def.el b/lisp/def.el new file mode 100644 index 0000000..0bf91b2 --- /dev/null +++ b/lisp/def.el @@ -0,0 +1,142 @@ +;;; def.el --- defining macros -*- lexical-binding: t; -*- + +;;; Code: + +(require 'cl-lib) + +;;; Utility + +(defun def--assert-args (pred args &optional error-type &rest error-args) + "Assert that ARGS follows PRED. +If it doesn't, raise an error. ERROR-TYPE will be the type of +that error (defaults to `user-error'), and it and ERROR-ARGS are +passed in a list to `signal'." + (unless (funcall pred args) + (funcall #'signal + (or error-type 'user-error) + (or error-args + (list "Wrong arguments" args))))) + +(defmacro o (&rest fns) + "Compose FNS into a new function for one argument." + (if (null fns) + `(lambda (&rest args) args) + `(lambda (&rest args) + (apply + #',(car fns) + (ensure-list (apply (o ,@(cdr fns)) args)))))) + +;; TODO: I need to figure out where this function goes. +(defun def--delete2 (list &rest elems) + "Delete each element of ELEMS, and the next item, from LIST." + (let ((r nil)) + (while (consp list) + (if (member (car list) elems) + (setf list (cdr list)) + (setf r (cons (car list) r))) + (setf list (cdr list))) + (reverse r))) + +;;; Keybindings + +(defmacro defkeys (maps &rest bindings) + "Define key BINDINGS in MAPS. +If MAPS is nil or t, bind to `current-global-map'. Otherwise, +bind each of BINDINGS to the map or list of maps provided. + +BINDINGS is a `setq'-style list of pairs of keys and definitions. +The key part of each binding can be a string, in which case it's +passed to `kbd', or a vector or anything else `define-key' +accepts in the KEY position. The definition part, likewise, can +be any form `define-key' accepts in that position, with this +addition: if the form is a `defun' form, it will be defined +before any keys are bound." + (declare (indent 1)) + (def--assert-args (o cl-evenp length) bindings + 'wrong-number-of-arguments 'defkeys 'evenp (length bindings)) + `(progn + ,@(cl-loop + for map in (ensure-list maps) + for first-map-p = t then nil + append + (cl-loop + for (keys def) on bindings by #'cddr + for defp = (memq (car-safe def) '(defmap defun defmacro)) + if (and defp first-map-p) collect def into defuns + append + (cl-loop + for key in (ensure-list keys) + collect (list 'define-key + (if (memq map '(t nil)) + '(current-global-map) + (or (car-safe map) map)) + (if (stringp key) + `(kbd ,key) + key) + (if defp + (cl-case (car def) + ((defmap) (cadr def)) + ((defun defmacro) `#',(cadr def)) + (otherwise (error "Bad def type: %S" + (car def)))) + def))) + into keydefs + finally return + (let ((all (append defuns keydefs))) + (if-let ((after (plist-get (cdr-safe map) :after))) + `((eval-after ,after + ,@all)) + all)))))) + +(defmacro defmap (name docstring &rest bindings) + "Define a keymap named NAME, with BINDINGS." + (declare (indent 1) (doc-string 2)) + `(,(if (boundp name) 'setq 'defvar) ,name + ;;; ^ probably a terrible hack + (let ((map (make-sparse-keymap))) + (defkeys map ,@bindings) + map) + ,@(unless (boundp name) (list docstring)))) + +;;; Hooks + +(defmacro defhook (hooks &rest body) + "Define a function to hook into HOOKS. +NAME and ARGS are passed to the generated `defun' form. +Each hook in HOOKS can be the name of a hook or a list of the form +(HOOK DEPTH LOCAL), where each argument is the same as in +`add-hook'." + (declare (indent 1)) + (let* ((name (or (plist-get body :name) + (intern (format "%s/h" + (mapconcat + (lambda (h) + (string-remove-suffix + "-hook" (symbol-name (or (car-safe h) + h)))) + (ensure-list hooks) + "|"))))) + (args (or (plist-get body :args) nil)) + (doc (or (plist-get body :doc) nil)) + (forms ; (DEFUN . FUNCS) + (cl-loop for form in (def--delete2 body :name :args :doc) + if (eq (car form) 'function) + collect form into funcs + else collect form into defuns + finally return (cons defuns funcs))) + (defun-forms (car forms)) + (func-forms (cdr forms))) + `(progn + ,@(when defun-forms + `((defun ,name ,args ,@(when doc (list doc)) ,@defun-forms))) + ,@(cl-loop for hook in (ensure-list hooks) + for h = (or (car-safe hook) hook) + for ha = (cdr-safe hook) + if defun-forms + collect `(add-hook ',h #',name ,@ha) + append + (cl-loop for fn in func-forms + collect `(add-hook ',h ,fn ,@ha)))))) + +(provide 'def) +;;; def.el ends here diff --git a/lisp/org-word-count.el b/lisp/org-word-count.el new file mode 100644 index 0000000..d6d2598 --- /dev/null +++ b/lisp/org-word-count.el @@ -0,0 +1,297 @@ +;;; org-word-count.el --- org-word-count in the modeline -*- lexical-binding: t; -*- + +;;; Commentary: + +;;; Code: + +(require 'org) +(require 'cl-lib) + +(defgroup org-word-count nil + "Extra fast word-counting in `org-mode'." + :group 'org) + +(defvar-local org-word-count-word-count nil + "Running total of words in this buffer.") + +(defvar-local org-word-count-string nil + "String for the modeline.") + +(defcustom org-word-count-format "%sw " + "Format for org word count in modeline." + :type 'string) + +(defcustom org-word-count-huge-string "huge" + "String to display with a huge buffer." + :type 'string) + +(defcustom org-word-count-update-after-funcs '(org-narrow-to-subtree + org-narrow-to-block + org-narrow-to-element + org-capture-narrow) + "Functions after which to update the word count." + :type '(repeat function)) + +(defcustom org-word-count-deletion-idle-timer 0.25 + "Length of time, in seconds, to wait before updating word-count." + :type 'number) + +(defcustom org-word-count-huge-change 5000 + "Number of characters that constitute a \"huge\" insertion." + :type 'number) + +(defcustom org-word-count-huge-buffer 10000 + "Number of words past which we're not going to try to count." + :type 'number) + +(defvar org-word-count-correction -5 + "Number to add to `org-word-count-word-count', for some reason? +`org-word-count-word-count' seems to consistently be off by 5. Thus +this correction. (At some point I should correct the underlying +code... probably).") + +(defvar-local org-word-count-update-timer nil) + +;;; Variables from org-wc + +(defun org-word-count-list-of-strings-p (arg) + (cl-every #'stringp arg)) + +(defun org-word-count--downcase-list-of-strings-set-default (var val) + (set-default var (mapcar #'downcase val))) + +(defcustom org-word-count-ignored-tags '("nowc" "noexport" "ARCHIVE") + "List of tags for which subtrees will be ignored in word counts" + :type '(repeat string) + :safe #'org-word-count-list-of-strings-p) + +(defcustom org-word-count-ignore-commented-trees t + "Ignore trees with COMMENT-prefix if non-nil." + :type 'boolean + :safe #'booleanp) + +(defcustom org-word-count-default-link-count 'description-or-path + "Default way of counting words in links. +This is applied to any link type not specified in any of +‘org-word-count-ignored-link-types’,‘org-word-count-one-word-link-types’, or +‘org-word-count-only-description-link-types’ " + :type '(choice + (const :tag "Count words in description or else path part of links" description-or-path) + (const :tag "Count words only in description part of links" description) + (const :tag "Count links as 0 words" ignore) + (const :tag "Count links as 1 word" oneword) + (const :tag "Count words only in path part of links" path)) + :safe 'symbolp) + +(defcustom org-word-count-ignored-link-types nil + "Link types which won't be counted as a word" + :type '(repeat string) + :safe #'org-word-count-list-of-strings-p) + +(defcustom org-word-count-one-word-link-types '("zotero") + "Link types which will be counted as one word" + :type '(repeat string) + :safe #'org-word-count-list-of-strings-p) + +(defcustom org-word-count-description-or-path-link-types '() + "Link types for which the description or the path should be counted" + :type '(repeat string) + :safe #'org-word-count-list-of-strings-p) + +(defcustom org-word-count-only-description-link-types '("note") + "Link types for which only the description should be counted" + :type '(repeat string) + :safe #'org-word-count-list-of-strings-p) + +(defcustom org-word-count-only-path-link-types '() + "Link types for which only the path should be counted" + :type '(repeat string) + :safe #'org-word-count-list-of-strings-p) + +(defcustom org-word-count-blocks-to-count '("quote" "verse") + "List of blocks which should be included in word count. + +Use lower case block names" + :type '(repeat string) + :safe #'org-word-count-list-of-strings-p + :set #'org-word-count--downcase-list-of-strings-set-default) + +(defun org-word-count-delayed-update (&rest _) + (if org-word-count-update-timer + (setq org-word-count-update-timer nil) + (setq org-word-count-update-timer + (run-with-idle-timer org-word-count-deletion-idle-timer nil + #'org-word-count-update)))) + +(defun org-word-count-force-update () + (interactive) + (message "Counting words...") + (when (timerp org-word-count-update-timer) + (cancel-timer org-word-count-update-timer)) + (org-word-count-update) + (message "Counting words...done")) + +(defun org-word-count-update (&rest _) ; Needs variadic parameters, since it's advice + (dlet ((org-word-count-counting t)) + (org-word-count-buffer) + (org-word-count-modeline) + (setq org-word-count-update-timer nil))) + +(defun org-word-count-changed (start end length) + (org-word-count-delayed-update)) + +(defun org-word-count-buffer () + "Count the words in the buffer." + (when (and (derived-mode-p 'org-mode) + (not (eq org-word-count-word-count 'huge))) + (setq org-word-count-word-count + (cond + ((> (count-words (point-min) (point-max)) + org-word-count-huge-buffer) + 'huge) + (t (org-word-count-aux (point-min) (point-max))))))) + +;;; From org-wc.el: +;; https://github.com/tesujimath/org-wc/ +(defun org-word-count-aux (beg end) + "Return the number of words between BEG and END." + (let ((wc 0) + subtreecount + (latex-macro-regexp "\\\\[A-Za-z]+\\(\\[[^]]*\\]\\|\\){\\([^}]*\\)}")) + (save-excursion + (goto-char beg) + ;; Handle the case where we start in a drawer + (when (org-at-drawer-p) + (org-end-of-meta-data t)) + (while (< (point) end) + (cond + ;; Handle headlines and subtrees + ((org-at-heading-p) + (cond + ;; Ignore commented and org-wc-ignored-tags trees + ((or (and org-word-count-ignore-commented-trees (org-in-commented-heading-p)) + (cl-intersection org-word-count-ignored-tags (org-get-tags) :test #'string=)) + (org-end-of-subtree t t)) + ;; Re-use count for subtrees already counted + ((setq subtreecount (get-text-property (point) :org-wc)) + (cl-incf wc subtreecount) + (org-end-of-subtree t t)) + ;; Skip counting words in headline + (t (org-word-count--goto-char (point-at-eol) end)))) + ;; Ignore most blocks. + ((when (save-excursion + (beginning-of-line 1) + (looking-at org-block-regexp)) + (if (member (downcase (match-string 1)) org-word-count-blocks-to-count) + (progn ;; go inside block and subtract count of end line + (org-word-count--goto-char (match-beginning 4) end) + (cl-decf wc)) + (org-word-count--goto-char (match-end 0) end)))) + ;; Ignore comments. + ((org-at-comment-p) + (org-word-count--goto-char (point-at-eol) end)) + ;; Ignore drawers. + ((org-at-drawer-p) + (org-end-of-meta-data t)) + ;; Ignore all other #+ lines + ((looking-at "#+") + (org-word-count--goto-char (point-at-eol) end)) + ;; Handle links + ((save-excursion + (when (< (1+ (point-min)) (point)) (backward-char 2)) + (looking-at org-link-bracket-re)) + (let* ((type (car (save-match-data (split-string (match-string 1) ":")))) + (pathstart (+ 1 (length type) (match-beginning 1)))) + (cl-case (cond ((member type org-word-count-ignored-link-types) 'ignore) + ((member type org-word-count-one-word-link-types) 'oneword) + ((member type org-word-count-only-description-link-types) + 'description) + ((member type org-word-count-only-path-link-types) 'path) + ((member type org-word-count-description-or-path-link-types) + 'description-or-path) + (t org-word-count-default-link-count)) + (ignore (org-word-count--goto-char (match-end 0) end)) + (oneword (org-word-count--goto-char (match-end 0) end) + (cl-incf wc)) + (description (if (match-beginning 2) + (goto-char (match-beginning 2)) + (org-word-count--goto-char + (match-end 0) end))) + (path (cl-incf wc (count-words-region pathstart + (match-end 1))) + (org-word-count--goto-char (match-end 0) end)) + (description-or-path + (if (match-beginning 2) + (goto-char (match-beginning 2)) + (cl-incf wc (count-words-region pathstart + (match-end 1))) + (org-word-count--goto-char (match-end 0) end))) + (t (user-error "Error in org-word-count link configuration"))))) + ;; Count latex macros as 1 word, ignoring their arguments. + ((save-excursion + (when (< (point-min) (point)) (backward-char)) + (looking-at latex-macro-regexp)) + (org-word-count--goto-char (match-end 0) end) + (cl-incf wc)) + (t + (and (re-search-forward "\\w+\\W*" end 'skip) + (cl-incf wc)))))) + wc)) + +(defun org-word-count--goto-char (char end) + "Moves point to CHAR and from there passes 0+ non-word characters. +Searchers to end as a maximum. + +This ensures that we are in an expected state (at the first word +character after some non-word characters) after moving beyond +headlines, links etc." + (goto-char char) + (re-search-forward "\\W*" end 'skip)) + +(defvar org-word-count-counting nil + "Are we currently counting?") + +(defun org-word-count-recount-widen (&rest _) + (when (and (not org-word-count-counting)) + (org-word-count-update))) + +(defun org-word-count-modeline () + (setq org-word-count-string + (cond + ((eq org-word-count-word-count 'huge) + org-word-count-huge-string) + (org-word-count-word-count + (format org-word-count-format + (max 0 (+ org-word-count-word-count + org-word-count-correction)))))) + (force-mode-line-update)) + +(define-minor-mode org-word-count-mode + "Count words in `org-mode' buffers in the mode-line." + :lighter "" + :keymap (let ((map (make-sparse-keymap))) + (define-key map (kbd "C-c C-.") #'org-word-count-force-update) + map) + (cond (org-word-count-mode + (org-word-count-buffer) + (add-hook 'after-change-functions + #'org-word-count-delayed-update nil t) + (unless (member '(org-word-count-mode org-word-count-string) + mode-line-misc-info) + (add-to-list 'mode-line-misc-info + '(org-word-count-mode org-word-count-string) + nil + #'equal)) + (dolist (fn org-word-count-update-after-funcs) + (advice-add fn :after #'org-word-count-update))) + (:else + (remove-hook 'after-change-functions + #'org-word-count-delayed-update t) + (setf mode-line-misc-info + (delete '(org-word-count-mode org-word-count-string) + mode-line-misc-info)) + (dolist (fn org-word-count-update-after-funcs) + (advice-remove fn #'org-word-count-update))))) + +(provide 'org-word-count) +;;; org-word-count.el ends here diff --git a/lisp/yoke.el b/lisp/yoke.el index f9c4d49..8ca94fd 100644 --- a/lisp/yoke.el +++ b/lisp/yoke.el @@ -84,60 +84,63 @@ Execute BODY afterward. append (list this next) into ret finally return (cond ((eq (car (last ret)) nil) (butlast ret)) - (:else ret))))) - `(cl-block ,pname - (condition-case err - (progn - ;; Pass `:when' or `:unless' clauses - ,@(cond - ((and whenp unlessp) - `((when (or (not ,when) ,unless) - (cl-return-from ,pname - (format "%s (abort) :when %S :unless %S" - ',pname ',when ',unless))))) - (whenp - `((unless ,when (cl-return-from ,pname - (format "%s (abort) :when %S" - ',pname ',when))))) - (unlessp - `((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* ((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)) - '(t)) - (add-to-list 'yoke-dirs dir nil #'string=))) - (cl-return-from ,pname - (format "Error fetching prerequiste: %s" - ',pkg*)))) - ;; Download the package, generate autoloads - ,@(when url - `((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 - `((yoke-eval-after ,after ,@body))) - (:else body))) - (:success ',package) - (t (message "%s: %s (%s)" ',pname (car err) (cdr err)) - nil))))) + (:else ret)))) + (r (gensym))) + `(let ((,r (cl-block ,pname +(condition-case err + (progn + ;; Pass `:when' or `:unless' clauses + ,@(cond + ((and whenp unlessp) + `((when (or (not ,when) ,unless) + (cl-return-from ,pname + (format "%s (abort) :when %S :unless %S" + ',pname ',when ',unless))))) + (whenp + `((unless ,when (cl-return-from ,pname + (format "%s (abort) :when %S" + ',pname ',when))))) + (unlessp + `((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* ((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)) + '(t)) + (add-to-list 'yoke-dirs dir nil #'string=))) + (cl-return-from ,pname + (format "Error fetching prerequiste: %s" + ',pkg*)))) + ;; Download the package, generate autoloads + ,@(when url + `((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 + `((yoke-eval-after ,after ,@body))) + (:else body))) + (:success ',package) + (t (message "%s: %s (%s)" ',pname (car err) (cdr err)) + nil))))) + (when (stringp ,r) (message "%S" ,r)) + ,r))) (defun yoke-get (url &rest args) "\"Get\" URL and and put it in DIR, then add DIR to `load-path'. -- cgit 1.4.1-21-gabe81