;;; -*- lexical-binding: t -*-
;;;
;;; this file:
;;;   http://user.it.uu.se/~embe8573/emacs-init/gnus/message-my.el
;;;   https://dataswamp.org/~incal/emacs-init/gnus/message-my.el

(require 'edit)
(require 'fill-new)
(require 'message)
(require 'message-my-dynamic)
(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-uu    "http://user.it.uu.se/~embe8573")
      (url-ds    "https://dataswamp.org/~incal")
      (signature (format "%s\n%s\n%s" title url-uu url-ds)) )
  (setq message-signature signature) )

;;; headers

(setq mail-header-separator "---")
(setq message-subject-trailing-was-query nil)
(setq message-default-headers "Mail-Copies-To: never")
(setq message-default-news-headers "To: ")
(setq message-default-mail-headers "Newsgroups: ")

(setq message-hidden-headers
      '(
        "Face"
        "From"
        "Mail-Copies-To"
        "References"
        "X-Draft-From"
        "X-Face"
        ))
(setq message-dont-reply-to-names user-mail-address)

(defun remove-empty-headers ()
  (interactive)
  (let ((header-start (point-min))
        (header-end   (get-header-separator-pos)) )
    (goto-char header-start)
    (while (re-search-forward ".+: \n" header-end t) ; NOERROR
      (replace-match "") )))

;;; 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*((first-line (line-number-at-pos))
        (last-line  (line-number-at-pos end))
        (num-lines  (1+ (- last-line first-line))) )
    (dotimes (_ num-lines)
      (while (looking-at ">") (delete-char 1))
      (when  (looking-at " ") (delete-char 1))
      (when (> levels 0)
        (insert-char ?> levels)
        (insert-char ?\s) ) ; this repairs ugly >quotes as well
      (forward-line 1) )
    (goto-char (point-min))
    (forward-line (1- last-line))
    (end-of-line)
    (when (region-active-p) (keyboard-quit)) ))

;; (setq message-send-hook nil)
(defun message-send-hook-f ()
  (remove-empty-headers) )
(setq message-send-hook #'message-send-hook-f)

;;; save draft

(defun message-save-draft ()
  (interactive)
  (let ((before-save-hook '(untab-all
                            (lambda ()
                              (delete-trailing-whitespace
                               (get-header-separator-pos)
                               nil) ))))
    (save-buffer) ))

(let ((the-map message-mode-map))
  ;; misc
  (define-key the-map "\C-c\C-c" #'message-send-and-exit-current)
  (define-key the-map "\C-ca"    #'goto-replied-to-message)
  (define-key the-map "\C-x\C-s" #'message-save-draft)
  (define-key the-map "\M-;"     #'message-cite-region)
  (define-key the-map "\M-n"     #'yank-subject)
  ;; headers
  (define-key the-map "\t"       #'next-header)
  (define-key the-map [backtab]  #'prev-header)
  )
(disable-super-global-keys message-mode-map)

(provide 'message-my)