A few changes

- add dedicate-windows-by-modes as window-configuration-change-hook,
  but it did not work well when used on gnus-summary-mode
- copying gnus article regions also copies links, which are appended
  at the end of the copy as footnote
- overload org-id-store-link so that capturing today's work could
  include the item priority
- org should open a gnus link in other-window
- fixing my-org-clean-up-entry so that it deletes trailing empty lines
- added a silly utility function to clean a red energy bill pay link

10 files changed, 120 insertions, 20 deletions

diff --git a/emacs/.emacs.d/init/ycp-buffer.el b/emacs/.emacs.d/init/ycp-buffer.el
index bb8b1dd..6096869 100644
--- a/emacs/.emacs.d/init/ycp-buffer.el
+++ b/emacs/.emacs.d/init/ycp-buffer.el
@@ -141,6 +141,7 @@
 (my-package window
   (require 'time)
   (require 'my-buffer)
+  (add-hook 'window-configuration-change-hook 'my-dedicate-windows-by-modes)
   (setq display-buffer-alist
         `(;; no window
           ("\\`\\*Async Shell Command\\*\\'"
@@ -155,9 +156,9 @@
            (window-parameters . ((mode-line-format . none))))
           ;; bottom buffer (NOT side window)
           ((or . (,(my-buffer-make-display-matcher
-                   '(flymake-diagnostics-buffer-mode
-                     flymake-project-diagnostics-mode
-                     messages-buffer-mode backtrace-mode))
+                    '(flymake-diagnostics-buffer-mode
+                      flymake-project-diagnostics-mode
+                      messages-buffer-mode backtrace-mode))
                   "\\*\\(Warnings\\|Compile-Log\\|Org Links\\)\\*"
                   ,world-clock-buffer-name))
            (display-buffer-reuse-mode-window display-buffer-at-bottom)
@@ -202,7 +203,7 @@
                   "\\*\\(Man\\|woman\\).*"
                   "\\*shell\\*.*"))
            (display-buffer-same-window))
