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

4 files changed, 101 insertions, 11 deletions

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