;;; -*- lexical-binding: t -*-
;;
;; this file:
;;   https://dataswamp.org/~incal/emacs-init/gnus/article.el

(require 'close)
(require 'gnus)
(require 'gnus-art)
(require 'gnus-cite)
(require 'gnus-msg)
(require 'mode-line)
(require 'scroll)
(require 'super)
(require 'w3m-bookmark-more)
(require 'w3m-download)

(setq gnus-article-mode-line-format "%S")
(setq gnus-single-article-buffer t)

;; hide

(setq gnus-treat-fold-headers t)
(setq gnus-treat-hide-signature t)

;; citation

(setq gnus-treat-hide-citation t)

(defun citation-style-f ()
  (let*((from      (mail-header-from message-reply-headers))
        (from-data (gnus-extract-address-components from))
        (name      (or (car from-data)
                       ;; if the user hasn't set his name, use the
                       ;; e-mail username (i.e., joe for joe@hacker.com)
                       (car (split-string (cadr from-data) "@"))))
        (citation-string (format "%s wrote:\n\n" name)) )
    (insert citation-string) ))
(setq message-citation-line-function #'citation-style-f)

(defun point-in-citation-p ()
  (= ?\> (char-after (line-beginning-position)) ))

(defun gnus-article-show-filled-citation ()
  (interactive)
  (let*((pos (point))
        (btn (get-char-property pos 'button)) )
    (when btn
      (widget-button-press pos)
      (save-excursion
        (gnus-article-fill-cited-article) ))))

;; save

(setq gnus-default-article-saver #'gnus-summary-save-in-file)

(defun gnus-article-cat-message ()
  (interactive)
  (gnus-summary-pipe-message "cat") )

;; reply

(defun gnus-article-reply-dwim ()
  "I have forgot the purpose of this."
  (interactive)
  (if (gnus-article-header-value "X-Mailing-List")
      (gnus-summary-reply-to-list-with-original 0)
    (gnus-article-followup-with-original) ))

;; header

(setq gnus-visible-headers '(
                             "^Bcc:"
                             "^Cc:"
                             "^Date:"
                             "^From:"
                             "^Subject:"
                             "^To:"
                             ))

(defun gnus-article-header-value (header)
  "Get the value of HEADER for the current article."
  (with-current-buffer gnus-original-article-buffer
    (gnus-fetch-field header) ))

(let ((kmap gnus-article-mode-map))
  (set-scroll-keys kmap)
  (set-close-key   kmap)

  (define-key kmap  "f" #'gnus-article-fill-cited-article)

  ;; save
  (define-key kmap  "a" #'gnus-summary-save-parts)
  (define-key kmap  "p" #'gnus-article-cat-message)

  ;; w3m
  (define-key kmap  "d" #'w3m-dl-dwim)
  (define-key kmap  "L" #'w3m-bookmark-dwim)

  ;; reply/followup
  (define-key kmap  "r" #'gnus-article-followup-with-original)
  (define-key kmap  "R" #'gnus-article-reply-with-original)

  ;; respool
  (define-key kmap  "Q" #'gnus-summary-respool-article)
  (define-key kmap  "q" #'gnus-summary-respool-query) )

;; mime button

(let ((kmap gnus-mime-button-map))
  (set-scroll-keys kmap)
  (set-close-key   kmap)
  (define-key kmap "\C-o" nil)
  (define-key kmap "d" #'gnus-mime-save-part) )

;; wash

(defun gnus-article-wash-more ()
  (article-translate-strings
   '(
     ("#+begin_quote\n"          "")
     ("#+end_quote\n"            "")
     ("#+begin_src emacs-lisp\n" "")
     ("#+begin_src r\n"          "")
     ("#+end_src\n"              "")
     ("--8<---------------cut"                     "")
     ("here---------------end--------------->8---" "")
     ("here---------------start------------->8---" "")
     ("Sendt fra min iPad"                         "")
     ("Sent using Zoho Mail"                       "")
     ("Skickades från E-post för Windows 10"       "")
     ("Skickat från Yahoo Mail för iPhone"         "")
     ("naïve" "naive")
     ("ʼ" "'")
     ("⇒" "→")
     ("➜" "→")
     ("⟦" "[")
     ("⟧" "]")
     ("> > > >" ">>>>")
     ("> > >"   ">>>")
     ("> >"     ">>")
     ("colour"  "color")
     ("⛔" "!")
     ("　" " ")
     ("・" "·")
     ("I’m" "I'm")
     ("doesn’t" "doesn't")
     ))
  (gnus-article-strip-multiple-blank-lines) )

(defun gnus-article-mode-hook-f ()
  (lines) )
(add-hook 'gnus-article-mode-hook #'gnus-article-mode-hook-f)

(defun gnus-article-prepare-hook-f ()
  (gnus-with-article-buffer
    (gnus-article-wash-more) ))
(add-hook 'gnus-article-prepare-hook #'gnus-article-prepare-hook-f)

(provide 'article)