summary refs log tree commit diff stats
path: root/lisp
diff options
context:
space:
mode:
Diffstat (limited to 'lisp')
-rw-r--r--lisp/acdw-org.el97
-rw-r--r--lisp/acdw.el31
2 files changed, 45 insertions, 83 deletions
diff --git a/lisp/acdw-org.el b/lisp/acdw-org.el index 189ac67..f8f23c6 100644 --- a/lisp/acdw-org.el +++ b/lisp/acdw-org.el
@@ -243,74 +243,13 @@ the deletion might narrow the column."
243 (org-table-copy-down n) 243 (org-table-copy-down n)
244 (acdw-org/return-dwim n))) 244 (acdw-org/return-dwim n)))
245 245
246(defun acdw-org/count-words (start end)
247 "Count words between START and END, respecting `org-mode' conventions."
248 (interactive (list nil nil))
249 (require 'cl-lib)
250 (require 'ox)
251 (message "Counting words...")
252 (cond ((not (called-interactively-p 'any))
253 (let ((words 0))
254 (save-excursion
255 (save-restriction
256 (narrow-to-region start end)
257 (goto-char (point-min))
258 (while (< (point) (point-max))
259 (cond
260 ;; Ignore comments
261 ((or (org-at-comment-p)
262 (org-in-commented-heading-p)) nil)
263 ;; Ignore tables
264 ((org-at-table-p) nil)
265 ;; Ignore hyperlinks, but count the descriptions
266 ((looking-at org-bracket-link-analytic-regexp)
267 (when-let ((desc (match-string-no-properties 5)))
268 (save-match-data
269 (setq words (+ words
270 (length (remove ""
271 (org-split-string
272 desc "\\W")))))))
273 (goto-char (match-end 0)))
274 ;; Ignore source code blocks
275 ((org-in-src-block-p) nil)
276 ;; Ignore footnotes
277 ((or (org-footnote-at-definition-p)
278 (org-footnote-at-reference-p))
279 nil)
280 ;; else... check the context
281 (t (let ((contexts (org-context)))
282 (cond
283 ;; Ignore tags, TODO keywords, etc.
284 ((or (assoc :todo-keyword contexts)
285 (assoc :priority contexts)
286 (assoc :keyword contexts)
287 (assoc :checkbox contexts))
288 nil)
289 ;; Ignore sections tagged :no-export
290 ((assoc :tags contexts)
291 (if (cl-intersection (org-get-tags-at)
292 org-export-exclude-tags
293 :test 'equal)
294 (org-forward-same-level 1)
295 nil))
296 ;; else... count the word
297 (t (setq words (1+ words)))))))
298 (re-search-forward "\\w+\\W*")))
299 words)))
300 ((use-region-p)
301 (message "%d words in region"
302 (acdw-org/count-words (region-beginning) (region-end))))
303 (t
304 (message "%d words in buffer"
305 (acdw-org/count-words (point-min) (point-max))))))
306
307;; This isn't the best code, but it'll do. 246;; This isn't the best code, but it'll do.
308(defun acdw-org/count-words-stupidly (start end &optional limit) 247(defun acdw-org/count-words-stupidly (start end &optional limit)
309 "Count words between START and END, ignoring a lot. 248 "Count words between START and END, ignoring a lot.
310 249
311Since this function is, for some reason, pricy, the optional 250Since this function is, for some reason, pricy, the optional
312parameter LIMIT sets a word limit at which to stop counting. 251parameter LIMIT sets a word limit at which to stop counting.
313Once the function hits that number, it'll return \"-LIMIT\" 252Once the function hits that number, it'll return -LIMIT
314instead of the true count." 253instead of the true count."
315 (interactive (list nil nil)) 254 (interactive (list nil nil))
316 (cond ((not (called-interactively-p 'any)) 255 (cond ((not (called-interactively-p 'any))
@@ -334,13 +273,35 @@ instead of the true count."
334 ((or (looking-at org-drawer-regexp) 273 ((or (looking-at org-drawer-regexp)
335 (looking-at org-clock-drawer-re)) 274 (looking-at org-clock-drawer-re))
336 (search-forward ":END:" nil :noerror)) 275 (search-forward ":END:" nil :noerror))
276 ;; Ignore tables
277 ((org-at-table-p) (forward-line))
278 ;; Ignore hyperlinks, but count the descriptions
279 ((looking-at org-bracket-link-analytic-regexp)
280 (when-let ((desc (match-string-no-properties 5)))
281 (save-match-data
282 (setq words (+ words
283 (length (remove ""
284 (org-split-string
285 desc "\\W")))))))
286 (goto-char (match-end 0)))
287 ;; Ignore source blocks
288 ((org-in-src-block-p) (foreward-line))
337 ;; Count everything else 289 ;; Count everything else
338 (t (setq words (1+ words)) 290 (t
339 (if (and limit 291 ;; ... unless it's in a few weird contexts
340 (> words limit)) 292 (let ((contexts (org-context)))
341 (setq words limit 293 (cond ((or (assoc :todo-keyword contexts)
342 continue nil)) 294 (assoc :priority contexts)
343 (forward-word-strictly)))))) 295 (assoc :keyword contexts)
296 (assoc :checkbox contexts))
297 (forward-word-strictly))
298
299 (t (setq words (1+ words))
300 (if (and limit
301 (> words limit))
302 (setq words (- limit)
303 continue nil))
304 (forward-word-strictly)))))))))
344 words)) 305 words))
345 ((use-region-p) 306 ((use-region-p)
346 (message "%d words in region" 307 (message "%d words in region"
diff --git a/lisp/acdw.el b/lisp/acdw.el index eab0719..2aa6c1f 100644 --- a/lisp/acdw.el +++ b/lisp/acdw.el
@@ -87,21 +87,6 @@ ARG). When called with multiple arguments or a list, it returns
87 (save-restriction 87 (save-restriction
88 (unfill-region (point-min) (point-max)))))) 88 (unfill-region (point-min) (point-max))))))
89 89
90(defun kill-ring-save-unfilled (start end &optional region)
91 "Unfill, kill, then re-fill the region defined by START and END positions.
92REGION is passed straight to `kill-ring-save'."
93 (interactive "*r")
94 (let ((sentence-end-double-space nil))
95 (unfill-region start end)
96 (kill-ring-save
97 ;; A quick hack to try and ameliorate the "Args out of range" error when
98 ;; `unfill-region' removes some newlines. I'm not sure if this will work
99 ;; if calling from Lisp or other such nonsense.
100 (max start (point-min))
101 (min end (point-max))
102 region))
103 (fill-region start end))
104
105(defmacro when-unfocused (name &rest forms) 90(defmacro when-unfocused (name &rest forms)
106 "Define a function NAME, executing FORMS, that fires when Emacs 91 "Define a function NAME, executing FORMS, that fires when Emacs
107is unfocused." 92is unfocused."
@@ -123,6 +108,22 @@ is unfocused."
123 ,@body) 108 ,@body)
124 (message "%s... Done." ,message))) 109 (message "%s... Done." ,message)))
125 110
111(defmacro with-eval-after-loads (files &rest body)
112 "Execute BODY after FILES are loaded.
113This macro simplifies `with-eval-after-load' for multiple nested
114features."
115 (declare (indent 1) (debug (form def-body)))
116 (waterfall-list 'with-eval-after-load files body))
117
118(defun waterfall-list (car list rest)
119 "Cons CAR with each element in LIST in a waterfall fashion, end with REST.
120For use with the `with-eval-after-loads' function."
121 (cond ((atom list) `(,car ',list ,@rest))
122 ((= 1 (length list)) `(,car ',(car list) ,@rest))
123 (t
124 `(,car ',(car list)
125 ,(waterfall-list car (cdr list) rest)))))
126
126 127
127;;; Comment-or-uncomment-sexp 128;;; Comment-or-uncomment-sexp
128;; from https://endlessparentheses.com/a-comment-or-uncomment-sexp-command.html 129;; from https://endlessparentheses.com/a-comment-or-uncomment-sexp-command.html