;;; -*- lexical-binding: t -*-
;;
;; --------------------------------------------------------------------------------

(require 'luki-lisp)

;; --------------------------------------------------------------------------------

(-> 'message)
(-> 'message-header)

;; --------------------------------------------------------------------------------

(add-to-list 'message-syntax-checks '(long-lines . disabled))
(setq mml-content-disposition-alist '((t . "attachment")))
(setq message-auto-save-directory nil)

;; --------------------------------------------------------------------------------

(setq message-kill-buffer-on-exit t)
(setq message-kill-buffer-query nil)

;; --------------------------------------------------------------------------------

(let* ((title  "underground experts united")
       (url-ds "http://dataswamp.org/~incal")
       (signature (@f "%s\n%s" title url-ds)))
  (setq message-signature signature))

;; --------------------------------------------------------------------------------

(defun goto-replied-to-message () (i)
  (when (bufferp message-reply-buffer)
    (switch-to-buffer message-reply-buffer)))

;; --------------------------------------------------------------------------------

(defun message-cite-region (beg end &optional levels)
  (interactive "*r\np")
  (or levels (setq levels 1))
  (goto-char beg)
  (beginning-of-line)
  (let* ((fst (line-number-at-pos))
         (lst (line-number-at-pos end))
         (n (- lst fst -1)))
    (cl-loop repeat n do
      (when (looking-at ">+ \\{0,1\\}")
        (delete-region (match-beginning 0) (match-end 0)))
      (when (< 0 levels)
        (insert-char ?> levels)
        (insert-char ?\s)) ; repair ugly >quotes as well
      (forward-line))
    (goto-beg)
    (forward-line (1- lst))
    (end-of-line)))

;; --------------------------------------------------------------------------------

(defun message-send-hook-f ()
  (remove-empty-headers))

(add-hook 'message-send-hook #'message-send-hook-f)

;; --------------------------------------------------------------------------------

(defun message-save-draft () (i)
  (let ((before-save-hook '(untab-all
                            (L () (delete-trailing-whitespace (get-header-separator-pos))))))
    (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 () (i)
  (let ((beg (point))
        (end (progn (message-beginning-of-line) (point))))
    (when (= beg end)
      (forward-line 0))))

;; --------------------------------------------------------------------------------

(defun message-mode-keys ()
  (let ((kmap message-mode-map))
    (keymap-set kmap "C-a"     #'message-bol)
    (keymap-set kmap "C-c a"   #'goto-replied-to-message)
    (keymap-set kmap "C-x C-s" #'message-save-draft)
    (keymap-set kmap "M-;"     #'message-cite-region)
    (keymap-set kmap "M-n"     #'message-yank-subject)))

(message-mode-keys)

;; --------------------------------------------------------------------------------

(<- 'message-incal)