-))
+          ))
 
   (setq switch-to-buffer-in-dedicated-window 'pop)
   (setq window-combination-resize nil)
diff --git a/emacs/.emacs.d/init/ycp-gnus.el b/emacs/.emacs.d/init/ycp-gnus.el
index e104d25..fd15e7f 100644
--- a/emacs/.emacs.d/init/ycp-gnus.el
+++ b/emacs/.emacs.d/init/ycp-gnus.el
@@ -80,6 +80,7 @@
                   gnus-browse-mode-hook))
     (add-hook mode #'hl-line-mode))
   (require 'my-gnus)
+  (require 'my-buffer)
   (my-setq-from-local my-gnus-inbox-group
                       my-gnus-group-alist)
   (my-keybind global-map
@@ -165,8 +166,9 @@
 (my-package gnus-art
   (setq gnus-inhibit-images t)
   (setq gnus-treat-display-smileys nil)
-  (setq gnus-article-x-face-too-ugly ".*")) ; all images in headers are outright
-                                        ; annoying---disabled!
+  (setq gnus-article-x-face-too-ugly ".*")
+  (my-keybind gnus-article-mode-map
+    "M-w" #'my-gnus-article-copy-region))
 ;;; gnus-desktop-notify
 (my-package gnus-desktop-notify
   (:delay 30)
diff --git a/emacs/.emacs.d/init/ycp-markup.el b/emacs/.emacs.d/init/ycp-markup.el
index d4879dd..843accd 100644
--- a/emacs/.emacs.d/init/ycp-markup.el
+++ b/emacs/.emacs.d/init/ycp-markup.el
@@ -72,7 +72,7 @@
   (my-keybind wiki-mode-map
     "C-'" #'my-wiki-grok-wikipedia)
   (my-setq-from-local wiki-sites)
-  (define-wiki-site-commands))
+  (wiki-define-site-commands))
 
 (my-package ledger-mode
   (:install t)
diff --git a/emacs/.emacs.d/init/ycp-org.el b/emacs/.emacs.d/init/ycp-org.el
index 2f93b3d..b9ccef4 100644
--- a/emacs/.emacs.d/init/ycp-org.el
+++ b/emacs/.emacs.d/init/ycp-org.el
@@ -213,7 +213,9 @@
   (setq org-capture-templates
         `(("w" "Today's work" checkitem
            (file+headline org-default-notes-file "Today's work")
-           "- [ ] %a%?"
+           ;; the :priority link prop requires overloading
+           ;; `org-id-store-link' below to work
+           "- [ ] [#%:priority] %a%?"
            :prepend t)
           ("j" "Journal" entry
 	         (file+olp+datetree ,(my-get-from-local my-org-journal-file))
@@ -303,6 +305,7 @@
         '(("User commands")
           ("T" . my-org-swap-referral-with-headline)
           ("D" . my-org-clean-up-entry)
+          ("g" . org-delete-property)
           ("W" . my-org-refile-logbook)
           ("+" . my-org-vote-up)
           ("-" . my-org-vote-down)
@@ -425,6 +428,7 @@
 (my-package ol
   (:delay 10)
   (require 'my-buffer)
+  (advice-add 'org-gnus-no-new-news :before 'my-org-gnus-other-window-advice)
   (add-to-list 'org-link-frame-setup
                (cons 'file 'my-find-file-maybe-other-window))
   )
@@ -450,6 +454,7 @@
   (my-override org-open-at-point-global)
   (my-override org-refile-get-targets)
   (my-override org-insert-last-stored-link)
+  (my-override org-id-store-link)
   (org-link-set-parameters "info" :follow #'my-org-info-open-new-window)
   (org-link-set-parameters "rt" :follow #'my-org-rt-open-new-window)
   (my-override org-src--make-source-overlay)
diff --git a/emacs/.emacs.d/init/ycp-prog.el b/emacs/.emacs.d/init/ycp-prog.el
index d3373d9..78bdd88 100644
--- a/emacs/.emacs.d/init/ycp-prog.el
+++ b/emacs/.emacs.d/init/ycp-prog.el
@@ -235,7 +235,7 @@
   )
 
 ;;; debugger
-(my-package debugger
+(my-package debug
   (my-override debugger-quit))
 
 (my-package inf-lisp
diff --git a/emacs/.emacs.d/init/ycp-web.el b/emacs/.emacs.d/init/ycp-web.el
index 5c96e43..dcaa3eb 100644
--- a/emacs/.emacs.d/init/ycp-web.el
+++ b/emacs/.emacs.d/init/ycp-web.el
@@ -159,6 +159,8 @@
 (add-to-list 'load-path (locate-user-emacs-file "lisp/mastodon.el/lisp"))
 (my-package mastodon
   (my-setq-from-local mastodon-active-user mastodon-instance-url)
+  ;; auto fill is a bit glitchy when composing a toot
+  (add-hook 'mastodon-toot-mode-hook (lambda () (turn-off-auto-fill)))
   (mastodon))
 
 (add-to-list 'load-path (locate-user-emacs-file "lisp/servall/lisp"))
diff --git a/emacs/.emacs.d/lisp/my/my-buffer.el b/emacs/.emacs.d/lisp/my/my-buffer.el
index 11d869d..fa51abf 100644
--- a/emacs/.emacs.d/lisp/my/my-buffer.el
+++ b/emacs/.emacs.d/lisp/my/my-buffer.el
@@ -313,6 +313,16 @@ that point."
                     (zerop (forward-line 1))))
         (eobp))))
 
+(defvar my-dedicated-modes nil
+  "Modes whose windows will be dedicated")
+(defun my-dedicate-windows-by-modes ()
+  "Dedicate windows with modes from `my-dedicated-modes'."
+  (walk-windows
+   (lambda (window)
+     (when (with-current-buffer (window-buffer window)
+             (apply 'derived-mode-p my-dedicated-modes))
+       (set-window-dedicated-p window t)))))
+
 ;;;; Scratch buffers
 ;; The idea is based on the `scratch.el' package by Ian Eure:
 ;; <https://github.com/ieure/scratch-el>.
diff --git a/emacs/.emacs.d/lisp/my/my-gnus.el b/emacs/.emacs.d/lisp/my/my-gnus.el
index aee03b5..1f7ff18 100644
--- a/emacs/.emacs.d/lisp/my/my-gnus.el
+++ b/emacs/.emacs.d/lisp/my/my-gnus.el
@@ -323,5 +323,37 @@ The archiving target comes from `my-gnus-group-alist'."
 	            (message "Displaying %s..." command))
 	          'external)))))))
 
+(defun my-gnus-article-copy-region (beg end)
+  "Copy an gnus article region from beginning to end, links included."
+  (interactive "r")
+  (let ((pairs)
+        (copied (buffer-substring-no-properties beg end))
+        (inhibit-message t))
+    (save-excursion
+      (goto-char beg)
+      (when-let* ((button (button-at (point)))
+                  (url (button-get button 'shr-url)))
+        (push (cons (buffer-substring-no-properties
+                     (button-start button)
+                     (button-end button))
+                    url)
+              pairs))
+      (while (and (shr-next-link)
+                  (<= (point) end))
+        (let ((button (button-at (point))))
+          (push (cons (buffer-substring-no-properties
+                       (button-start button)
+                       (button-end button))
+                      (button-get button 'shr-url))
+                pairs)))
+      (pcase-dolist (`(,label . ,url) (reverse pairs))
+        (setq copied
+              (concat copied
+                      (format "[%s] %s\n" label url)))))
+    (kill-new copied)
+    (setq deactivate-mark t)
+    (let ((inhibit-message nil))
+      (message "Copied region with %d links." (length pairs)))))
+
 (provide 'my-gnus)
 ;;; my-gnus.el ends here
diff --git a/emacs/.emacs.d/lisp/my/my-org.el b/emacs/.emacs.d/lisp/my/my-org.el
index 1a44a10..43be91f 100644
--- a/emacs/.emacs.d/lisp/my/my-org.el
+++ b/emacs/.emacs.d/lisp/my/my-org.el
@@ -1142,10 +1142,14 @@ Flush lines with only some common symbols."
   (interactive)
   (my-org-delete-empty-properties)
   (org-attach-sync)
-  (save-restriction
-    (org-narrow-to-subtree)
-    (flush-lines "^[ \t-]*$")
-    (delete-trailing-whitespace)))
+  (save-excursion
+    (save-restriction
+      (org-narrow-to-subtree)
+      (flush-lines "^\\ *[-]+\\ *$")
+      (delete-trailing-whitespace)
+      (goto-char (point-max))
+      (when (<= (skip-chars-backward "\n") -2)
+        (delete-region (1+ (point)) (point-max))))))
 
 (defun my-org-delete-empty-properties ()
   "Delete empty (standard) properties at point."
@@ -1304,5 +1308,38 @@ buffer preserved, annotated with the size"
             (insert line "\n"))))))
   (switch-to-buffer-other-window "*org-sizes*"))
 
+;; for `org-link-frame-setup'
+(defun my-org-gnus-other-window-advice ()
+  (other-window 1))
+
+
+;; override `org-id-store-link' with a priority property
+(defun my-org-id-store-link ()
+  "Store a link to the current entry, using its ID.
+
+If before first heading store first title-keyword as description
+or filename if no title."
+  (interactive)
+  (when (and (buffer-file-name (buffer-base-buffer)) (derived-mode-p 'org-mode))
+    (let* ((link (concat "id:" (org-id-get-create)))
+	         (case-fold-search nil)
+	         (desc (save-excursion
+		               (org-back-to-heading-or-point-min t)
+                   (cond ((org-before-first-heading-p)
+                          (let ((keywords (org-collect-keywords '("TITLE"))))
+                            (if keywords
+                                (cadr (assoc "TITLE" keywords))
+                              (file-name-nondirectory
+			                         (buffer-file-name (buffer-base-buffer))))))
+		                     ((looking-at org-complex-heading-regexp)
+			                    (if (match-end 4)
+			                        (match-string 4)
+			                      (match-string 0)))
+                         (t link))))
+           (prio (org-entry-get (point) "PRIORITY")))
+      (org-link-store-props :link link :description desc :type "id"
+                            :priority prio)
+      link)))
+
 (provide 'my-org)
 ;;; my-org.el ends here
diff --git a/emacs/.emacs.d/lisp/my/my-web.el b/emacs/.emacs.d/lisp/my/my-web.el
index bd6a55d..311bcf9 100644
--- a/emacs/.emacs.d/lisp/my/my-web.el
+++ b/emacs/.emacs.d/lisp/my/my-web.el
@@ -126,16 +126,27 @@
    (list
     (let ((com-table))
       (dolist (buffer (buffer-list))
-	(with-current-buffer buffer
-	  (when (equal major-mode 'eww-mode)
-	    (add-to-list
-	     'com-table
-	     (concat (plist-get eww-data :title)
-		     (propertize (concat " " (buffer-name))
-				 'invisible t))))))
+	      (with-current-buffer buffer
+	        (when (equal major-mode 'eww-mode)
+	          (add-to-list
+	           'com-table
+	           (concat (plist-get eww-data :title)
+		                 (propertize (concat " " (buffer-name))
+				                         'invisible t))))))
       (completing-read "Eww buffer title: " com-table))))
   (string-match "^.* \\(.*\\)$" title-and-buffer)
   (switch-to-buffer (match-string 1 title-and-buffer)))
 
+(defun my-red-energy-copy-clean-url (beg end)
+  "Clean up the payment url in a raw red energy bill email."
+  (interactive "r")
+  (let ((url (url-unhex-string
+              (replace-regexp-in-string
+               "^.*url=" "" (replace-regexp-in-string
+                             "=3D" "=" (replace-regexp-in-string "=
+" "" (buffer-substring-no-properties beg end)))))))
+    (kill-new url)
+    (message "Copied link: %s" url)))
+
 (provide 'my-web)
 ;;; my-web.el ends here