From 1622ac38772868d101e48107591db8f4700627c4 Mon Sep 17 00:00:00 2001
From: Yuchen Pei <id@ypei.org>
Date: Tue, 5 Sep 2023 00:14:03 +1000
Subject: 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
---
 emacs/.emacs.d/lisp/my/my-org.el | 45 ++++++++++++++++++++++++++++++++++++----
 1 file changed, 41 insertions(+), 4 deletions(-)

(limited to 'emacs/.emacs.d/lisp/my/my-org.el')

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
-- 
cgit v1.2.3