From 32959ca977b7b05bcbeef14c559de85ba7838243 Mon Sep 17 00:00:00 2001 From: Case Duckworth Date: Wed, 19 May 2021 12:37:57 -0500 Subject: Add variable-pitch-mode in Org and Info --- lisp/acdw-fonts.el | 45 +++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 45 insertions(+) (limited to 'lisp') diff --git a/lisp/acdw-fonts.el b/lisp/acdw-fonts.el index 6c0cb8d..1b73af7 100644 --- a/lisp/acdw-fonts.el +++ b/lisp/acdw-fonts.el @@ -127,5 +127,50 @@ This is for emoji fonts." (set-fontset-font t 'symbol (font-spec :family font) nil 'append))))) + +;;; Variable-pitch +;; from https://github.com/turbana/emacs-config#variable-pitch + +(defcustom acdw-fonts/fixed-pitch-faces '(linum + org-block + org-block-begin-line + org-block-end-line + org-checkbox + org-code + org-date + org-document-info-keyword + org-hide + org-indent + org-link + org-meta-line + org-special-keyword + org-table + whitespace-space) + "Faces to keep fixed-pitch in `acdw/variable-pitch-mode'." + :type 'sexp + :group 'faces) + +(defun acdw-fonts//variable-pitch-add-inherit (attrs parent) + "Add `:inherit PARENT' to ATTRS unless already present. +Handles cases where `:inherit' is already specified." + (let ((current-parent (plist-get attrs :inherit))) + (unless (or (eq parent current-parent) + (and (listp current-parent) + (member parent current-parent))) + (plist-put attrs :inherit (if current-parent + (list current-parent parent) + parent))))) + +(defun acdw-fonts/adapt-variable-pitch () + "Adapt `variable-pitch-mode' to keep some fonts fixed-pitch." + (when variable-pitch-mode + (mapc (lambda (face) + (when (facep face) + (apply #'set-face-attribute + face nil (acdw-fonts//variable-pitch-add-inherit + (face-attr-construct face) + 'fixed-pitch)))) + acdw-fonts/fixed-pitch-faces))) + (provide 'acdw-fonts) ;;; acdw-fonts.el ends here -- cgit 1.4.1-21-gabe81 From 66d0e6999cf3bd1bb45d5e121f2d1168e0c8a846 Mon Sep 17 00:00:00 2001 From: Case Duckworth Date: Wed, 19 May 2021 15:28:58 -0500 Subject: Rewrite acdw-modeline/word-count to show region counts --- init.el | 27 ++++++++++++++------------- lisp/acdw-modeline.el | 20 ++++++++++++++++++++ 2 files changed, 34 insertions(+), 13 deletions(-) (limited to 'lisp') diff --git a/init.el b/init.el index 06caede..b8584b6 100644 --- a/init.el +++ b/init.el @@ -972,19 +972,20 @@ if ripgrep is installed, otherwise `consult-grep'." (setup (:straight simple-modeline) (setup (:straight minions)) - (:option simple-modeline-segments - '((acdw-modeline/modified - acdw-modeline/buffer-name - acdw-modeline/vc-branch - simple-modeline-segment-position - simple-modeline-segment-word-count) - (simple-modeline-segment-misc-info - acdw-modeline/winum - acdw-modeline/text-scale - simple-modeline-segment-process - acdw-modeline/god-mode-indicator - acdw-modeline/minions - simple-modeline-segment-major-mode))) + (:option + ;; (prepend acdw-modeline/word-count-modes) '(org-mode . #'acdw-org/word-count) + simple-modeline-segments '((acdw-modeline/modified + acdw-modeline/buffer-name + acdw-modeline/vc-branch + simple-modeline-segment-position) + (simple-modeline-segment-misc-info + acdw-modeline/word-count + acdw-modeline/winum + acdw-modeline/text-scale + simple-modeline-segment-process + acdw-modeline/god-mode-indicator + acdw-modeline/minions + simple-modeline-segment-major-mode))) (require 'acdw-modeline) (simple-modeline-mode +1)) diff --git a/lisp/acdw-modeline.el b/lisp/acdw-modeline.el index 81b808d..4f78816 100644 --- a/lisp/acdw-modeline.el +++ b/lisp/acdw-modeline.el @@ -93,4 +93,24 @@ indicator in the mode-line." (> winum--window-count 1)) (format winum-format (winum-get-number-string)))) +(defcustom acdw-modeline/word-count-modes + (mapcar (lambda (m) (cons m nil)) simple-modeline-word-count-modes) + "Alist of modes to functions that `acdw-modeline/word-count' should dispatch. +If the cdr of the cons cell is nil, use the default function (`count-words'). +Otherwise, cdr should be a function that takes two points (see `count-words')." + :type '(alist :key-type (symbol :tag "Major-Mode") + :value-type function) + :group 'simple-modeline) + +(defun acdw-modeline/word-count () + "Display a buffer word count, depending on the major mode. +Uses `acdw-modeline/word-count-modes' to determine which function to use." + (when-let ((modefun + (assoc major-mode acdw-modeline/word-count-modes #'equal))) + (let ((fn (or (cdr modefun) + #'count-words)) + (min (if (region-active-p) (region-beginning) (point-min))) + (max (if (region-active-p) (region-end) (point-max)))) + (format "%dW" (funcall fn min max))))) + (provide 'acdw-modeline) -- cgit 1.4.1-21-gabe81 From ccf03a4be3ee88110d35818dffcd88517c1d1787 Mon Sep 17 00:00:00 2001 From: Case Duckworth Date: Wed, 19 May 2021 17:06:32 -0500 Subject: Change definition of `acdw-org/count-words' (I renamed it from `acdw-org/word-count'.) It's still too slow for use in the modeline. So I have work to do still... --- init.el | 3 +- lisp/acdw-org.el | 142 ++++++++++++++++++++++--------------------------------- 2 files changed, 59 insertions(+), 86 deletions(-) (limited to 'lisp') diff --git a/init.el b/init.el index b8584b6..3bec384 100644 --- a/init.el +++ b/init.el @@ -973,7 +973,8 @@ if ripgrep is installed, otherwise `consult-grep'." (setup (:straight simple-modeline) (setup (:straight minions)) (:option - ;; (prepend acdw-modeline/word-count-modes) '(org-mode . #'acdw-org/word-count) + ;; `acdw-org/count-words' is too slow to use in the modeline. + ;; (prepend acdw-modeline/word-count-modes) '(org-mode . acdw-org/count-words) simple-modeline-segments '((acdw-modeline/modified acdw-modeline/buffer-name acdw-modeline/vc-branch diff --git a/lisp/acdw-org.el b/lisp/acdw-org.el index 3f0c4ea..7e68712 100644 --- a/lisp/acdw-org.el +++ b/lisp/acdw-org.el @@ -243,91 +243,63 @@ the deletion might narrow the column." (org-table-copy-down n) (acdw-org/return-dwim n))) -(defun acdw-org/word-count (beg end - &optional count-latex-macro-args? - count-footnotes?) - "Report the number of words in the Org mode buffer or selected region. -Ignores: -- comments -- tables -- source code blocks (#+BEGIN_SRC ... #+END_SRC, and inline blocks) -- hyperlinks (but does count words in hyperlink descriptions) -- tags, priorities, and TODO keywords in headers -- sections tagged as 'not for export'. +(defun acdw-org/count-words (start end) + "Count words between START and END, respecting `org-mode' conventions." + (interactive (list nil nil)) + (cond ((not (called-interactively-p 'any)) + (let ((words 0)) + (save-excursion + (save-restriction + (narrow-to-region start end) + (goto-char (point-min)) + (while (< (point) (point-max)) + (cond + ;; Ignore comments + ((or (org-at-comment-p) + (org-in-commented-heading-p)) nil) + ;; Ignore tables + ((org-at-table-p) nil) + ;; Ignore hyperlinks, but count the descriptions + ((looking-at org-bracket-link-analytic-regexp) + (when-let ((desc (match-string-no-properties 5))) + (save-match-data + (setq words (+ words + (length (remove "" + (org-split-string + desc "\\W"))))))) + (goto-char (match-end 0))) + ;; Ignore source code blocks + ((org-in-src-block-p) nil) + ;; Ignore footnotes + ((or (org-footnote-at-definition-p) + (org-footnote-at-reference-p)) + nil) + ;; else... check the context + (t (let ((contexts (org-context))) + (cond + ;; Ignore tags, TODO keywords, etc. + ((or (assoc :todo-keyword contexts) + (assoc :priority contexts) + (assoc :keyword contexts) + (assoc :checkbox contexts)) + nil) + ;; Ignore sections tagged :no-export + ((assoc :tags contexts) + (if (intersection (org-get-tags-at) + org-export-exclude-tags + :test 'equal) + (org-forward-same-level 1) + nil)) + ;; else... count the word + (t (setq words (1+ words))))))) + (re-search-forward "\\w+\\W*"))) + words))) + ((use-region-p) + (message "%d words in region" + (acdw-org/count-words (region-beginning) (region-end)))) + (t + (message "%d words in buffer" + (acdw-org/count-words (point-min) (point-max)))))) -The text of footnote definitions is ignored, unless the optional argument -COUNT-FOOTNOTES? is non-nil. - -If the optional argument COUNT-LATEX-MACRO-ARGS? is non-nil, the word count -includes LaTeX macro arguments (the material between {curly braces}). -Otherwise, and by default, every LaTeX macro counts as 1 word regardless -of its arguments." - (interactive "r") - (unless mark-active - (setf beg (point-min) - end (point-max))) - (let ((wc 0) - (latex-macro-regexp "\\\\[A-Za-z]+\\(\\[[^]]*\\]\\|\\){\\([^}]*\\)}")) - (save-excursion - (goto-char beg) - (while (< (point) end) - (cond - ;; Ignore comments. - ((or (org-in-commented-line) (org-at-table-p)) - nil) - ;; Ignore hyperlinks. But if link has a description, count - ;; the words within the description. - ((looking-at org-bracket-link-analytic-regexp) - (when (match-string-no-properties 5) - (let ((desc (match-string-no-properties 5))) - (save-match-data - (incf wc (length (remove "" (org-split-string - desc "\\W"))))))) - (goto-char (match-end 0))) - ((looking-at org-any-link-re) - (goto-char (match-end 0))) - ;; Ignore source code blocks. - ((org-in-regexps-block-p "^#\\+BEGIN_SRC\\W" "^#\\+END_SRC\\W") - nil) - ;; Ignore inline source blocks, counting them as 1 word. - ((save-excursion - (backward-char) - (looking-at org-babel-inline-src-block-regexp)) - (goto-char (match-end 0)) - (setf wc (+ 2 wc))) - ;; Count latex macros as 1 word, ignoring their arguments. - ((save-excursion - (backward-char) - (looking-at latex-macro-regexp)) - (goto-char (if count-latex-macro-args? - (match-beginning 2) - (match-end 0))) - (setf wc (+ 2 wc))) - ;; Ignore footnotes. - ((and (not count-footnotes?) - (or (org-footnote-at-definition-p) - (org-footnote-at-reference-p))) - nil) - (t - (let ((contexts (org-context))) - (cond - ;; Ignore tags and TODO keywords, etc. - ((or (assoc :todo-keyword contexts) - (assoc :priority contexts) - (assoc :keyword contexts) - (assoc :checkbox contexts)) - nil) - ;; Ignore sections marked with tags that are - ;; excluded from export. - ((assoc :tags contexts) - (if (intersection (org-get-tags-at) org-export-exclude-tags - :test 'equal) - (org-forward-same-level 1) - nil)) - (t - (incf wc)))))) - (re-search-forward "\\w+\\W*"))) - (message (format "%d words in %s." wc - (if mark-active "region" "buffer"))))) (provide 'acdw-org) -- cgit 1.4.1-21-gabe81