(require 'buc)
(require 'super)
(require 'scroll)
(require 'close)
(require 'gnus)
(require 'gnus-art)
(require 'gnus-cite)
(require 'gnus-msg)
(require 'dl)
(require 'bookmarks)

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

(defun switch-to-article-buffer ()
  (interactive)
  (let ((buffer "*Article*"))
    (if (member buffer (buffer-names)) (switch-to-buffer buffer)
      (message "No article buffer.") )))

(defun gnus-article-reply-dwim ()
  (interactive)
  (if (gnus-article-header-value "X-Mailing-List")
      (gnus-summary-reply-to-list-with-original 0)
    (gnus-article-followup-with-original) ))

(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) ))

(defun gnus-article-url ()
  "Get the URL where the article is archived, if on Gmane."
  (interactive)
  (let*((id-header (gnus-article-header-value "Message-ID"))
        (id        (gnus-replace-in-string id-header "^<\\|>$" ""))
        (url       (format "http://mid.gmane.org/%s" id)) )
    (kill-new url)
    (message " Killed %s" url) ))

;; misc
(setq gnus-article-mode-line-format "%S")
(setq gnus-visible-headers '("^Date:"))

;; quote / cite
(defun point-in-quotation-p ()
  (= ?\> (char-after (point-at-bol)) ))
(setq gnus-treat-hide-citation t)

(defun gnus-article-fill-cited-article-keep-point ()
  "Fill the article, then restore point."
  (interactive)
  (save-excursion (gnus-article-fill-cited-article)) )

(defun gnus-article-show-filled-quote ()
  "Fill the quote opened on a hidden-quote-button-press."
  (interactive)
  (let*((pos    (point))
        (button (get-char-property pos 'button)) )
    (when button
      (widget-button-press pos)
      (gnus-article-fill-cited-article-keep-point) )))

(defun replace-strings (tuple-list)
  (when tuple-list
      (let*((tuple          (car  tuple-list))
            (rest           (cdr  tuple-list))
            (replace-match  (car  tuple))
            (replace-string (cadr tuple)) )
        (goto-char (point-min))
        (while (re-search-forward replace-match (point-max) t) ; NOERROR
          (replace-match replace-string) )
        (replace-strings rest) )))

(defun gnus-article-wash-more ()
  "Perform additional article washing."
  (interactive)
   (article-translate-strings
    '(
      ("Skickades från E-post för Windows 10"       "")
      ("Sendt fra min iPad"                         "")
      ("Skickat från Yahoo Mail för iPhone"         "")
      ("--8<---------------cut"                     "")
      ("here---------------start------------->8---" "")
      ("here---------------end--------------->8---" "")
      ))
   (gnus-article-strip-multiple-blank-lines) )

(setq gnus-single-article-buffer t)

(let ((the-map gnus-article-mode-map))
  (set-scroll-keys the-map)
  (set-close-key   the-map)
  (define-key the-map  "a"     #'gnus-summary-save-parts)
  (define-key the-map  "d"     #'w3m-dl-dwim)
  (define-key the-map  "l"  #'w3m-bookmark-dwim)
  (define-key the-map  "L"  #'w3m-bookmark-dwim)
  (define-key the-map  "p"  #'gnus-article-cat-message)
  (define-key the-map  "r"  #'gnus-article-followup-with-original)
  (define-key the-map  "R"  #'gnus-article-reply-dwim)
  (define-key the-map  "s"  #'gnus-article-wash-more)
  (define-key the-map "\r"  #'gnus-article-show-filled-quote)
  )

(define-key gnus-article-edit-mode-map "\C-x\C-s" #'gnus-article-edit-done)

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

;; (setq gnus-article-prepare-hook nil)
(defun gnus-article-prepare-hook-f ()
  (gnus-with-article-buffer
    (gnus-article-wash-more) )
  (gnus-article-hide-signature nil 1)
  (gnus-article-fill-cited-article) )
(add-hook 'gnus-article-prepare-hook #'gnus-article-prepare-hook-f)

(provide 'article)