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/init/ycp-buffer.el | 9 ++++---- emacs/.emacs.d/init/ycp-gnus.el | 6 +++-- emacs/.emacs.d/init/ycp-markup.el | 2 +- emacs/.emacs.d/init/ycp-org.el | 7 +++++- emacs/.emacs.d/init/ycp-prog.el | 2 +- emacs/.emacs.d/init/ycp-web.el | 2 ++ 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 +++++++++++++++------ 10 files changed, 120 insertions(+), 20 deletions(-) (limited to 'emacs/.emacs.d') 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: ;; . 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