Moving things one level deeper

To ease gnu stow usage. Now we can do

stow -t ~ emacs

1 files changed, 327 insertions, 0 deletions

diff --git a/emacs/.emacs.d/lisp/my/my-gnus.el b/emacs/.emacs.d/lisp/my/my-gnus.el
new file mode 100644
index 0000000..aee03b5
--- /dev/null
+++ b/emacs/.emacs.d/lisp/my/my-gnus.el
@@ -0,0 +1,327 @@
+;;; my-gnus.el -- Email related extensions for emacs core -*- lexical-binding: t -*-
+
+;; Copyright (C) 2023 Free Software Foundation.
+
+;; Author: Yuchen Pei <id@ypei.org>
+;; Package-Requires: ((emacs "28.2"))
+
+;; This file is part of dotfiles.
+
+;; dotfiles is free software: you can redistribute it and/or modify it under
+;; the terms of the GNU Affero General Public License as published by
+;; the Free Software Foundation, either version 3 of the License, or
+;; (at your option) any later version.
+
+;; dotfiles is distributed in the hope that it will be useful, but WITHOUT
+;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY
+;; or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU Affero General
+;; Public License for more details.
+
+;; You should have received a copy of the GNU Affero General Public
+;; License along with dotfiles.  If not, see <https://www.gnu.org/licenses/>.
+
+;;; Commentary:
+
+;; Email related extensions for emacs core. Covers gnus, message mode etc.
+
+;;; Code:
+
+
+
+(defun my-gnus-summary-exit-like-mu4e () (interactive)
+       (if (get-buffer-window (gnus-buffer-live-p gnus-article-buffer))
+	         (gnus-summary-expand-window)
+	       (gnus-summary-exit)))
+
+(defun my-gnus-summary-next-article-like-mu4e () (interactive)
+       (if (get-buffer-window (gnus-buffer-live-p gnus-article-buffer))
+	         (gnus-summary-next-article)
+	       (next-line)))
+(defun my-gnus-summary-prev-article-like-mu4e () (interactive)
+       (if (get-buffer-window (gnus-buffer-live-p gnus-article-buffer))
+	         (gnus-summary-prev-article)
+	       (previous-line)))
+
+(defun my-gnus-topic-select-group (arg)
+  (interactive "P")
+  (if arg (gnus-topic-select-group t)
+    (gnus-topic-select-group 200)))
+
+(defun my-gnus-move-article-like-mu4e ()
+  (interactive)
+  (call-interactively 'gnus-summary-move-article)
+  (my-gnus-summary-next-article-like-mu4e))
+
+(defvar my-gnus-group-default-targets
+  '((archive . "Archive") (trash . "Trash")))
+
+(defvar my-gnus-group-alist `((".*" . ,my-gnus-group-default-targets))
+  "Alist of information about groups such as archive and trash
+targets. Later entries override earlier ones")
+
+(defun my-gnus-refile-article-like-mu4e (key)
+  "Refile an article and move to the next, just like in mu4e.
+
+The archiving target comes from `my-gnus-group-alist'.
+KEY is either 'archive or 'trash."
+  (interactive)
+  (let ((target
+         (alist-get key my-gnus-group-default-targets))
+        (new-group-name))
+    (pcase-dolist (`(,re . ,info) my-gnus-group-alist)
+	    (when (and (string-match re gnus-newsgroup-name)
+                 (alist-get key info))
+        (setq target (alist-get key info))))
+    (setq new-group-name
+	        (replace-regexp-in-string
+           "/.*"
+           (concat "/" target)
+           gnus-newsgroup-name))
+    (gnus-summary-move-article 1 new-group-name)
+    (my-gnus-summary-next-article-like-mu4e)))
+
+(defun my-gnus-archive-article-like-mu4e ()
+  "Archive an article and move to the next, just like in mu4e.
+
+The archiving target comes from `my-gnus-group-alist'."
+  (interactive)
+  (my-gnus-refile-article-like-mu4e 'archive))
+
+(defun my-gnus-trash-article-like-mu4e ()
+  (interactive)
+  (my-gnus-refile-article-like-mu4e 'trash))
+
+(defun my-org-open-gnus-link (link)
+	(my-select-new-window-matching-mode 'gnus-summary-mode)
+	(org-gnus-open link t))
+
+(defvar my-gnus-inbox-group nil
+  "The default inbox to be opened with `my-gnus-open-inbox'.")
+(defun my-gnus-open-inbox ()
+  (interactive)
+  (gnus-group-read-group t nil my-gnus-inbox-group))
+
+(defun my-gnus-start ()
+	(interactive)
+	(let ((buffer (get-buffer "*Group*")))
+		(if buffer 
+			  (switch-to-buffer "*Group*")
+		  (gnus))))
+
+(defun my-gnus-topic-up ()
+  (interactive)
+  (gnus-topic-jump-to-topic (gnus-current-topic)))
+
+(defun my-gnus-group-compose ()
+  (interactive) (gnus-group-mail '(4)))
+
+(defun my-gnus-group-get-new-news-quietly ()
+  (interactive)
+  (let ((inhibit-message t))
+    (gnus-group-get-new-news)))
+
+
+;; override `mm-display-external'
+;; Removed the following nonsensical part
+;; 			  ;; So that we pop back to the right place, sort of.
+;;			  (switch-to-buffer gnus-summary-buffer)
+(defun my-mm-display-external (handle method)
+  "Display HANDLE using METHOD."
+  (let ((outbuf (current-buffer)))
+    (mm-with-unibyte-buffer
+      (if (functionp method)
+	        (let ((cur (current-buffer)))
+	          (if (eq method 'mailcap-save-binary-file)
+		            (progn
+		              (set-buffer (generate-new-buffer " *mm*"))
+		              (setq method nil))
+	            (mm-insert-part handle)
+	            (mm-add-meta-html-tag handle)
+	            (let ((win (get-buffer-window cur t)))
+		            (when win
+		              (select-window win)))
+	            (switch-to-buffer (generate-new-buffer " *mm*")))
+	          (buffer-disable-undo)
+	          (set-buffer-file-coding-system mm-binary-coding-system)
+	          (insert-buffer-substring cur)
+	          (goto-char (point-min))
+	          (when method
+	            (message "Viewing with %s" method))
+	          (let ((mm (current-buffer))
+		              (attachment-filename (mm-handle-filename handle))
+		              (non-viewer (assq 'non-viewer
+				                            (mailcap-mime-info
+				                             (mm-handle-media-type handle) t))))
+	            (unwind-protect
+		              (if method
+		                  (progn
+			                  (when (and (boundp 'gnus-summary-buffer)
+                                   (buffer-live-p gnus-summary-buffer))
+			                    (when attachment-filename
+			                      (with-current-buffer mm
+			                        (rename-buffer
+			                         (format "*mm* %s" attachment-filename) t)))
+			                    ;; ;; So that we pop back to the right place, sort of.
+			                    ;; (switch-to-buffer gnus-summary-buffer)
+			                    (switch-to-buffer mm))
+			                  (funcall method))
+		                (mm-save-part handle))
+		            (when (and (not non-viewer)
+			                     method)
+		              (mm-handle-set-undisplayer handle mm)))))
+	      ;; The function is a string to be executed.
+	      (mm-insert-part handle)
+	      (mm-add-meta-html-tag handle)
+	      ;; We create a private sub-directory where we store our files.
+	      (let* ((dir (with-file-modes #o700
+		                  (make-temp-file
+		                   (expand-file-name "emm." mm-tmp-directory) 'dir)))
+	             (filename (or
+			                    (mail-content-type-get
+			                     (mm-handle-disposition handle) 'filename)
+			                    (mail-content-type-get
+			                     (mm-handle-type handle) 'name)))
+	             (mime-info (mailcap-mime-info
+			                     (mm-handle-media-type handle) t))
+	             (needsterm (or (assoc "needsterm" mime-info)
+			                        (assoc "needsterminal" mime-info)))
+	             (copiousoutput (assoc "copiousoutput" mime-info))
+	             file buffer)
+	        (if filename
+	            (setq file (expand-file-name
+			                    (gnus-map-function mm-file-name-rewrite-functions
+					                                   (file-name-nondirectory filename))
+			                    dir))
+	          ;; Use nametemplate (defined in RFC1524) if it is specified
+	          ;; in mailcap.
+	          (let ((suffix (cdr (assoc "nametemplate" mime-info))))
+	            (if (and suffix
+		                   (string-match "\\`%s\\(\\..+\\)\\'" suffix))
+		              (setq suffix (match-string 1 suffix))
+		            ;; Otherwise, use a suffix according to
+		            ;; `mailcap-mime-extensions'.
+		            (setq suffix (car (rassoc (mm-handle-media-type handle)
+					                                mailcap-mime-extensions))))
+	            (setq file (with-file-modes #o600
+			                     (make-temp-file (expand-file-name "mm." dir)
+					                                 nil suffix)))))
+	        (let ((coding-system-for-write mm-binary-coding-system))
+	          (write-region (point-min) (point-max) file nil 'nomesg))
+	        ;; The file is deleted after the viewer exists.  If the users edits
+	        ;; the file, changes will be lost.  Set file to read-only to make it
+	        ;; clear.
+	        (set-file-modes file #o400 'nofollow)
+	        (message "Viewing with %s" method)
+	        (cond
+	         (needsterm
+	          (let ((command (mm-mailcap-command
+			                      method file (mm-handle-type handle))))
+	            (unwind-protect
+		              (if window-system
+		                  (set-process-sentinel
+		                   (start-process "*display*" nil
+				                              mm-external-terminal-program
+				                              "-e" shell-file-name
+				                              shell-command-switch command)
+		                   (lambda (process _state)
+			                   (if (eq 'exit (process-status process))
+			                       (run-at-time
+			                        60.0 nil
+			                        (lambda ()
+				                        (ignore-errors (delete-file file))
+				                        (ignore-errors (delete-directory
+						                                    (file-name-directory
+						                                     file))))))))
+		                (require 'term)
+		                (require 'gnus-win)
+		                (set-buffer
+		                 (setq buffer
+			                     (make-term "display"
+				                              shell-file-name
+				                              nil
+				                              shell-command-switch command)))
+		                (term-mode)
+		                (term-char-mode)
+		                (set-process-sentinel
+		                 (get-buffer-process buffer)
+                     (let ((wc gnus-current-window-configuration))
+		                   (lambda (process _state)
+			                   (when (eq 'exit (process-status process))
+			                     (ignore-errors (delete-file file))
+			                     (ignore-errors
+			                       (delete-directory (file-name-directory file)))
+			                     (gnus-configure-windows wc)))))
+		                (gnus-configure-windows 'display-term))
+		            (mm-handle-set-external-undisplayer handle (cons file buffer))
+		            (add-to-list 'mm-temp-files-to-be-deleted file t))
+	            (message "Displaying %s..." command))
+	          'external)
+	         (copiousoutput
+	          (with-current-buffer outbuf
+	            (forward-line 1)
+	            (mm-insert-inline
+	             handle
+	             (unwind-protect
+		               (progn
+		                 (call-process shell-file-name nil
+				                           (setq buffer
+					                               (generate-new-buffer " *mm*"))
+				                           nil
+				                           shell-command-switch
+				                           (mm-mailcap-command
+				                            method file (mm-handle-type handle)))
+		                 (if (buffer-live-p buffer)
+			                   (with-current-buffer buffer
+			                     (buffer-string))))
+		             (progn
+		               (ignore-errors (delete-file file))
+		               (ignore-errors (delete-directory
+				                           (file-name-directory file)))
+		               (ignore-errors (kill-buffer buffer))))))
+	          'inline)
+	         (t
+	          ;; Deleting the temp file should be postponed for some wrappers,
+	          ;; shell scripts, and so on, which might exit right after having
+	          ;; started a viewer command as a background job.
+	          (let ((command (mm-mailcap-command
+			                      method file (mm-handle-type handle))))
+	            (unwind-protect
+		              (let ((process-connection-type nil))
+		                (start-process "*display*"
+				                           (setq buffer
+					                               (generate-new-buffer " *mm*"))
+				                           shell-file-name
+				                           shell-command-switch command)
+		                (set-process-sentinel
+		                 (get-buffer-process buffer)
+		                 (lambda (process _state)
+		                   (when (eq (process-status process) 'exit)
+			                   (run-at-time
+			                    60.0 nil
+			                    (lambda ()
+			                      (ignore-errors (delete-file file))
+			                      (ignore-errors (delete-directory
+					                                  (file-name-directory file)))))
+			                   (when (buffer-live-p outbuf)
+			                     (with-current-buffer outbuf
+			                       (let ((buffer-read-only nil)
+				                           (point (point)))
+			                         (forward-line 2)
+			                         (let ((start (point)))
+				                         (mm-insert-inline
+				                          handle (with-current-buffer buffer
+					                                 (buffer-string)))
+				                         (put-text-property start (point)
+						                                        'face 'mm-command-output))
+			                         (goto-char point))))
+			                   (when (buffer-live-p buffer)
+			                     (kill-buffer buffer)))
+		                   (message "Displaying %s...done" command))))
+		            (mm-handle-set-external-undisplayer
+		             handle (cons file buffer))
+		            (add-to-list 'mm-temp-files-to-be-deleted file t))
+	            (message "Displaying %s..." command))
+	          'external)))))))
+
+(provide 'my-gnus)
+;;; my-gnus.el ends here