;;; -*- lexical-binding: t -*- ;; ;; this file: ;; https://dataswamp.org/~incal/emacs-init/gnus/message-incal.el (require 'edit) (require 'fill-incal) (require 'message) (require 'moggle) (require 'super) (add-to-list 'message-syntax-checks '(long-lines . disabled)) (setq mml-content-disposition-alist '((t . "attachment"))) ;; kill buffer (setq message-kill-buffer-query nil) (setq message-kill-buffer-on-exit t) ;;; signature (let*((title "underground experts united") (url-ds "https://dataswamp.org/~incal") (signature (format "%s\n%s" title url-ds)) ) (setq message-signature signature) ) ;; headers (setq mail-header-separator "---") (setq message-default-headers "Mail-Copies-To: never") (setq message-default-mail-headers "Newsgroups: ") (setq message-default-news-headers "To: ") (setq message-dont-reply-to-names user-mail-address) (setq message-subject-trailing-was-query nil) (setq message-hidden-headers '("^Face" ;; "^From" "^Mail-Copies-To" "^References" "^X-Draft-From" "^X-Face") ) (defun remove-empty-headers () (interactive) (flush-lines "^.+: $" (point-min) (get-header-separator-pos)) ) (defun message-yank-subject () (interactive) (save-excursion (let ((subj (message-fetch-field "Subject"))) (when subj (message-goto-body) (insert (format "%s\n" subj)) )))) (defun message-transpose-headers (hdr1 hdr2) (interactive "sheader 1: \nsheader 2: ") (save-excursion (let ((v1 (or (message-fetch-field hdr1) "")) (v2 (or (message-fetch-field hdr2) "")) ) (message-replace-header hdr1 v2 hdr1 t) (message-replace-header hdr2 v1 hdr2 t)) )) ;; test: ;; (message-transpose-headers "To" "Subject") ;;; goto (defun goto-replied-to-message () (interactive) (when (bufferp message-reply-buffer) (switch-to-buffer message-reply-buffer) )) ;;; citation (defun message-cite-region (beg end &optional levels) (interactive "*r\np") (goto-char beg) (beginning-of-line) (let*((lvl (or levels 1)) (fst (line-number-at-pos)) (lst (line-number-at-pos end)) (n (1+ (- lst fst))) ) (dotimes (_ n) (when (looking-at ">+ \\{0,1\\}") (delete-region (match-beginning 0) (match-end 0)) ) (when (> lvl 0) (insert-char ?> lvl) (insert-char ?\s) ) ; repair ugly >quotes as well (forward-line) ) (goto-char (point-min)) (forward-line (1- lst)) (end-of-line) )) ;; (setq message-send-hook nil) (defun message-send-hook-f () (remove-empty-headers) ) (add-hook 'message-send-hook #'message-send-hook-f) (defun message-save-draft () (interactive) (let ((before-save-hook '(untab-all (lambda () (delete-trailing-whitespace (get-header-separator-pos) nil) )))) (save-buffer) )) ;; works here but not in `gnus-article-mode' ;; regexp from gnus-art.el line 7878, Emacs 29.0 Gnus 5.13 (font-lock-add-keywords 'message-mode '( ("['`‘]\\([a-z][a-z0-9]+-[a-z]+\\)['’]" (1 font-lock-reference-face)) ) t) (defun message-bol () (interactive) (let ((beg (point)) (end (progn (message-beginning-of-line) (point))) ) (when (= beg end) (forward-line 0) ))) (let ((kmap message-mode-map)) (disable-super-global-keys kmap) (define-key kmap "\C-a" #'message-bol) (define-key kmap "\C-ca" #'goto-replied-to-message) (define-key kmap "\C-x\C-s" #'message-save-draft) (define-key kmap "\M-;" #'message-cite-region) (define-key kmap "\M-n" #'message-yank-subject) ) (provide 'message-incal)