;;; -*- 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)