;;; nnhackernews.el --- Gnus backend for Hacker News  -*- lexical-binding: t; coding: utf-8 -*-

;; Copyright (C) 2019 The Authors of nnhackernews.el

;; Authors: dickmao <github id: dickmao>
;; Package-Version: 20260630.1255
;; Package-Revision: 0cb7ff0a86c9
;; Keywords: news
;; URL: https://github.com/dickmao/nnhackernews
;; Package-Requires: ((emacs "25.2") (request "0.3.3") (dash "2.18.1") (anaphora "1.0.4"))

;; This file is NOT part of GNU Emacs.

;; This program is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; This program is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with nnhackernews.el.  If not, see <https://www.gnu.org/licenses/>.

;;; Commentary:

;; A Gnus backend for Hacker News.

;;; Code:

(eval-when-compile (require 'cl-lib)
                   (cl-assert (fboundp 'libxml-parse-html-region) nil
                              "nnhackernews requires emacs built with libxml support"))

(require 'nnoo)
(require 'gnus)
(require 'gnus-start)
(require 'gnus-art)
(require 'gnus-sum)
(require 'gnus-msg)
(require 'gnus-cite)
(require 'gnus-srvr)
(require 'gnus-cache)
(require 'gnus-bcklg)
(require 'gnus-score)
(require 'mm-url)
(require 'cl-lib)
(require 'json)
(require 'subr-x)
(require 'request)
(require 'dash)
(require 'anaphora)
(require 'url-http)

(nnoo-declare nnhackernews)

(defconst nnhackernews-hacker-news-url "https://news.ycombinator.com")
(defconst nnhackernews--group-ask "ask")
(defconst nnhackernews--group-show "show")
(defconst nnhackernews--group-job "job")
(defconst nnhackernews--group-stories "news")

(defgroup nnhackernews nil "A Gnus backend for Hacker News."
  :group 'gnus)

(defcustom nnhackernews-render-story t
  "If non-nil, follow link upon `gnus-summary-select-article'.

Otherwise, just display link."
  :type 'boolean
  :group 'nnhackernews)

(defcustom nnhackernews-localhost "127.0.0.1"
  "Some users keep their browser in a separate domain.

Do not set this to \"localhost\" as a numeric IP is required for the oauth
handshake."
  :type 'string
  :group 'nnhackernews)

(defcustom nnhackernews-purge-threshold 30000
  "When number of headers exceeds this, call `nnhackernews-purge'."
  :type 'integer
  :group 'nnhackernews)

(defcustom nnhackernews-max-items-per-scan 100
  "Maximum items to fetch from firebase each refresh cycle."
  :type 'integer
  :group 'nnhackernews)

(defcustom nnhackernews-refractory-ms 2200
  "In June 2021, hackernews started throttling responses."
  :type 'integer
  :group 'nnhackernews)

(defcustom nnhackernews-max-render-bytes 300e3
  "`quoted-printable-encode-region' bogs when javascript spyware overdoes it."
  :type 'integer
  :group 'nnhackernews)

(defvoo nnhackernews-status-string "")

(defvar nnhackernews-avoid-rescoring nil
  "This semaphore avoids unnecessary scoring.
The unnecessary run results from `nndraft-update-unread-articles'
calling `gnus-group-get-new-news-this-group'.")

(defvar nnhackernews--mutex-display-article
  (when (fboundp 'make-mutex)
    (make-mutex "nnhackernews--mutex-display-article"))
  "Scoring in `gnus-after-getting-new-news-hook' emits 'Selecting deleted buffer'.")

(defvar nnhackernews--last-item nil "Keep track of where we are.")

(defvar nnhackernews--debug-request-items nil "Keep track of ids to re-request for testing.")

(defvar nnhackernews--last-scan-time (- (truncate (float-time)) 100)
  "Don't scan more than once every few seconds.")

(defmacro nnhackernews--callback (result &optional callback)
  "Set RESULT to return value of CALLBACK."
  `(cl-function (lambda (&rest args &key data &allow-other-keys)
                  (setq ,result (if ,callback
                                    (apply ,callback args)
                                  data)))))

(defun nnhackernews-alist-get (key alist &optional default remove testfn)
  "Replicated library function for emacs-25.

Same argument meanings for KEY ALIST DEFAULT REMOVE and TESTFN."
  (ignore remove)
  (let ((x (if (not testfn)
               (assq key alist)
             (assoc key alist))))
    (if x (cdr x) default)))

(gv-define-expander nnhackernews-alist-get
  (lambda (do key alist &optional default remove testfn)
    (macroexp-let2 macroexp-copyable-p k key
      (gv-letplace (getter setter) alist
        (macroexp-let2 nil p `(if (and ,testfn (not (eq ,testfn 'eq)))
                                  (assoc ,k ,getter)
                                (assq ,k ,getter))
          (funcall do (if (null default) `(cdr ,p)
                        `(if ,p (cdr ,p) ,default))
                   (lambda (v)
                     (macroexp-let2 nil v v
                       (let ((set-exp
                              `(if ,p (setcdr ,p ,v)
                                 ,(funcall setter
                                           `(cons (setq ,p (cons ,k ,v))
                                                  ,getter)))))
                         `(progn
                            ,(cond
                             ((null remove) set-exp)
                             ((or (eql v default)
                                  (and (eq (car-safe v) 'quote)
                                       (eq (car-safe default) 'quote)
                                       (eql (cadr v) (cadr default))))
                              `(if ,p ,(funcall setter `(delq ,p ,getter))))
                             (t
                              `(cond
                                ((not (eql ,default ,v)) ,set-exp)
                                (,p ,(funcall setter
                                              `(delq ,p ,getter))))))
                            ,v))))))))))

(defsubst nnhackernews--gethash (string hashtable &optional dflt)
  "Get corresponding value of STRING from HASHTABLE, or DFLT if undefined.

Starting in emacs-src commit c1b63af, Gnus moved from obarrays to
normal hashtables."
  (if (fboundp 'gnus-gethash)
      (let ((sym (intern-soft string hashtable)))
        (if (or (null sym) (not (boundp sym))) dflt (symbol-value sym)))
    (gethash string hashtable dflt)))

(defsubst nnhackernews--replace-hash (string func hashtable)
  "Set value of STRING to FUNC applied to existing STRING value in HASHTABLE.

Starting in emacs-src commit c1b63af, Gnus moved from obarrays to
normal hashtables."
  (let* ((capture (nnhackernews--gethash string hashtable))
         (replace-with (funcall func capture)))
    (if (fboundp 'gnus-sethash)
       (set (intern string hashtable) replace-with)
      (puthash string replace-with hashtable))))

(defmacro nnhackernews--remhash (string hashtable)
  "Remove STRING from HASHTABLE.

Starting in emacs-src commit c1b63af, Gnus moved from obarrays to
normal hashtables."
  `(,(if (fboundp 'gnus-sethash)
         'unintern
       'remhash)
    ,(if (fboundp 'gnus-sethash)
         (cons 'intern (list string hashtable))
       string)
     ,hashtable))

(defmacro nnhackernews--sethash (string value hashtable)
  "Set corresponding value of STRING to VALUE in HASHTABLE.

Starting in emacs-src commit c1b63af, Gnus moved from obarrays to
normal hashtables."
  `(,(if (fboundp 'gnus-sethash)
         'gnus-sethash
       'puthash)
    ,string ,value ,hashtable))

(defmacro nnhackernews--maphash (func table)
  "Map FUNC taking key and value over TABLE, return nil.

Starting in emacs-src commit c1b63af, Gnus moved from obarrays to
normal hashtables."
  (declare (indent nil))
  `(,(if (fboundp 'gnus-gethash-safe)
         'mapatoms
       'maphash)
    ,(if (fboundp 'gnus-gethash-safe)
         `(lambda (k) (funcall
                       (apply-partially
                        ,func
                        (symbol-name k) (funcall (function gnus-gethash-safe) k ,table))))
       func)
    ,table))

(defvar nnhackernews-summary-voting-map
  (let ((map (make-sparse-keymap)))
    map)
  "Voting map.")

(defvar nnhackernews-summary-mode-map
  (let ((map (make-sparse-keymap)))
    (define-key map "r" #'gnus-summary-followup)
    (define-prefix-command 'nnhackernews-summary-voting-map)
    (define-key map "R" 'nnhackernews-summary-voting-map)
    (define-key nnhackernews-summary-voting-map "0" #'nnhackernews-novote)
    (define-key nnhackernews-summary-voting-map "-" #'nnhackernews-downvote)
    (define-key nnhackernews-summary-voting-map "=" #'nnhackernews-upvote)
    (define-key nnhackernews-summary-voting-map "+" #'nnhackernews-upvote)
    map))

(defvar nnhackernews-article-mode-map
  (copy-keymap nnhackernews-summary-mode-map)) ;; how does Gnus do this?

(define-minor-mode nnhackernews-article-mode
  "Disallow `gnus-article-reply-with-original'.

\\{gnus-article-mode-map}"
  :lighter " HN"
  :keymap nnhackernews-article-mode-map)

(define-minor-mode nnhackernews-summary-mode
  "Disallow \"reply\" commands in `gnus-summary-mode-map'.

\\{nnhackernews-summary-mode-map}"
  :lighter " HN"
  :keymap nnhackernews-summary-mode-map)

(defsubst nnhackernews-novote ()
  "Retract vote."
  (interactive)
  (nnhackernews-vote-current-article 0))

(defsubst nnhackernews-downvote ()
  "Downvote the article in current buffer."
  (interactive)
  (nnhackernews-vote-current-article -1))

(defsubst nnhackernews-upvote ()
  "Upvote the article in current buffer."
  (interactive)
  (nnhackernews-vote-current-article 1))

(defvar nnhackernews--seq-map-indexed
  (if (fboundp 'seq-map-indexed)
      #'seq-map-indexed
    (lambda (function sequence)
      (let ((index 0))
        (seq-map (lambda (elt)
                   (prog1
                       (funcall function elt index)
                     (setq index (1+ index))))
                 sequence)))))

(defmacro nnhackernews--normalize-server ()
  "Disallow \"server\" from being empty string, which is unsettling.
Normalize it to \"nnhackernews-default\"."
  `(let ((canonical "nnhackernews-default"))
    (when (equal server "")
      (setq server nil))
    (unless server
      (setq server canonical))
    (unless (string= server canonical)
      (error "`nnhackernews--normalize-server': multiple servers unsupported!"))))

(defvar nnhackernews-score-files nil "For `nnhackernews--ensure-score-file'.")

(defvar nnhackernews-location-hashtb (gnus-make-hashtable)
  "Id -> ( group . index ).")

(defvar nnhackernews-root-hashtb (gnus-make-hashtable)
  "Id -> possibly ancient header.")

(defvar nnhackernews-headers-alist nil
  "Group -> headers.  This is an alist.  Hashtable mysteriously slow.")

(defvar nnhackernews-refs-hashtb (gnus-make-hashtable)
  "Who replied to whom (global over all entries).")

(defvar nnhackernews-authors-hashtb (gnus-make-hashtable)
  "For fast lookup of parent-author (global over all entries).")

(defun nnhackernews-get-headers (group)
  "List headers from GROUP."
  (cl-second (assoc group nnhackernews-headers-alist)))

(defun nnhackernews-find-header (id &optional noquery)
  "Retrieve property list of ID.

If NOQUERY, return nil and avoid querying if not extant."
  (if-let ((location (nnhackernews--gethash id nnhackernews-location-hashtb)))
      (cl-destructuring-bind (group . index) location
        (nnhackernews--get-header (1+ index) group))
    (unless noquery
      (nnhackernews--request-item id))))

(defun nnhackernews-refs-for (id)
  "Return ancestors sorted oldest to youngest as list for ID."
  (cl-loop with get-root-plst = #'ignore
           for prev-id = id then cur-id
           for cur-id =
           (let ((cached (nnhackernews--gethash prev-id
                                                nnhackernews-refs-hashtb
                                                'NULL)))
             (if (eq cached 'NULL)
                 (let ((plst (nnhackernews--request-item prev-id)))
                   (nnhackernews-add-entry nnhackernews-refs-hashtb
                                           plst :parent)
                   (setq get-root-plst (lambda () plst))
                   (plist-get plst :parent))
               (setq get-root-plst (apply-partially #'nnhackernews-find-header prev-id t))
               cached))
           until (null cur-id)
           collect cur-id into rresult
           finally return
	   (let ((result (nreverse rresult))
                 (root-plst (funcall get-root-plst)))
             (when (and result
                        (string= (plist-get root-plst :id) (car result)))
               (nnhackernews--sethash (car result) root-plst
                                      nnhackernews-root-hashtb))
             result)))

(defun nnhackernews--retrieve-root (header)
  "Retrieve and cache property list HEADER root."
  (if-let ((root-id (car (nnhackernews-refs-for (plist-get header :id)))))
      (nnhackernews--gethash root-id nnhackernews-root-hashtb)
    header))

(defun nnhackernews--group-for (header)
  "Classify HEADER as one of ask, show, or news based on title."
  (let* ((root-plst (nnhackernews--retrieve-root header))
         (title (or (plist-get header :link_title) ""))
         (type (or (plist-get root-plst :type) "")))
    ;; string-match-p like all elisp searching is case-insensitive
    (cond ((string= type "job") nnhackernews--group-job)
          ((string-match-p "^\\(Launch\\|Show\\) HN" title) nnhackernews--group-show)
          ((string-match-p "^\\(Ask\\|Tell\\) HN" title) nnhackernews--group-ask)
          (t nnhackernews--group-stories))))

(defsubst nnhackernews--get-user-cookie ()
  "Extract Hacker News login from cookies."
  (let* ((site (url-host (url-generic-parse-url nnhackernews-hacker-news-url))))
    (cdr (assoc-string
          "user"
          (cl-loop with result
                   for securep in '(t nil)
                   do (setq result
                            (request-cookie-alist site "/" securep))
                   until result
                   finally return result)))))

(defun nnhackernews--domify (html)
  "Parse HTML into dom."
  (with-temp-buffer
    (insert html)
    (if (fboundp 'libxml-parse-html-region)
        (libxml-parse-html-region (point-min) (point-max))
      (error "`nnhackernews--domify': need libxml-parse-html-region"))))

(cl-defun nnhackernews--request-login-success (&key data &allow-other-keys)
  "Validate login depending on what DATA say.

After some time, logging in via browser recaptcha might be
necessary.  Remember `string-match-p' is always case-insensitive
as is all elisp pattern matching."
  (when (and (stringp data)
             (string-match-p (regexp-quote "validation required") data))
    (display-warning
     'nnhackernews
     (concat "Recaptcha required.  Please login via browser and try again."))
    (error "Recaptcha required"))
  data)

(defun nnhackernews--request-login (url &optional hidden)
  "Store a cookie from URL with HIDDEN plist."
  (let* (result
         (auth-source-do-cache nil)
         (auth-source-save-behavior 'ask)
         (auth-source-creation-prompts '((user . "news.ycombinator.com user: ")
                                         (secret . "Password for %u: ")))
         (found (car (auth-source-search :max 1 :host "news.ycombinator.com" :require
                                         '(:user :secret) :create t))))
    (nnhackernews--request
     "nnhackernews--request-login"
     url
     :backend 'curl
     :headers `(("User-Agent" . "Mozilla/5.0 (X11; Ubuntu; Linux x86_64) AppleWebKit/537.36 (KHTML, like Gecko) Chrome/149.0.0.0 Safari/537.36")
                ("Origin" . ,nnhackernews-hacker-news-url)
                ("Referer" . ,(concat nnhackernews-hacker-news-url "/"))
                ("Accept" . "text/html,application/xhtml+xml,application/xml;q=0.9,image/avif,image/webp,image/apng,*/*;q=0.8,application/signed-exchange;v=b3;q=0.7")
                ("Accept-Language" . "en-US,en;q=0.9")
                ("sec-fetch-dest" . "document")
                ("sec-fetch-mode" . "navigate")
                ("sec-fetch-site" . "same-origin")
                ("sec-fetch-user" . "?1")
                ("upgrade-insecure-requests" . "1"))
     :data (append
            (cl-loop for (k v) on hidden by (function cddr)
                     collect (cons (cl-subseq (symbol-name k) 1) v))
            `(("acct" . ,(plist-get found :user))
              ("pw" . ,(let ((secret (plist-get found :secret)))
                         (if (functionp secret)
                             (funcall secret)
                           secret)))))
     :success (nnhackernews--callback result #'nnhackernews--request-login-success))
    result))

(defmacro nnhackernews--extract-hidden (dom hidden)
  "Extract hidden tag-value pairs from DOM into plist HIDDEN."
  `(-tree-map-nodes
    (lambda (x)
      (and (listp x)
           (eq (car x) 'input)
           (string= "hidden" (alist-get 'type (cl-second x)))
           (not (string= "creating" (alist-get 'name (cl-second x))))))
    (lambda (x)
      (let ((keyname (intern (concat ":" (alist-get 'name (cl-second x))))))
        (unless (plist-get ,hidden keyname)
          (!cons (alist-get 'value (cl-second x)) ,hidden)
          (!cons keyname ,hidden))))
    ,dom))

(cl-defun nnhackernews--request-hidden-success (&key data response &allow-other-keys)
  "Based on DATA and RESPONSE, we may need to login first.  Return :fnid and :fnop."
  (let* ((dom (nnhackernews--domify data))
         (form (car (alist-get 'form (alist-get 'body dom))))
         (url (request-response-url response))
         (path (car (url-path-and-query (url-generic-parse-url url))))
         (login-p (aif (alist-get 'action form) (cl-search it path)))
         hidden)
    (nnhackernews--extract-hidden dom hidden)
    (when login-p
      (setq dom (nnhackernews--domify (nnhackernews--request-login url hidden)))
      (nnhackernews--extract-hidden dom hidden))
    hidden))

(defun nnhackernews--request-hidden (url)
  "Get the hidden fields (e.g., FNID, FNOP, HMAC) from URL."
  (let (result)
    (nnhackernews--request
     "nnhackernews--request-hidden"
     url
     :backend 'curl
     :success (nnhackernews--callback result #'nnhackernews--request-hidden-success))
    result))

(defsubst nnhackernews--who-am-i ()
  "Get my Hacker News username."
  (let ((user-cookie (nnhackernews--get-user-cookie)))
    (unless user-cookie
      (nnhackernews--request-login (format "%s/login" nnhackernews-hacker-news-url))
      (setq user-cookie (nnhackernews--get-user-cookie)))
    (if (stringp user-cookie)
        (car (split-string user-cookie "&"))
      (gnus-message 3 "nnhackernews--who-am-i: failed to get user-cookie")
      "error")))

(defsubst nnhackernews--append-header (plst &optional group)
  "Update data structures for PLST \"header\".

If GROUP classification omitted, figure it out."
  (let ((id (plist-get plst :id))
	(group (or group (nnhackernews--group-for plst))))
    (nnhackernews--sethash id
                           (cons group (length (nnhackernews-get-headers group)))
                           nnhackernews-location-hashtb)
    (setf (nnhackernews-alist-get group nnhackernews-headers-alist nil nil #'equal)
          (list (nconc (nnhackernews-get-headers group) (list plst))))
    plst))

(nnoo-define-basics nnhackernews)

(defun nnhackernews-vote-current-article (vote)
  "VOTE is +1, -1, 0."
  (unless gnus-newsgroup-name (error "No current newgroup"))
  (if-let ((article-number (or (with-current-buffer gnus-article-buffer
                                 (cdr gnus-article-current))
                               (with-current-buffer gnus-summary-buffer
                                 (gnus-summary-article-number)))))
      (let* ((header (nnhackernews--get-header
		      article-number
                      (gnus-group-real-name gnus-newsgroup-name)))
             (orig-score (format "%s" (plist-get header :score)))
             (new-score (if (zerop vote) orig-score
                          (concat orig-score " "
                                  (if (> vote 0) "+" "")
                                  (format "%s" vote)))))
        (save-excursion
          (save-window-excursion
            (with-current-buffer gnus-summary-buffer
              (if (eq (gnus-summary-article-number) (cdr gnus-article-current))
                  (if (nnhackernews--request-vote (plist-get header :id) vote)
                      (with-current-buffer gnus-article-buffer
                        (let ((inhibit-read-only t))
                          (nnheader-replace-header "Score" new-score)))
                    (gnus-message 5 "nnhackernews-vote-current-article: failed for %s"
                                  (plist-get header :id)))
                (message "Open the article before voting."))))))
    (error "No current article")))

(defsubst nnhackernews--gate (&optional group)
  "Apply our minor modes only when the following conditions hold for GROUP."
  (unless group
    (setq group gnus-newsgroup-name))
  (and (stringp group)
       (listp (gnus-group-method group))
       (eq 'nnhackernews (car (gnus-group-method group)))))

(defsubst nnhackernews--message-gate ()
  "In `message-mode', `gnus-newsgroup-name' could be anything."
  (nnhackernews--gate (car-safe gnus-message-group-art)))

(deffoo nnhackernews-request-close ()
  (nnhackernews-close-server)
  t)

(deffoo nnhackernews-request-type (_group &optional _article)
  'news)

(deffoo nnhackernews-server-opened (&optional server)
  (nnhackernews--normalize-server)
  nnhackernews--last-item)

(deffoo nnhackernews-status-message (&optional server)
  (nnhackernews--normalize-server)
  "")

(deffoo nnhackernews-open-server (_server &optional _defs)
  t)

(deffoo nnhackernews-close-group (_group &optional server)
  (nnhackernews--normalize-server)
  t)

(defmacro nnhackernews--with-group (group &rest body)
  "Disambiguate GROUP if it's empty and execute BODY."
  (declare (debug (form &rest form))
           (indent defun))
  `(let* ((group (or ,group (gnus-group-real-name gnus-newsgroup-name)))
          (gnus-newsgroup-name (gnus-group-full-name group "nnhackernews:")))
     ,@body))

(defun nnhackernews--get-header (article-number &optional group)
  "Get header indexed ARTICLE-NUMBER for GROUP."
  (nnhackernews--with-group group
    (elt (nnhackernews-get-headers group) (1- article-number))))

(defun nnhackernews--get-body (header &optional server)
  "Get full text of submission or comment HEADER at SERVER."
  (nnhackernews--normalize-server)
  (if-let ((url (plist-get header :url)))
      (format "<div><p><a href=\"%s\">%s</a></div>" url url)
    (or (plist-get header :text)
        (plist-get (nnhackernews--request-item (plist-get header :id)) :text)
        "")))

(defun nnhackernews--massage (body)
  "Precede each quoted line of BODY broken by `shr-fill-line' with '>'."
  (with-temp-buffer
    (insert body)
    (mm-url-decode-entities)
    (cl-loop initially (goto-char (point-min))
             until (and (null (re-search-forward "\\(^>\\( .*?\\)\\)<p>" nil t))
                        (null (re-search-forward "\\(<p>\\s-*>\\( .*?\\)\\)<p>" nil t)))
             do (let* ((start (match-beginning 1))
                       (end (match-end 1))
                       (matched (match-string 2)))
                  (perform-replace
                   ".*"
                   (concat "<p>\n"
                           (with-temp-buffer
                             (insert matched)
                             (fill-region (point-min) (point-max))
                             (insert
                              (prog1
                                  (cl-subseq (replace-regexp-in-string
                                              "\n" "<br>\n> " (concat "\n" (buffer-string)))
                                             5)
                                (erase-buffer)))
                             (buffer-string))
                           "\n")
                   nil t nil nil nil start end)))
    (buffer-string)))

(defsubst nnhackernews--citation-wrap (author body)
  "Cite AUTHOR using `gnus-message-cite-prefix-regexp' before displaying BODY.

Originally written by Paul Issartel."
  (with-temp-buffer
    (insert body)
    (mm-url-remove-markup)
    (mm-url-decode-entities)
    (fill-region (point-min) (point-max))
    (let* ((trimmed-1 (replace-regexp-in-string "\\(\\s-\\|\n\\)+$" "" (buffer-string)))
           (trimmed (replace-regexp-in-string "^\\(\\s-\\|\n\\)+" "" trimmed-1)))
      (concat author " wrote:<p>\n"
              "<pre>\n"
              (cl-subseq (replace-regexp-in-string "\n" "\n> " (concat "\n" trimmed)) 1)
              "\n</pre><p>"))))

(defun nnhackernews-add-entry (hashtb e field)
  "Add to HASHTB the pair consisting of entry E's name to its FIELD."
  (nnhackernews--sethash (plist-get e :id) (plist-get e field) hashtb))

(defun nnhackernews--summary-exit (group)
  "Call `gnus-summary-exit' for GROUP without the rescoring mess."
  (remove-function (symbol-function 'gnus-summary-exit)
                   (symbol-function 'nnhackernews--score-pending))
  (unwind-protect
      (let ((summary-buffer-name (gnus-summary-buffer-name group)))
        (with-current-buffer summary-buffer-name
          (gnus-summary-exit t t)
          (gnus-kill-buffer gnus-article-buffer)
          (gnus-kill-buffer gnus-original-article-buffer))
        (gnus-kill-buffer (get-buffer summary-buffer-name)))
    (add-function :after (symbol-function 'gnus-summary-exit)
                  (symbol-function 'nnhackernews--score-pending))))

(defsubst nnhackernews--ensure-score-files (group)
  "File I/O remains a perennial problem for score files for GROUP."
  (if-let ((files (alist-get (intern group) nnhackernews-score-files)))
      (condition-case nil
        (progn
          (dolist (file files t)
            (gnus-score-load-score-alist file)))
        (error nil))
    t))

(defmacro nnhackernews--with-mutex (mtx &rest body)
  "If capable of threading, lock with MTX and execute BODY."
  (declare (indent 1))
  (if (fboundp 'with-mutex)
      `(with-mutex ,mtx ,@body)
    `(progn ,@body)))

(defun nnhackernews--daring-scoring (group)
  "Dare to score GROUP without the benefit of `gnus-summary-read-group'."
  (with-temp-buffer
    ;; Withhold judgment of setqs, mimicking `gnus-summary-setup-buffer'
    (setq gnus-newsgroup-name group) ;; now defvar-local, right?
    (set-default 'gnus-newsgroup-name gnus-newsgroup-name)
    (gnus-summary-mode)
    (gnus-update-format-specifications 'summary 'summary-mode 'summary-dummy)
    (gnus-update-summary-mark-positions)
    (gnus-summary-set-local-parameters gnus-newsgroup-name)
    (let ((gnus-single-article-buffer t))
      ;; employ a hack that messes with *Article*, not an article I'm reading
      (gnus-select-newsgroup group nil nil))
    ;; Save the active value in effect when the group was entered.
    (setq gnus-newsgroup-active
	  (copy-tree (gnus-active gnus-newsgroup-name)))
    (setq gnus-newsgroup-highest (cdr gnus-newsgroup-active))
    (gnus-run-hooks 'gnus-select-group-hook)
    (gnus-possibly-score-headers)
    (gnus-summary-prepare) ;; this actually updates unreads... can't blame a 20yo
    (gnus-run-hooks 'gnus-apply-kill-hook)
    (setq gnus-newsgroup-prepared t)
    (gnus-run-hooks 'gnus-summary-prepared-hook)
    (gnus-group-update-group group nil t)
    (gnus-score-adaptive)
    (gnus-score-save)
    (gnus-run-hooks 'gnus-exit-group-hook)
    (gnus-summary-update-info)
    (gnus-run-hooks 'gnus-summary-prepare-exit-hook)
    (gnus-close-group group)
    (gnus-run-hooks 'gnus-summary-exit-hook)
    (when (equal gnus-article-buffer (default-value 'gnus-article-buffer))
      ;; can't be killing an article I was reading!
      (gnus-kill-buffer gnus-article-buffer)
      (gnus-kill-buffer gnus-original-article-buffer))))

(defun nnhackernews--rescore (group force)
  "Unforced rescore of GROUP when merely `gnus-summary-exit'.
FORCE in wake of `gnus-after-getting-new-news-hook'."
  (when (nnhackernews--gate group)
    (cl-loop repeat 5
             for ensured = (nnhackernews--ensure-score-files group)
             until ensured
             do (sleep-for 0 300)
             finally (unless ensured
                       (gnus-message 2 "nnhackernews--rescore: Bad score files %s!"
                                     (alist-get (intern group)
                                                nnhackernews-score-files))))
    (let* ((num-headers (length (nnhackernews-get-headers
                                 (gnus-group-real-name group))))
           (marks (gnus-info-marks (gnus-get-info group)))
           (seen (or (cdr-safe (--max-by (> (or (cdr-safe it) 0) (or (cdr-safe other) 0))
                                         (alist-get 'seen marks)))
                     0)))
      (unless (zerop seen)
        (when (or force (> num-headers seen))
          (save-window-excursion
            (let (gnus-auto-select-subject
                  gnus-summary-next-group-on-exit
                  (unread (length (gnus-list-of-unread-articles group)))
                  (gnus-large-newsgroup 10000))
              (if (zerop unread)
                  (gnus-message 7 "nnhackernews--rescore: skipping %s no unread"
                                group)
		;; Q: Why `gnus-summary-read-group'?
		;; A: `gnus-score-headers' message-clone-locals `gnus-summary-buffer'
                ;; Problem: Fights with main thread UI since it calls
                ;; `gnus-configure-windows',
                (nnhackernews--with-mutex nnhackernews--mutex-display-article
                  (if (> (gnus-continuum-version) 5.13)
                      (nnhackernews--daring-scoring group)
                    (gnus-summary-read-group group nil t)
                    (nnhackernews--summary-exit group)))))))))))

(defalias 'nnhackernews--score-pending
  (lambda (&rest _args)
    (awhen (gnus-group-name-at-point)
      (nnhackernews--rescore it nil))))

(defun nnhackernews-extant-summary-buffer (group)
  "Return main thread's summary buffer for GROUP if extant."
  (let* ((args (when (and (boundp 'gnus-threaded-get-unread-articles)
                          gnus-threaded-get-unread-articles)
                 '(t)))
         (name (apply #'gnus-summary-buffer-name group args)))
    (gnus-buffer-live-p name)))

(defun nnhackernews--score-unread (group)
  "Filter unread messages for GROUP now.

Otherwise *Group* buffer annoyingly overrepresents unread."
  (when (or (gnus-native-method-p '(nnhackernews ""))
            (gnus-secondary-method-p '(nnhackernews "")))
    (nnhackernews--with-group group
      (when (and (not (nnhackernews-extant-summary-buffer gnus-newsgroup-name))
		 (not nnhackernews-avoid-rescoring))
        (nnhackernews--rescore gnus-newsgroup-name t)))))

(defun nnhackernews--mark-scored-as-read (group)
  "Reflect the scoring results now.

If root article (story) is scored in GROUP, that means we've already
read it.  This function seems redundant with `nnhackernews--score-unread'
but might be faster on startup?  See 15195cc."
  (nnhackernews--with-group group
    (let ((preface (format "nnhackernews--mark-scored-as-read: %s not rescoring " group))
          (extant (nnhackernews-extant-summary-buffer gnus-newsgroup-name))
          (unread (gnus-group-unread gnus-newsgroup-name)))
      (cond ((or (not (numberp unread)) (<= unread 0))
             (gnus-message 7 (concat preface "(unread %s)") unread))
            ((and extant (buffer-local-value 'gnus-newsgroup-prepared extant))
             ;; reflect the extant logic in `gnus-summary-setup-buffer'
             (gnus-message 7 (concat preface "(extant %s)") (buffer-name extant)))
            (t
             (save-excursion
               (let (gnus-auto-select-subject
                     (gnus-large-newsgroup 10000))
                 (gnus-summary-read-group gnus-newsgroup-name nil t)
                 (with-current-buffer (gnus-summary-buffer-name gnus-newsgroup-name)
                   (dolist (datum gnus-newsgroup-data)
                     (-when-let* ((article (gnus-data-number datum))
                                  (plst (nnhackernews--get-header article))
                                  (scored-story-p (and (plist-get plst :title)
                                                       (> (gnus-summary-article-score article) 0))))
                       (gnus-message 7 "nnhackernews--mark-scored-as-read: %s (%s %s)"
                                     (plist-get plst :title) group article)
                       (gnus-summary-mark-as-read article))))
                 (nnhackernews--summary-exit gnus-newsgroup-name))))))))

(deffoo nnhackernews-request-group-scan (group &optional server info)
  "\\[gnus-group-get-new-news-this-group] calls this."
  (nnhackernews--normalize-server)
  (nnhackernews--with-group group
    (gnus-message 5 "nnhackernews-request-group-scan: scanning %s..." group)
    (gnus-activate-group gnus-newsgroup-name t)
    (gnus-get-unread-articles-in-group
     (or info (gnus-get-info gnus-newsgroup-name))
     (gnus-active (gnus-info-group info)))
    (gnus-message 5 "nnhackernews-request-group-scan: scanning %s...done" group)
    (nnhackernews--score-unread group))
  t)

(defun nnhackernews--checksum ()
  "Ensure header tallies agree.

The two hashtables being reconciled are `nnhackernews-location-hashtb' and
`nnhackernews-headers-alist'."
  (let ((counts (gnus-make-hashtable)))
    (nnhackernews--maphash
     (lambda (_id group-index)
       (nnhackernews--replace-hash (car group-index) (lambda (v) (1+ (or v 0)))
                                   counts))
     nnhackernews-location-hashtb)

    (mapc
     (lambda (pair)
       (cl-destructuring-bind (group headers) pair
	 (cl-assert (= (nnhackernews--gethash group counts 0)
		       (length headers))
		    nil
		    "nnhackernews--checksum: %s, %s != %s"
		    group (nnhackernews--gethash group counts 0)
		    (length headers))))
     nnhackernews-headers-alist)

    (let (result)
      (nnhackernews--maphash
       (lambda (group count)
         (push (cons group count) result))
       counts)
      result)))

;; gnus-group-select-group
;;   gnus-group-read-group
;;     gnus-summary-read-group
;;       gnus-summary-read-group-1
;;         gnus-summary-setup-buffer
;;           sets gnus-newsgroup-name
;;         gnus-select-newsgroup
;;           gnus-request-group
;;             nnhackernews-request-group
(deffoo nnhackernews-request-group (group &optional server _fast info)
  (nnhackernews--normalize-server)
    (nnhackernews--with-group group
      (let* ((info (or info (gnus-get-info gnus-newsgroup-name)))
             (headers (nnhackernews-get-headers group))
             (first-header (1+ (or (-find-index #'identity headers) 0)))
             (last-header (length headers))
             (num-headers (if (> first-header last-header) 0
                            (1+ (- last-header first-header))))
             (status (format "211 %d %d %d %s"
                             num-headers first-header last-header group)))
        (gnus-message 7 "nnhackernews-request-group: %s" status)
        (nnheader-insert "%s\n" status)
        (when info
          (gnus-info-set-marks
           info
           (append (assq-delete-all 'seen (gnus-info-marks info))
                   (list `(seen (1 . ,num-headers))))
           t)
          (gnus-info-set-method info (gnus-group-method gnus-newsgroup-name) t)
          (gnus-set-info gnus-newsgroup-name info)))
      t))

(defsubst nnhackernews--json-read ()
  "Copied from ein:json-read() by tkf."
  (goto-char (point-max))
  (backward-sexp)
  (let ((json-object-type 'plist)
        (json-array-type 'list))
    (json-read)))

(defun nnhackernews--request-max-item ()
  "Retrieve the max-item from which all read-unread accounting stems."
  (let (max-item)
    (nnhackernews--request
     "nnhackernews--request-max-item"
     "https://hacker-news.firebaseio.com/v0/maxitem.json"
     :parser 'nnhackernews--json-read
     :success (nnhackernews--callback max-item))
    max-item))

(defun nnhackernews--request-newstories ()
  "Return list of id's which we know to be stories (as opposed to comments)."
  (let (stories)
    (nnhackernews--request
     "nnhackernews--request-newstories"
     "https://hacker-news.firebaseio.com/v0/newstories.json"
     :success (nnhackernews--callback
               stories
               (cl-function
                (lambda (&key data &allow-other-keys)
                  ;; manual recommended listify appends nil
                  (append
                   (eval (car (read-from-string (subst-char-in-string ?, ?\  data))))
                   nil)))))
    stories))

(cl-defun nnhackernews--request (caller url
                                 &rest attributes
                                 &key parser (backend 'url-retrieve) (timeout 10)
                                 &allow-other-keys)
  "Prefix errors with CALLER executing synchronous request to URL.

Request shall contain ATTRIBUTES, one of which is PARSER of the
response, if provided (shall default to verbatim dump of
response, if not).  BACKEND can be curl (defaults to
`url-retrieve').  TIMEOUT is seconds, default 10."
  (unless parser
    (setq attributes (append attributes (list :parser #'buffer-string))))
  (setq attributes
        (cl-loop for (k v) on attributes by (function cddr)
                 unless (eq k :backend)
                 collect k and collect v))
  (let ((request-backend backend))
    (apply #'request url
           :sync t
           :timeout timeout
           :error (apply-partially #'nnhackernews--request-error caller)
           attributes)))

(cl-defun nnhackernews--request-vote-success (item vote &key data &allow-other-keys)
  "If necessary, login first.
Then locate ITEM VOTE link in DATA (will depend on VOTE sign)."
  (let* ((dom (nnhackernews--domify data))
         (before (format "%s_%s" (if (> vote 0) "up" "un") item))
         (after (format "%s_%s" (if (<= vote 0) "up" "un") item))
         before-found result)
    (-tree-map-nodes
     (lambda (x)
       (and (listp x)
            (eq (car x) 'a)
            (let ((id (alist-get 'id (cl-second x))))
              (or (string= before id) (string= after id)))))
     (lambda (x)
       (let ((id (alist-get 'id (cl-second x)))
             (href (alist-get 'href (cl-second x))))
         (cond ((string= before id)
                (setq before-found (concat (file-name-as-directory nnhackernews-hacker-news-url) href)))
               ((string= after id) (setq result t)))))
     dom)
    (when before-found
      (nnhackernews--request
       "nnhackernews--request-vote-success"
       before-found
       :backend 'curl
       :success (nnhackernews--callback
                 result
                 (cl-function
                  (lambda (&key data response &allow-other-keys)
                    (let* ((dom (nnhackernews--domify data))
                           (form (alist-get 'form (alist-get 'body dom)))
                           (url (request-response-url response))
                           hidden)
                      (nnhackernews--extract-hidden dom hidden)
                      (when (string= "vote" (alist-get 'action (car form)))
                        (setq dom (nnhackernews--domify
                                   (nnhackernews--request-login url hidden))))
                      (let (result0)
                        (-tree-map-nodes
                         (lambda (x)
                           (and (listp x)
                                (eq (car x) 'a)
                                (string= after (alist-get 'id (cl-second x)))))
                         (lambda (_x) (setq result0 t))
                         dom)
                        result0)))))))
    result))

(defun nnhackernews--request-vote (item vote)
  "Tally for ITEM the VOTE."
  (let (result)
    (nnhackernews--request
     "nnhackernews--request-vote"
     (format "%s/item?id=%s" nnhackernews-hacker-news-url item)
     :backend 'curl
     :success (nnhackernews--callback
               result
               (apply-partially #'nnhackernews--request-vote-success item vote)))
    result))

(defsubst nnhackernews--enforce-curl ()
  "Curl must exist."
  (unless (executable-find "curl")
    (error "`nnhackernews--enforce-curl': the 'curl' program was not found")))

(defun nnhackernews--request-reply (url text hidden)
  "Reply URL with TEXT using HIDDEN credentials."
  (nnhackernews--enforce-curl)
  (let (result)
    (nnhackernews--request
     "nnhackernews--request-reply"
     url
     :backend 'curl
     :data (append (cl-loop for (k v) on hidden by (function cddr)
                            collect (cons (cl-subseq (symbol-name k) 1) v))
                   `(("text" . ,text)))
     :success (nnhackernews--callback result))
    result))

(defun nnhackernews--request-edit (_item _body)
  "Replace body of ITEM with BODY."
  ;; (let (result)
  ;;   (nnhackernews--request
  ;;    "nnhackernews--request-edit"
  ;;    (format "%s/delete-confirm?%s"
  ;;            nnhackernews-hacker-news-url
  ;;            (url-build-query-string
  ;;             (cons `(id ,item)
  ;;                   (when root `((goto ,(format "item?id=%s" root)))))))
  ;;    :backend 'curl
  ;;    :success (nnhackernews--callback result #'nnhackernews--request-delete-success))
  ;;   result)
  )

(defun nnhackernews--request-delete (item &optional root)
  "Cancel ITEM at root ROOT."
  (let (result)
    (nnhackernews--request
     "nnhackernews--request-delete"
     (format "%s/delete-confirm?%s"
             nnhackernews-hacker-news-url
             (url-build-query-string
              (cons `(id ,item)
                    (when root `((goto ,(format "item?id=%s" root)))))))
     :backend 'curl
     :success (nnhackernews--callback result #'nnhackernews--request-delete-success))
    result))

(cl-defun nnhackernews--request-error (caller
                                       &key response symbol-status error-thrown
                                       &allow-other-keys
                                       &aux (response-status
                                             (request-response-status-code response)))
  "Refer to CALLER when reporting a submit error.

Also report http code of RESPONSE, which is distinct from
SYMBOL-STATUS, and ERROR-THROWN.  The http code is stored in
RESPONSE-STATUS."
  (gnus-message 3 "%s %s: http status %s, %s" caller symbol-status response-status
                (error-message-string error-thrown)))

(cl-defun nnhackernews--request-submit-success
    (caller posturl postdata retry &key data response &allow-other-keys)
  "If necessary, login, then \"goto\" fields take us to target.

And if accused of being a bot, retry with CALLER, POSTURL,
POSTDATA \(and toggle RETRY).  Use DATA and RESPONSE to determine
if we need to login again."
  (let* ((dom (nnhackernews--domify data))
         (form (car (alist-get 'form (alist-get 'body dom))))
         (url (request-response-url response))
         (path (car (url-path-and-query (url-generic-parse-url url))))
         (login-p (aif (alist-get 'action form) (cl-search it path)))
         (result data))
    (when login-p
      (let (hidden)
        (nnhackernews--extract-hidden dom hidden)
        (setq result (nnhackernews--request-login url hidden))))
    (-tree-map-nodes
     (lambda (x)
       (and (listp x)
            (eq (car x) 'td)
            (stringp (cl-third x))
            (string-match-p (regexp-quote "try again") (cl-third x))))
     (lambda (_x)
       (if retry
           (let (hidden)
             (nnhackernews--extract-hidden dom hidden)
             (setq result (nnhackernews--request-submit caller posturl postdata hidden nil)))
         (setq result nil)
         (setq nnhackernews-status-string "Retried and failed")))
     dom)
    result))

(defun nnhackernews--request-submit (caller posturl postdata hidden retry)
  "Submit from CALLER to POSTURL the POSTDATA with HIDDEN credentials.

Bool RETRY is non-nil on first attempt.
Factor out commonality between text and link submit."
  (nnhackernews--enforce-curl)
  (let (result)
    (nnhackernews--request
     caller
     posturl
     :backend 'curl
     :data (append (cl-loop for (k v) on hidden by (function cddr)
                            collect (cons (cl-subseq (symbol-name k) 1) v))
                   postdata)
     :success (nnhackernews--callback
               result
               (apply-partially #'nnhackernews--request-submit-success
                                caller posturl postdata retry)))
    result))

(defsubst nnhackernews--request-submit-link (url title link hidden)
  "Submit to URL the TITLE with LINK and HIDDEN credentials."
  (nnhackernews--request-submit "nnhackernews--request-submit-link"
                                url
                                `(("title" . ,title) ("url" . ,link) ("text" . ""))
                                hidden t))

(defsubst nnhackernews--request-submit-text (url title text hidden)
  "Submit to URL the TITLE with TEXT and HIDDEN credentials."
  (nnhackernews--request-submit "nnhackernews--request-submit-text"
                                url
                                `(("title" . ,title) ("url" . "") ("text" . ,text))
                                hidden t))

(defun nnhackernews--request-item (id)
  "Retrieve ID as a property list."
  (push id nnhackernews--debug-request-items)
  (let ((utf-decoder (lambda (x)
                       (decode-coding-string (with-temp-buffer
                                               (set-buffer-multibyte nil)
                                               (insert x)
                                               (buffer-string))
                                             'utf-8)))
        plst)
    (add-function :filter-return (symbol-function 'json-read-string) utf-decoder)
    (unwind-protect
	(nnhackernews--request
	 "nnhackernews--request-item"
	 (format "https://hacker-news.firebaseio.com/v0/item/%s.json" id)
	 :parser 'nnhackernews--json-read
	 :success (nnhackernews--callback plst))
      (remove-function (symbol-function 'json-read-string) utf-decoder))
    (when-let ((id (plist-get plst :id)))
      (when (numberp id)
        (setq plst (plist-put plst :id (number-to-string id))))
      (-when-let* ((parent (plist-get plst :parent))
                   (is-number (numberp parent)))
        (setq plst (plist-put plst :parent (number-to-string parent))))
      (unless (plist-get plst :score)
        (setq plst (plist-put plst :score 0)))
      plst)))

(defun nnhackernews--select-items (start-item max-item all-stories)
  "Return a list of items to retrieve between START-ITEM and MAX-ITEM.

Since we are constrained by `nnhackernews-max-items-per-scan', we
prioritize ALL-STORIES and may throw away comments, etc."
  (mapcar
   #'number-to-string
   (if (> (1+ (- max-item start-item)) nnhackernews-max-items-per-scan)
       (let* ((stories (seq-take-while (lambda (x) (>= x start-item))
                                       all-stories))
              (excess (- nnhackernews-max-items-per-scan (length stories))))
         (if (<= excess 0)
             (nreverse (cl-subseq stories 0 nnhackernews-max-items-per-scan))
           (cl-loop with excess-count = 0
                    with j = 0
                    for i from max-item downto start-item by 1
                    until (or (>= excess-count excess) (>= j (length stories)))
                    if (= i (elt stories j))
                    do (cl-incf j)
                    else
                    do (cl-incf excess-count)
                    end
                    collect i into result
                    finally return (nreverse (append result (nthcdr j stories)
                                                     (cl-loop for k from 0 below
                                                              (- excess excess-count) by 1
                                                              collect (- i k)))))))
     (cl-loop for i from start-item to max-item by 1
              collect i))))

(defun nnhackernews--incoming (&optional static-max-item static-newstories)
  "Drink from the firehose.

Optionally provide STATIC-MAX-ITEM and STATIC-NEWSTORIES to
prevent querying out."
  (interactive)
  (setq nnhackernews--debug-request-items nil)
  (unless nnhackernews--last-item
    (mapc (lambda (group)
            (-when-let* ((full-name (gnus-group-full-name group "nnhackernews:"))
                         (info (gnus-get-info full-name)))
              (setf (gnus-info-read info) nil)
              (gnus-set-info full-name info)))
          `(,nnhackernews--group-ask
            ,nnhackernews--group-show
            ,nnhackernews--group-job
            ,nnhackernews--group-stories)))
  (let ((max-item (or static-max-item (nnhackernews--request-max-item))))
    (if (and nnhackernews--last-item (<= max-item nnhackernews--last-item))
        (gnus-message 7 "nnhackernews--incoming: max %s <= last %s"
                      max-item nnhackernews--last-item)
      (let* ((stories (or static-newstories (nnhackernews--request-newstories)))
             (earliest-story (nth (1- (min nnhackernews-max-items-per-scan
                                           (length stories)))
                                  stories))
             (start-item (if nnhackernews--last-item
                             (1+ nnhackernews--last-item)
                           (min earliest-story
                                (- max-item nnhackernews-max-items-per-scan))))
             (counts (gnus-make-hashtable))
             (items (nnhackernews--select-items start-item max-item stories)))
        (dolist (item items)
          (-when-let* ((plst (nnhackernews--request-item item))
                       (not-deleted (not (plist-get plst :deleted)))
                       (type (plist-get plst :type)))
            (nnhackernews-add-entry nnhackernews-refs-hashtb plst :parent)
            (nnhackernews-add-entry nnhackernews-authors-hashtb plst :by)
            (nnhackernews--replace-hash type (lambda (x) (1+ (or x 0))) counts)
            (setq plst (plist-put plst :link_title
                                  (or (plist-get
                                       (nnhackernews--retrieve-root plst)
                                       :title)
                                      "")))
            (cl-case (intern type)
              (job (nnhackernews--append-header plst nnhackernews--group-job))
              ((story comment) (nnhackernews--append-header plst))
              (otherwise (gnus-message 5 "nnhackernews-incoming: ignoring type %s" type)))))
        (setq nnhackernews--last-item max-item)
        (gnus-message
         5 (concat "nnhackernews--incoming: "
                   (format "%d requests, " (length nnhackernews--debug-request-items))
                   (let ((result ""))
                     (nnhackernews--maphash
                      (lambda (key value)
                        (setq result (concat result (format "%s +%s " key value))))
                      counts)
                     result)))))))

(deffoo nnhackernews-request-scan (&optional group server)
  (nnhackernews--normalize-server)
  (when group
    (if (> 2 (- (truncate (float-time)) nnhackernews--last-scan-time))
        (gnus-message 7 "nnhackernews-request-scan: last scanned at %s"
                      (current-time-string nnhackernews--last-scan-time))
      (nnhackernews--with-group group
        (cl-destructuring-bind (seconds num-gc seconds-gc)
            (benchmark-run (nnhackernews--incoming))
          (setq nnhackernews--last-scan-time (truncate (float-time)))
          (gnus-message 5 (concat "nnhackernews-request-scan: Took %s seconds,"
                                  " with %s gc runs taking %s seconds")
                        seconds num-gc seconds-gc))))))

(defsubst nnhackernews--make-message-id (id)
  "Construct a valid Gnus message id from ID."
  (format "<%s@ycombinator.com>" id))

(defsubst nnhackernews--make-references (id)
  "Construct a space delimited string of message ancestors of ID."
  (mapconcat (lambda (ref) (nnhackernews--make-message-id ref))
             (nnhackernews-refs-for id) " "))

(defun nnhackernews--make-header (article-number &optional group)
  "Construct full headers of articled indexed ARTICLE-NUMBER in GROUP."
  (let* ((header (nnhackernews--get-header article-number group))
         (score (plist-get header :score))
         (num-comments (plist-get header :num_comments)))
    (make-full-mail-header
     article-number
     (replace-regexp-in-string "\\S-+ HN: " ""
                               (or (plist-get header :title)
                                   (plist-get header :link_title)))
     (plist-get header :by)
     (format-time-string "%a, %d %h %Y %T %z (%Z)" (plist-get header :time))
     (nnhackernews--make-message-id (plist-get header :id))
     (nnhackernews--make-references (plist-get header :id))
     0 0 nil
     (append `((X-Hackernews-Name . ,(plist-get header :id)))
             `((X-Hackernews-ID . ,(plist-get header :id)))
             `((X-Hackernews-Permalink . ,(format "%s/item?id=%s" nnhackernews-hacker-news-url (plist-get header :id))))
             (and (integerp score)
                  `((X-Hackernews-Score . ,(number-to-string score))))
             (and (integerp num-comments)
                  `((X-Hackernews-Comments . ,(number-to-string num-comments))))))))

(deffoo nnhackernews-request-article (article-number &optional group server buffer)
  (nnhackernews--normalize-server)
  (unless buffer (setq buffer nntp-server-buffer))
  (nnhackernews--with-group group
    (with-current-buffer buffer
      (erase-buffer)
      (if-let ((header (nnhackernews--get-header article-number group)))
          (let* ((mail-header (nnhackernews--make-header article-number))
                 (score (cdr (assq 'X-Hackernews-Score (mail-header-extra mail-header))))
                 (permalink (cdr (assq 'X-Hackernews-Permalink (mail-header-extra mail-header))))
                 (body (nnhackernews--massage (nnhackernews--get-body header server))))
          (when body
            (insert
             "Newsgroups: " group "\n"
             "Subject: " (mail-header-subject mail-header)  "\n"
             "From: " (or (mail-header-from mail-header) "nobody") "\n"
             "Date: " (mail-header-date mail-header) "\n"
             "Message-ID: " (mail-header-id mail-header) "\n"
             "References: " (mail-header-references mail-header) "\n"
             "Archived-at: " permalink "\n"
             "Score: " score "\n"
             "\n")
            (mml-insert-multipart "alternative")
            (mml-insert-tag 'part 'type "text/html"
                            'disposition "inline"
                            'charset "utf-8")
            (save-excursion (mml-insert-tag '/part))
            (-when-let*
                ((parent (plist-get header :parent))
                 (parent-author
                  (or (nnhackernews--gethash parent nnhackernews-authors-hashtb)
                      "Someone"))
                 (parent-body (nnhackernews--get-body
                               (nnhackernews-find-header parent) server)))
              (insert (nnhackernews--citation-wrap parent-author parent-body)))
            (aif (and nnhackernews-render-story (plist-get header :url))
                (condition-case err
                    (nnhackernews--request
                     "nnhackernews-request-article" it
                     :success (cl-function
                               (lambda (&key data &allow-other-keys)
                                 (if (> (length data) nnhackernews-max-render-bytes)
                                     (insert body)
                                   (insert data)))))
                  (error (gnus-message 5 "nnhackernews-request-article: %s"
                                       (error-message-string err))
                         (insert body)))
              (insert body))
            (insert "\n")
            (if (mml-validate)

                (message-encode-message-body)
              (gnus-message 2 "nnhackernews-request-article: Invalid mml:\n%s"
                            (buffer-string)))
            (cons group article-number)))
        (gnus-message 5 "nnhackernews-request-article: header purged %s (article %s)"
                      group article-number)))))

(defsubst nnhackernews--shift-ranges (delta ranges)
  "Shift back by DELTA the elements of RANGES, removing any negative entries."
  (cl-remove-if-not (lambda (e)
                      (cond ((numberp e) (> e 0))
                            (t (> (cdr e) 0))))
                    (mapcar (lambda (e)
                              (cond ((numberp e) (- e delta))
                                    (t `(,(max 1 (- (car e) delta)) .
                                         ,(- (cdr e) delta)))))
                            ranges)))

(defun nnhackernews-purge ()
  "The size of `nnhackernews-refs-hashtb' is not the problem!"
  (interactive)
  (nnhackernews--with-group "news"
    (let* ((headers (nnhackernews-get-headers group))
           (delta (truncate (* 0.5 (length headers))))
           (info (gnus-get-info gnus-newsgroup-name))
           (remaining (nthcdr delta headers))
           (newsrc-read-ranges (gnus-info-read info))
           (newsrc-mark-ranges (gnus-info-marks info))
           (newsrc-read-ranges-shifted
            (nnhackernews--shift-ranges delta newsrc-read-ranges))
           (newsrc-mark-ranges-shifted
            (mapcar (lambda (what-ranges)
                      (cl-case (car what-ranges)
                        (seen `(seen (1 . ,(length remaining))))
                        (t (cons (car what-ranges)
                                 (nnhackernews--shift-ranges delta (cdr what-ranges))))))
                    newsrc-mark-ranges)))
      (dolist (id (mapcar (lambda (header) (plist-get header :id))
                          (cl-subseq headers 0 delta)))
        (nnhackernews--remhash id nnhackernews-refs-hashtb)
        (nnhackernews--remhash id nnhackernews-location-hashtb)
        (nnhackernews--remhash id nnhackernews-authors-hashtb))
      (setf (gnus-info-read info) newsrc-read-ranges-shifted)
      (gnus-set-active gnus-newsgroup-name (cons 1 (length remaining)))
      (gnus-info-set-marks info newsrc-mark-ranges-shifted)
      (gnus-set-info gnus-newsgroup-name info)
      (setf (nnhackernews-alist-get group nnhackernews-headers-alist nil nil #'equal)
            (list remaining)))))

(deffoo nnhackernews-retrieve-headers (article-numbers &optional group server _fetch-old)
  (nnhackernews--normalize-server)
  (nnhackernews--with-group group
    (with-current-buffer nntp-server-buffer
      (erase-buffer)
      (dolist (i article-numbers)
        (nnheader-insert-nov (nnhackernews--make-header i group)))
      'nov)))

(deffoo nnhackernews-close-server (&optional server _defs)
  (nnhackernews--normalize-server)
  t)

(deffoo nnhackernews-request-list (&optional server)
  (nnhackernews--normalize-server)
  (with-current-buffer nntp-server-buffer
    (erase-buffer)
    (mapc (lambda (group)
            (let* ((full-name (gnus-group-full-name group `("nnhackernews" ,(or server ""))))
		   (level (gnus-group-level full-name)))
	      (gnus-activate-group full-name t)
	      (when (> level gnus-level-zombie)
		;; Can't know if first time or gnus-level-killed group.
		(gnus-group-unsubscribe-group full-name gnus-level-default-subscribed t))
	      (when (<= level gnus-level-subscribed)
		(insert (format "%s %d 1 y\n" group
				(length (nnhackernews-get-headers group)))))))
          `(,nnhackernews--group-ask
            ,nnhackernews--group-show
            ,nnhackernews--group-job
            ,nnhackernews--group-stories)))
  t)

(deffoo nnhackernews-request-newgroups (_date &optional server)
  (nnhackernews--normalize-server)
  (with-current-buffer nntp-server-buffer
    (erase-buffer)
    (mapc (lambda (group)
            (insert (format "%S 0 1 y\n" group)))
          `(,nnhackernews--group-ask
            ,nnhackernews--group-show
            ,nnhackernews--group-job
            ,nnhackernews--group-stories))
    t))

(defun nnhackernews-sentinel (process event)
  "Wipe headers state when PROCESS dies from EVENT."
  (unless (string= "open" (substring event 0 4))
    (gnus-message 2 "nnhackernews-sentinel: process %s %s"
                  (car (process-command process))
                  (replace-regexp-in-string "\n$" "" event))
    (setq nnhackernews-location-hashtb (gnus-make-hashtable))
    (gnus-backlog-shutdown)))

(defun nnhackernews--message-user (server beg end _prev-len)
  "Message SERVER related alert with `buffer-substring' from BEG to END."
  (let ((string (buffer-substring beg end))
        (magic "::user::"))
    (when (string-prefix-p magic string)
      (message "%s: %s" server (substring string (length magic))))))

(cl-defun nnhackernews--request-delete-success (&key data &allow-other-keys)
  "Delete with extreme prejudice the hidden items in DATA."
  (let* ((dom (nnhackernews--domify data))
         hidden)
    (nnhackernews--extract-hidden dom hidden)
    (let (result)
      (nnhackernews--request
       "nnhackernews--request-delete-success"
       (format "%s/xdelete" nnhackernews-hacker-news-url)
       :backend 'curl
       :data (append (cl-loop for (k v) on hidden by (function cddr)
                              collect (cons (cl-subseq (symbol-name k) 1) v))
                     '(("d" . "Yes")))
       :success (nnhackernews--callback result))
      result)))

(defsubst nnhackernews--extract-unique (message-id)
  "Get unique from <unique@fqdn> in MESSAGE-ID."
  (when (string-match "\\(<[^>]+>\\)" message-id)
    (car (split-string
          (replace-regexp-in-string
           "[<>]" "" (match-string 1 message-id)) "@"))))

(defsubst nnhackernews--request-post-reply-url (headers)
  "Return hexified reply url from HEADERS."
  (let ((references (mail-header-references headers))
        (immediate (nnhackernews--extract-unique
                    (mail-header-message-id headers))))
    (if references
        (let ((root (nnhackernews--extract-unique
                     (car (split-string references " ")))))
          (format "%s/reply?%s"
                  nnhackernews-hacker-news-url
                  (url-build-query-string
                   `((id ,immediate) (goto ,(format "item?id=%s#%s"
                                                    root
                                                    immediate))))))
      (format "%s/comment?%s"
              nnhackernews-hacker-news-url
              (url-build-query-string
                   `((id ,immediate) (goto ,(format "item?id=%s"
                                                    immediate))))))))

(defmacro nnhackernews--set-status-string (dom)
  "Set `nnhackernews-status-string' to DOM remarks.
We do this for the benefit of `nnheader-report'."
  `(let ((body (alist-get 'body ,dom))
         remarks)
     (-tree-map-nodes
      (lambda (x)
        (and (listp x)
             (eq (car x) 'td)
             (stringp (cl-third x))))
      (lambda (x) (!cons (cl-third x) remarks))
      body)
     (setq nnhackernews-status-string
           (mapconcat #'string-trim remarks " "))))

;; C-c C-c from followup buffer
;; message-send-and-exit
;; message-send
;; message-send-method-alist=message-send-news-function=message-send-news
;; gnus-request-post
;; nnhackernews-request-post
(deffoo nnhackernews-request-post (&optional server)
  (nnhackernews--normalize-server)
  (let ((url (aif message-reply-headers
                 (nnhackernews--request-post-reply-url it)
               (format "%s/submit" nnhackernews-hacker-news-url))))
    (let ((ret t)
          (title (or (message-fetch-field "Subject") (error "No Subject field")))
          (link (message-fetch-field "Link"))
          (reply-p message-reply-headers)
          (edit-item (aif (message-fetch-field "Supersedes")
                         (nnhackernews--extract-unique it)))
          (cancel-item (aif (message-fetch-field "Control")
                           (nnhackernews--extract-unique it)))
          (body
           (save-excursion
             (save-restriction
               (message-goto-body)
               (narrow-to-region (point) (point-max))
               (buffer-string)))))
      (cond (cancel-item
             (let* ((header (nnhackernews-find-header cancel-item))
                    (result (nnhackernews--request-delete
                             cancel-item
                             (and (null (plist-get header :title))
                                  (plist-get (nnhackernews--retrieve-root header) :id))))
                    (dom (nnhackernews--domify result)))
               (cl-destructuring-bind (tag params &rest args) dom
                 (setq ret (and (eq tag 'html)
                                (string= (alist-get 'op params) "item")))
                 (unless ret (nnhackernews--set-status-string dom)))))
            (edit-item
             (let* ((result (nnhackernews--request-edit edit-item body))
                    (dom (nnhackernews--domify result)))
               (cl-destructuring-bind (tag params &rest args) dom
                 (setq ret (and (eq tag 'html)
                                (string= (alist-get 'op params) "item")))
                 (unless ret (nnhackernews--set-status-string dom)))))
            (reply-p
             (-if-let* ((hidden (nnhackernews--request-hidden url))
                        (path (car (url-path-and-query (url-generic-parse-url url))))
                        (url (replace-regexp-in-string path "/comment" url))
                        (result (progn (sleep-for 0 nnhackernews-refractory-ms)
                                       (nnhackernews--request-reply url body hidden)))
                        (dom (nnhackernews--domify result)))
                 (cl-destructuring-bind (tag params &rest args) dom
                   (setq ret (and (eq tag 'html)
                                  (string= (alist-get 'op params) "item")))
                   (unless ret (nnhackernews--set-status-string dom)))
               (gnus-message 3 "nnhackernews-request-post: null reply from %s"
                             url)))
            (link
             (let* ((hidden (nnhackernews--request-hidden url))
                    (parsed-url (url-generic-parse-url link))
                    (host (url-host parsed-url))
                    (path (car (url-path-and-query (url-generic-parse-url url))))
                    (url (replace-regexp-in-string path "/r" url)))
               (if (and (stringp host) (not (zerop (length host))))
                   (setq ret (progn
                               (sleep-for 0 nnhackernews-refractory-ms)
                               (nnhackernews--request-submit-link url title link hidden)))
                 (gnus-message 3 "nnhackernews-request-post: invalid url \"%s\"" link)
                 (setq ret nil))))
            (t
             (let* ((hidden (nnhackernews--request-hidden url))
                    (path (car (url-path-and-query (url-generic-parse-url url))))
                    (url (replace-regexp-in-string path "/r" url)))
               (sleep-for 0 nnhackernews-refractory-ms)
               (setq ret (nnhackernews--request-submit-text url title body hidden)))))
      ret)))

(defun nnhackernews--browse-story (&rest _args)
  "What happens when I click on hackernews Subject."
  (-when-let* ((group-article gnus-article-current)
               (url (or (gnus-fetch-original-field "Archived-At")
                        (plist-get (nnhackernews--retrieve-root
                                    (nnhackernews--get-header
                                     (cdr group-article)
                                     (gnus-group-real-name
                                      (car group-article))))
                                   :url))))
    (browse-url url)))

(defun nnhackernews--header-button-alist ()
  "Construct a buffer-local `gnus-header-button-alist' for nnhackernews."
  (let* ((result (copy-alist gnus-header-button-alist))
         (references-value (assoc-default "References" result
                                          (lambda (x y) (string-match-p y x))))
         (references-key (car (rassq references-value result))))
    (setq result (cl-delete "^Subject:" result :test (lambda (x y) (cl-search x (car y)))))
    (setq result (cl-delete references-key result :test (lambda (x y) (cl-search x (car y)))))
    (push (append '("^\\(Message-I[Dd]\\|^In-Reply-To\\):") references-value) result)
    (push '("^Subject:" ".+" 0 (>= gnus-button-browse-level 0)
            nnhackernews--browse-story 0)
          result)
    result))

(defun nnhackernews--fallback-link ()
  "Cannot render story."
  (-when-let* ((group-article gnus-article-current)
               (header (nnhackernews--get-header
                        (cdr group-article)
                        (gnus-group-real-name (car group-article))))
               (body (nnhackernews--massage (nnhackernews--get-body header))))
    (with-current-buffer gnus-original-article-buffer
      (article-goto-body)
      (delete-region (point) (point-max))
      (insert body))))

(defalias 'nnhackernews--display-article
  (lambda (article &optional all-headers _header)
    (nnhackernews--with-mutex nnhackernews--mutex-display-article
      (condition-case err
          (gnus-article-prepare article all-headers)
        (error
         (if nnhackernews-render-story
             (progn
               (let ((fallback-ok (nnhackernews--fallback-link)))
                 (when fallback-ok
                   (gnus-article-prepare article all-headers))
                 (gnus-message (if fallback-ok 7 5)
                               "nnhackernews--display-article: '%s' (falling back...%s)"
                               (error-message-string err)
                               (if fallback-ok "" "denied"))))
           (error (error-message-string err)))))))
  "In case of shr failures, dump original link.")

(defsubst nnhackernews--dense-time (time*)
  "Convert TIME to a floating point number.
Written by John Wiegley (https://github.com/jwiegley/dot-emacs)."
  (let ((time (if (fboundp 'time-convert)
                  (funcall #'time-convert time* 'list)
                (identity time*))))
    (+ (* (car time) 65536.0)
       (cadr time)
       (/ (or (car (cdr (cdr time))) 0) 1000000.0))))

(defalias 'nnhackernews--format-time-elapsed
  (lambda (header)
    (condition-case err
        (let ((date (mail-header-date header)))
          (when (> (length date) 0)
            (let* ((then (nnhackernews--dense-time
                          (apply #'encode-time (parse-time-string date))))
                   (now (nnhackernews--dense-time (current-time)))
                   (diff (- now then))
                   (str
                    (cond
                     ((>= diff (* 86400.0 7.0 52.0))
                      (if (>= diff (* 86400.0 7.0 52.0 10.0))
                          (format "%3dY" (floor (/ diff (* 86400.0 7.0 52.0))))
                        (format "%3.1fY" (/ diff (* 86400.0 7.0 52.0)))))
                     ((>= diff (* 86400.0 30.0))
                      (if (>= diff (* 86400.0 30.0 10.0))
                          (format "%3dM" (floor (/ diff (* 86400.0 30.0))))
                        (format "%3.1fM" (/ diff (* 86400.0 30.0)))))
                     ((>= diff (* 86400.0 7.0))
                      (if (>= diff (* 86400.0 7.0 10.0))
                          (format "%3dw" (floor (/ diff (* 86400.0 7.0))))
                        (format "%3.1fw" (/ diff (* 86400.0 7.0)))))
                     ((>= diff 86400.0)
                      (if (>= diff (* 86400.0 10.0))
                          (format "%3dd" (floor (/ diff 86400.0)))
                        (format "%3.1fd" (/ diff 86400.0))))
                     ((>= diff 3600.0)
                      (if (>= diff (* 3600.0 10.0))
                          (format "%3dh" (floor (/ diff 3600.0)))
                        (format "%3.1fh" (/ diff 3600.0))))
                     ((>= diff 60.0)
                      (if (>= diff (* 60.0 10.0))
                          (format "%3dm" (floor (/ diff 60.0)))
                        (format "%3.1fm" (/ diff 60.0))))
                     (t
                      (format "%3ds" (floor diff)))))
                   (stripped
                    (replace-regexp-in-string "\\.0" "" str)))
              (concat (cond
                       ((= 2 (length stripped)) "  ")
                       ((= 3 (length stripped)) " ")
                       (t ""))
                      stripped))))
      ;; print some spaces and pretend nothing happened.
      (error (format "%S" err))))
  "Return time elapsed since HEADER was sent.
Written by John Wiegley (https://github.com/jwiegley/dot-emacs).")

;; Evade package-lint!
(fset 'gnus-user-format-function-S
      (symbol-function 'nnhackernews--format-time-elapsed))

(defun nnhackernews-sort-scored-then-responses (t1 t2)
  "Scored first.  Then whichever of T1 or T2 has more responses.
Modified `gnus-thread-sort-by-score'."
  (let* ((h1 (gnus-thread-header t1))
         (h2 (gnus-thread-header t2))
         (s1 (or (cdr (assq (mail-header-number h1)
		            gnus-newsgroup-scored))
                 gnus-summary-default-score 0))
         (s2 (or (cdr (assq (mail-header-number h2)
		            gnus-newsgroup-scored))
                 gnus-summary-default-score 0)))
    (cond ((and (> s1 gnus-summary-default-high-score)
                (<= s2 gnus-summary-default-high-score))
           t)
          ((and (> s2 gnus-summary-default-high-score)
                (<= s1 gnus-summary-default-high-score))
           nil)
          (t (> (gnus-summary-number-of-articles-in-thread t1)
                (gnus-summary-number-of-articles-in-thread t2))))))

(defun nnhackernews-sort-by-number-of-articles-in-thread (t1 t2)
  "Whichever of T1 or T2 has more responses."
  (> (gnus-summary-number-of-articles-in-thread t1)
     (gnus-summary-number-of-articles-in-thread t2)))

(defun nnhackernews-gather-threads-by-references (threads)
  "Gather THREADS by root reference, and don't be incomprehensible or buggy.
The built-in `gnus-gather-threads-by-references' is both."
  (cl-flet ((special-case
	     (thread)
	     (let ((header (cl-first thread)))
	       (if (stringp header)
		   thread
		 (list (mail-header-subject header) thread))))
	    (has-refs
	     (thread)
	     (let ((header (cl-first thread)))
               (gnus-split-references (mail-header-references header)))))
    (let ((threads-by-ref (gnus-make-hashtable))
	  (separated (-separate #'has-refs threads))
	  result)
      (dolist (thread (cl-second separated))
	(let* ((header (cl-first thread))
	       (id (mail-header-id header))
	       (thread-special (special-case thread)))
	  (push thread-special result)
	  (nnhackernews--sethash id thread-special threads-by-ref)))
      (dolist (thread (cl-first separated))
	(let* ((header (cl-first thread))
	       (refs (gnus-split-references (mail-header-references header)))
	       (ref-thread (cl-some (lambda (ref)
				      (nnhackernews--gethash ref threads-by-ref))
				    refs)))
	  (if ref-thread
	      (setcdr ref-thread (nconc (cdr ref-thread) (list thread)))
	    (setq ref-thread (special-case thread))
	    (push ref-thread result)
	    (nnhackernews--sethash (car refs) ref-thread threads-by-ref))))
      (nreverse result))))

(defun nnhackernews-gather-then-sort (threads)
  "Gather THREADS by root, then sort.
Gnus, for whatever reason, first sorts threads then collates, thus breaking
the initial sort.  Circumvent this stupidity."
  (let ((gnus-thread-sort-functions
         (list 'nnhackernews-sort-scored-then-responses)))
    (gnus-sort-threads
     (nnhackernews-gather-threads-by-references threads))))

(let ((custom-defaults
       ;; For now, revert any user overrides that I can't predict.
       (mapcar (lambda (x)
                 (let* ((var (cl-first x))
                        (sv (get var 'standard-value)))
                   (when (eq var 'gnus-default-adaptive-score-alist)
                     (setq sv (list `(quote
                                      ,(mapcar (lambda (entry)
                                                 (cons (car entry)
                                                       (assq-delete-all 'from (cdr entry))))
                                               (eval (car sv)))))))
                   (cons var sv)))
               (seq-filter (lambda (x) (eq 'custom-variable (cl-second x)))
                           (append (get 'gnus-score-adapt 'custom-group)
                                   (get 'gnus-score-default 'custom-group))))))
  (add-to-list 'gnus-parameters `("^nnhackernews"
                                  ,@custom-defaults
                                  (gnus-summary-make-false-root 'adopt)
                                  (gnus-cite-hide-absolute 5)
                                  (gnus-cite-hide-percentage 0)
                                  (gnus-cited-lines-visible '(2 . 2))
                                  (gnus-use-cache nil)
                                  (gnus-use-adaptive-scoring (quote (line)))
                                  ;; (total-expire . t)
                                  (gnus-newsgroup-adaptive t)
                                  (gnus-simplify-subject-functions (quote (gnus-simplify-subject-fuzzy)))

                                  (gnus-summary-line-format "%3t%U%R%uS %I%(%*%-10,10f  %s%)\n")
                                  (gnus-auto-extend-newsgroup nil)
                                  (gnus-add-timestamp-to-message t)
                                  (gnus-thread-sort-functions (quote (ignore)))
                                  (gnus-summary-thread-gathering-function
                                   (quote nnhackernews-gather-then-sort))
                                  (gnus-subthread-sort-functions (quote (gnus-thread-sort-by-number)))
                                  (gnus-summary-display-article-function
                                   (quote ,(symbol-function 'nnhackernews--display-article)))
                                  (gnus-header-button-alist
                                   (quote ,(nnhackernews--header-button-alist)))
                                  (gnus-visible-headers ,(concat gnus-visible-headers "\\|^Score:")))))

(nnoo-define-skeleton nnhackernews)

(defun nnhackernews-article-mode-activate ()
  "Augment the `gnus-article-mode-map' conditionally."
  (when (nnhackernews--gate)
    (nnhackernews-article-mode)))

(deffoo nnhackernews-request-expire-articles (articles &optional group server _force)
  "Never gets called sinced I turned off total . expire.
Preserving indices so `nnhackernews-find-header' still works."
  (nnhackernews--normalize-server)
  (nnhackernews--with-group group
    (dolist (art articles)
      (let ((i (1- art))
            (headers (nnhackernews-get-headers group)))
        (if (zerop i)
            (setcar headers nil)
          (setcdr (nthcdr (1- i) headers) (cons nil (nthcdr (1+ i) headers))))))
    (nnhackernews--checksum)
    nil))

(defun nnhackernews-summary-mode-activate ()
  "Shadow some bindings in `gnus-summary-mode-map' conditionally."
  (when (nnhackernews--gate)
    (nnhackernews-summary-mode)))

;; I believe I did try buffer-localizing hooks, and it wasn't sufficient
(add-hook 'gnus-article-mode-hook #'nnhackernews-article-mode-activate)
(add-hook 'gnus-summary-mode-hook #'nnhackernews-summary-mode-activate)
(add-hook 'gnus-message-setup-hook
          (lambda ()
            (when (nnhackernews--message-gate)
              (message-replace-header
               "From"
               (concat (nnhackernews--who-am-i) "@ycombinator.com")))))

;; Avoid having to select the GROUP to make the unread number go down.
(add-hook 'gnus-after-getting-new-news-hook
	  (lambda ()
            (when (> (length (nnhackernews-get-headers "news"))
                     nnhackernews-purge-threshold)
              (nnhackernews-purge))
            (mapc (lambda (group)
                    (nnhackernews--score-unread group))
                  `(,nnhackernews--group-ask
                    ,nnhackernews--group-show
                    ,nnhackernews--group-job
                    ,nnhackernews--group-stories))))

;; Without this, I get Y's the first time around.  See 15195cc.
(add-hook 'gnus-started-hook
          (lambda () (mapc (lambda (group)
                             (nnhackernews--mark-scored-as-read group))
                           `(,nnhackernews--group-ask
                             ,nnhackernews--group-show
                             ,nnhackernews--group-job
                             ,nnhackernews--group-stories)))
          t)

;; "Can't figure out hook that can remove itself (quine conundrum)"
(add-function :around (symbol-function 'gnus-summary-exit)
              (lambda (f &rest args)
                (let ((gnus-summary-next-group-on-exit
                       (unless (nnhackernews--gate)
                         gnus-summary-next-group-on-exit)))
                  (apply f args))))

(add-function :after (symbol-function 'gnus-summary-exit)
              (symbol-function 'nnhackernews--score-pending))

(add-function :before (symbol-function 'gnus-score-save)
              (lambda (&rest _)
                (when (nnhackernews--gate)
                  (setq nnhackernews-score-files
                        (assq-delete-all (intern gnus-newsgroup-name)
                                         nnhackernews-score-files)))))

;; `gnus-newsgroup-p' requires valid method post-mail to return t
(add-to-list 'gnus-valid-select-methods '("nnhackernews" post-mail) t)

(add-function
 :around (symbol-function 'message-supersede)
 (lambda (f &rest args)
   (cond ((nnhackernews--message-gate)
          (add-function :override
                        (symbol-function 'mml-insert-mml-markup)
                        #'ignore)
          (unwind-protect
              (prog1 (apply f args)
                (remove-function (symbol-function 'mml-insert-mml-markup) #'ignore)
                (save-excursion
                  (save-restriction
                    (message-replace-header
                     "From"
                     (concat (nnhackernews--who-am-i) "@ycombinator.com"))
                    (message-goto-body)
                    (narrow-to-region (point) (point-max))
                    (goto-char (point-max))
                    (mm-inline-text-html nil)
                    (delete-region (point-min) (point)))))
            (remove-function (symbol-function 'mml-insert-mml-markup) #'ignore)))
         (t (apply f args)))))

(add-function
 :around (symbol-function 'message-send-news)
 (lambda (f &rest args)
   (cond ((nnhackernews--message-gate)
          (let* ((dont-ask (lambda (prompt)
                             (when (cl-search "mpty article" prompt) t)))
                 (link-p (message-fetch-field "Link"))
                 (message-shoot-gnksa-feet (if link-p t message-shoot-gnksa-feet)))
            (when link-p
              (add-function :before-until (symbol-function 'y-or-n-p) dont-ask))
            (unwind-protect (apply f args)
              (remove-function (symbol-function 'y-or-n-p) dont-ask))))
         (t (apply f args)))))

(add-function
 :around (symbol-function 'gnus-summary-post-news)
 (lambda (f &rest args)
   (cond ((nnhackernews--gate)
          (let* ((nnhackernews-post-type (read-char-choice "[l]ink / [t]ext: " '(?l ?t)))
                 (link-header (apply-partially #'message-add-header "Link: https://"))
                 (add-link-header (apply-partially #'add-hook
                                                   'message-header-setup-hook
                                                   link-header))
                 (remove-link-header (apply-partially #'remove-hook
                                                      'message-header-setup-hook
                                                      link-header)))
            (cl-case nnhackernews-post-type
              (?l (funcall add-link-header)))
            (condition-case err
                (progn
                  (apply f args)
                  (funcall remove-link-header))
              (error (funcall remove-link-header)
                     (error (error-message-string err))))))
         (t (apply f args)))))

(add-function
 :filter-return (symbol-function 'message-make-fqdn)
 (lambda (val)
   (if (and (nnhackernews--message-gate)
            (cl-search "--so-tickle-me" val))
       "ycombinator.com" val)))

(add-function
 :around (symbol-function 'message-is-yours-p)
 (lambda (f &rest args)
   (let ((concat-func (lambda (f &rest args)
                        (let ((fetched (apply f args)))
                          (if (string= (car args) "from")
                              (concat fetched "@ycombinator.com")
                            fetched)))))
     (when (nnhackernews--message-gate)
       (add-function :around
                     (symbol-function 'message-fetch-field)
                     concat-func))
     (unwind-protect
         (apply f args)
       (remove-function (symbol-function 'message-fetch-field) concat-func)))))

(let ((protect (lambda (caller)
                 (add-function
                  :around (symbol-function caller)
                  (lambda (f &rest args)
                    (cond ((nnhackernews--gate)
                           (condition-case err
                               (apply f args)
                             (error (gnus-message 7 "%s: %s"
                                                  caller
                                                  (error-message-string err)))))
                          (t (apply f args))))))))
  (funcall protect 'url-http-generic-filter)
  (funcall protect 'url-http-end-of-document-sentinel))

;; Make the scoring entries Markovian
(add-function
 :around (symbol-function 'gnus-summary-score-entry)
 (lambda (f header match &rest args)
   (cond ((nnhackernews--gate)
          (cl-flet ((my-delete-all ;; assoc-delete-all for emacs-25
                     (key alist)
                     (progn
                       (while (and (consp (car alist))
	                           (equal (caar alist) key))
                         (setq alist (cdr alist)))
                       (let ((tail alist) tail-cdr)
                         (while (setq tail-cdr (cdr tail))
                           (if (and (consp (car tail-cdr))
	                            (equal (caar tail-cdr) key))
	                       (setcdr tail (cdr tail-cdr))
	                     (setq tail tail-cdr))))
                       alist)))
            (let* ((match (downcase match))
                   (new-touched
                    (let ((gnus-score-alist (copy-alist '((touched nil)))))
                      ;; gnus-summary-score-entry modifies gnus-score-alist
                      (cons (apply f header match args)
                            (cl-some #'identity (gnus-score-get 'touched)))))
                   (new (car new-touched))
                   (touched (cdr new-touched)))
              (when (and touched new)
                (let ((old (gnus-score-get header)))
                  (mapc (lambda (what) (setq old (my-delete-all what old)))
                        (list match
                              (gnus-simplify-subject-re match)
                              (gnus-simplify-subject-fuzzy match)))
                  (gnus-score-set header (cons new old) nil t)
                  (gnus-score-set 'touched '(t))))
              new)))
         (t (apply f header match args)))))

;; the let'ing to nil of `gnus-summary-display-article-function'
;; in `gnus-summary-select-article' dates back to antiquity.
(add-function
 :around (symbol-function 'gnus-summary-display-article)
 (lambda (f &rest args)
   (cond ((nnhackernews--gate)
          (let ((gnus-summary-display-article-function
                 (symbol-function 'nnhackernews--display-article)))
            (apply f args)))
         (t (apply f args)))))

(add-function
 :around (symbol-function 'gnus-group-get-new-news-this-group)
 (lambda (f &rest args)
   "Semaphore down `nnhackernews-avoid-rescoring'."
   (let ((nnhackernews-avoid-rescoring t))
     (apply f args))))

;; disallow caching as firebase might change the article numbering?
(setq gnus-uncacheable-groups
      (aif gnus-uncacheable-groups
          (format "\\(%s\\)\\|\\(^nnhackernews\\)" it)
        "^nnhackernews"))

;; I would use custom-set-variables, but that mucks with the user's .emacs.
;; I suspect I did try putting this in `gnus-parameters' but out-of-band.
(let ((update-score-files
       (lambda (file)
	 (when (nnhackernews--gate)
	   (unless (member file (alist-get (intern gnus-newsgroup-name)
					   nnhackernews-score-files))
	     (push file (alist-get (intern gnus-newsgroup-name)
				   nnhackernews-score-files)))))))
  (if gnus-score-after-write-file-function
      (add-function :after gnus-score-after-write-file-function update-score-files)
    (setq gnus-score-after-write-file-function update-score-files)))

;; (push '((and (eq (car gnus-current-select-method) 'nnhackernews)
;;              (eq mark gnus-unread-mark)
;;              (not (string-match-p
;;                    "^Re: " (gnus-summary-article-subject))))
;;         . gnus-summary-high-unread)
;;       gnus-summary-highlight)

(provide 'nnhackernews)

;;; nnhackernews.el ends here
