diff options
Diffstat (limited to '.emacs.d/lisp/my/my-gnus.el')
| -rw-r--r-- | .emacs.d/lisp/my/my-gnus.el | 327 |
1 files changed, 0 insertions, 327 deletions
diff --git a/.emacs.d/lisp/my/my-gnus.el b/.emacs.d/lisp/my/my-gnus.el deleted file mode 100644 index aee03b5..0000000 --- a/.emacs.d/lisp/my/my-gnus.el +++ /dev/null @@ -1,327 +0,0 @@ -;;; 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 |