From 1622ac38772868d101e48107591db8f4700627c4 Mon Sep 17 00:00:00 2001 From: Yuchen Pei 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-buffer.el | 10 +++++++++ emacs/.emacs.d/lisp/my/my-gnus.el | 32 ++++++++++++++++++++++++++ emacs/.emacs.d/lisp/my/my-org.el | 45 +++++++++++++++++++++++++++++++++---- emacs/.emacs.d/lisp/my/my-web.el | 25 +++++++++++++++------ 4 files changed, 101 insertions(+), 11 deletions(-) (limited to 'emacs/.emacs.d/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: ;; . 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 -- cgit v1.2.3