dickmao
/
nnhackernews
Protected
0
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Dev #10

Merged
dickmao merged 8 commits from dev into master 2019-11-11 17:36:26 +00:00
Conversation 0 Commits 8 Files Changed 5
5 changed files with 123 additions and 113 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

3
.travis.yml
View File

@ -38,7 +38,7 @@ matrix:
- env: EMACS_CI=emacs-snapshot - env: EMACS_CI=emacs-snapshot
include: include:
- os: linux - os: linux
env: EMACS_CI=emacs-25-1 PY=python PIP="${PY} -m pip install --user" env: EMACS_CI=emacs-25-2 PY=python PIP="${PY} -m pip install --user"
- os: linux - os: linux
env: EMACS_CI=emacs-26-2 PY=python3 PIP="${PY} -m pip install --user" env: EMACS_CI=emacs-26-2 PY=python3 PIP="${PY} -m pip install --user"
- os: osx - os: osx
@ -50,4 +50,5 @@ before_script:
- sh tools/install-cask.sh - sh tools/install-cask.sh
script: script:
- make test-install
- make test || ( ( printf "To diagnose, travis logs -i | dos2unix | sed '/^begin 644/,/^end/!d' | uudecode\n" ) && ( zip -q - tests/log/* 2>/dev/null | uuencode log.zip ) && false) - make test || ( ( printf "To diagnose, travis logs -i | dos2unix | sed '/^begin 644/,/^end/!d' | uudecode\n" ) && ( zip -q - tests/log/* 2>/dev/null | uuencode log.zip ) && false)

2
Cask
View File

@ -1,3 +1,4 @@
(source gnu)
(source melpa) (source melpa)
(package-file "nnhackernews.el") (package-file "nnhackernews.el")
@ -5,4 +6,5 @@
(development (development
(depends-on "ert-runner") (depends-on "ert-runner")
(depends-on "package-lint")
(depends-on "ecukes")) (depends-on "ecukes"))

2
Makefile
View File

@ -39,8 +39,8 @@ clean: test-clean
.PHONY: test-compile .PHONY: test-compile
test-compile: test-compile:
sh -e tools/package-lint.sh nnhackernews.el
cask install cask install
sh -ex tools/package-lint.sh nnhackernews.el
! (cask eval "(let ((byte-compile-error-on-warn t)) (cask-cli/build))" 2>&1 | egrep -a "(Warning|Error):") ! (cask eval "(let ((byte-compile-error-on-warn t)) (cask-cli/build))" 2>&1 | egrep -a "(Warning|Error):")
cask clean-elc cask clean-elc

163
nnhackernews.el
View File

@ -6,7 +6,7 @@
;; Version: 0.1.0 ;; Version: 0.1.0
;; Keywords: news ;; Keywords: news
;; URL: https://github.com/dickmao/nnhackernews ;; URL: https://github.com/dickmao/nnhackernews
;; Package-Requires: ((emacs "25.1") (request "20190819") (dash "20190401") (dash-functional "20180107") (anaphora "20180618")) ;; Package-Requires: ((emacs "25.2") (request "20190819") (dash "20190401") (dash-functional "20180107") (anaphora "20180618"))
;; This file is NOT part of GNU Emacs. ;; This file is NOT part of GNU Emacs.
@ -83,6 +83,10 @@ Do not set this to \"localhost\" as a numeric IP is required for the oauth hands
(defvoo nnhackernews-status-string "") (defvoo nnhackernews-status-string "")
(defvar nnhackernews--mutex-display-article (when (fboundp 'make-mutex)
(make-mutex "nnhackernews--mutex-display-article"))
"Scoring runs via `gnus-after-getting-new-news-hook' cause 'Selecting deleted buffer'.")
(defvar nnhackernews--last-item nil "Keep track of where we are.") (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--debug-request-items nil "Keep track of ids to re-request for testing.")
@ -563,6 +567,13 @@ Originally written by Paul Issartel."
(error nil)) (error nil))
t)) 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--rescore (group &optional force) (defun nnhackernews--rescore (group &optional force)
"Can't figure out GROUP hook that can remove itself (quine conundrum). "Can't figure out GROUP hook that can remove itself (quine conundrum).
@ -586,9 +597,14 @@ FORCE is generally t unless coming from `nnhackernews--score-pending'."
(when (or force (> num-headers seen)) (when (or force (> num-headers seen))
(save-window-excursion (save-window-excursion
(let ((gnus-auto-select-subject nil) (let ((gnus-auto-select-subject nil)
(gnus-summary-next-group-on-exit nil)) (gnus-summary-next-group-on-exit nil)
(gnus-summary-read-group group nil t) (unread (length (gnus-list-of-unread-articles group))))
(nnhackernews--summary-exit)))))))) (if (zerop unread)
(gnus-message 7 "nnhackernews--rescore: skipping %s no unread"
group)
(nnhackernews--with-mutex nnhackernews--mutex-display-article
(gnus-summary-read-group group nil t)
(nnhackernews--summary-exit))))))))))
(defalias 'nnhackernews--score-pending (defalias 'nnhackernews--score-pending
(lambda (&rest _args) (nnhackernews--rescore (gnus-group-name-at-point)))) (lambda (&rest _args) (nnhackernews--rescore (gnus-group-name-at-point))))
@ -680,26 +696,26 @@ The two hashtables being reconciled are `nnhackernews-location-hashtb' and
;; nnhackernews-request-group ;; nnhackernews-request-group
(deffoo nnhackernews-request-group (group &optional server _fast info) (deffoo nnhackernews-request-group (group &optional server _fast info)
(nnhackernews--normalize-server) (nnhackernews--normalize-server)
(nnhackernews--with-group group (nnhackernews--with-group group
(let* ((info (or info (gnus-get-info gnus-newsgroup-name))) (let* ((info (or info (gnus-get-info gnus-newsgroup-name)))
(headers (nnhackernews-get-headers group)) (headers (nnhackernews-get-headers group))
(first-header (1+ (or (-find-index #'identity headers) 0))) (first-header (1+ (or (-find-index #'identity headers) 0)))
(last-header (length headers)) (last-header (length headers))
(num-headers (if (> first-header last-header) 0 (num-headers (if (> first-header last-header) 0
(1+ (- last-header first-header)))) (1+ (- last-header first-header))))
(status (format "211 %d %d %d %s" (status (format "211 %d %d %d %s"
num-headers first-header last-header group))) num-headers first-header last-header group)))
(gnus-message 7 "nnhackernews-request-group: %s" status) (gnus-message 7 "nnhackernews-request-group: %s" status)
(nnheader-insert "%s\n" status) (nnheader-insert "%s\n" status)
(when info (when info
(gnus-info-set-marks (gnus-info-set-marks
info info
(append (assq-delete-all 'seen (gnus-info-marks info)) (append (assq-delete-all 'seen (gnus-info-marks info))
(list `(seen (1 . ,num-headers)))) (list `(seen (1 . ,num-headers))))
t) t)
(gnus-info-set-method info (gnus-group-method gnus-newsgroup-name) t) (gnus-info-set-method info (gnus-group-method gnus-newsgroup-name) t)
(gnus-set-info gnus-newsgroup-name info))) (gnus-set-info gnus-newsgroup-name info)))
t)) t))
(defsubst nnhackernews--json-read () (defsubst nnhackernews--json-read ()
"Copied from ein:json-read() by tkf." "Copied from ein:json-read() by tkf."
@ -1009,42 +1025,45 @@ Optionally provide STATIC-MAX-ITEM and STATIC-NEWSTORIES to prevent querying out
,nnhackernews--group-show ,nnhackernews--group-show
,nnhackernews--group-job ,nnhackernews--group-job
,nnhackernews--group-stories))) ,nnhackernews--group-stories)))
(when-let ((max-item (or static-max-item (nnhackernews--request-max-item)))) (let ((max-item (or static-max-item (nnhackernews--request-max-item))))
(let* ((stories (or static-newstories (nnhackernews--request-newstories))) (if (and nnhackernews--last-item (<= max-item nnhackernews--last-item))
(earliest-story (nth (1- (min nnhackernews-max-items-per-scan (gnus-message 7 "nnhackernews--incoming: max %s <= last %s"
(length stories))) max-item nnhackernews--last-item)
stories)) (let* ((stories (or static-newstories (nnhackernews--request-newstories)))
(start-item (if nnhackernews--last-item (earliest-story (nth (1- (min nnhackernews-max-items-per-scan
(1+ nnhackernews--last-item) (length stories)))
(min earliest-story stories))
(- max-item nnhackernews-max-items-per-scan)))) (start-item (if nnhackernews--last-item
(counts (gnus-make-hashtable)) (1+ nnhackernews--last-item)
(items (nnhackernews--select-items start-item max-item stories))) (min earliest-story
(dolist (item items) (- max-item nnhackernews-max-items-per-scan))))
(-when-let* ((plst (nnhackernews--request-item item)) (counts (gnus-make-hashtable))
(not-deleted (not (plist-get plst :deleted))) (items (nnhackernews--select-items start-item max-item stories)))
(type (plist-get plst :type))) (dolist (item items)
(nnhackernews-add-entry nnhackernews-refs-hashtb plst :parent) (-when-let* ((plst (nnhackernews--request-item item))
(nnhackernews-add-entry nnhackernews-authors-hashtb plst :by) (not-deleted (not (plist-get plst :deleted)))
(nnhackernews--replace-hash type (lambda (x) (1+ (or x 0))) counts) (type (plist-get plst :type)))
(setq plst (plist-put plst :link_title (nnhackernews-add-entry nnhackernews-refs-hashtb plst :parent)
(or (plist-get (nnhackernews-add-entry nnhackernews-authors-hashtb plst :by)
(nnhackernews--retrieve-root plst) (nnhackernews--replace-hash type (lambda (x) (1+ (or x 0))) counts)
:title) ""))) (setq plst (plist-put plst :link_title
(cl-case (intern type) (or (plist-get
(job (nnhackernews--append-header plst nnhackernews--group-job)) (nnhackernews--retrieve-root plst)
((story comment) (nnhackernews--append-header plst)) :title) "")))
(otherwise (gnus-message 5 "nnhackernews-incoming: ignoring type %s" type))))) (cl-case (intern type)
(setq nnhackernews--last-item max-item) (job (nnhackernews--append-header plst nnhackernews--group-job))
(gnus-message ((story comment) (nnhackernews--append-header plst))
5 (concat "nnhackernews--incoming: " (otherwise (gnus-message 5 "nnhackernews-incoming: ignoring type %s" type)))))
(format "%d requests, " (length nnhackernews--debug-request-items)) (setq nnhackernews--last-item max-item)
(let ((result "")) (gnus-message
(nnhackernews--maphash 5 (concat "nnhackernews--incoming: "
(lambda (key value) (format "%d requests, " (length nnhackernews--debug-request-items))
(setq result (concat result (format "%s +%s " key value)))) (let ((result ""))
counts) (nnhackernews--maphash
result)))))) (lambda (key value)
(setq result (concat result (format "%s +%s " key value))))
counts)
result)))))))
(deffoo nnhackernews-request-scan (&optional group server) (deffoo nnhackernews-request-scan (&optional group server)
(nnhackernews--normalize-server) (nnhackernews--normalize-server)
@ -1298,7 +1317,8 @@ Optionally provide STATIC-MAX-ITEM and STATIC-NEWSTORIES to prevent querying out
(let* ((path (car (url-path-and-query (url-generic-parse-url url)))) (let* ((path (car (url-path-and-query (url-generic-parse-url url))))
(url (replace-regexp-in-string path "/comment" url)) (url (replace-regexp-in-string path "/comment" url))
(result (nnhackernews--request-reply url body hidden)) (result (nnhackernews--request-reply url body hidden))
(dom (nnhackernews--domify result))) dom)
(setq dom (nnhackernews--domify result))
(cl-destructuring-bind (tag params &rest args) dom (cl-destructuring-bind (tag params &rest args) dom
(setq ret (and (eq tag 'html) (setq ret (and (eq tag 'html)
(string= (alist-get 'op params) "item"))) (string= (alist-get 'op params) "item")))
@ -1355,16 +1375,17 @@ Optionally provide STATIC-MAX-ITEM and STATIC-NEWSTORIES to prevent querying out
(defalias 'nnhackernews--display-article (defalias 'nnhackernews--display-article
(lambda (article &optional all-headers _header) (lambda (article &optional all-headers _header)
(condition-case err (nnhackernews--with-mutex nnhackernews--mutex-display-article
(gnus-article-prepare article all-headers) (condition-case err
(error (gnus-article-prepare article all-headers)
(if nnhackernews-render-story (error
(progn (if nnhackernews-render-story
(gnus-message 7 "nnhackernews--display-article: '%s' (falling back...)" (progn
(error-message-string err)) (gnus-message 7 "nnhackernews--display-article: '%s' (falling back...)"
(nnhackernews--fallback-link) (error-message-string err))
(gnus-article-prepare article all-headers)) (nnhackernews--fallback-link)
(error (error-message-string err)))))) (gnus-article-prepare article all-headers))
(error (error-message-string err)))))))
"In case of shr failures, dump original link.") "In case of shr failures, dump original link.")
(defsubst nnhackernews--dense-time (time) (defsubst nnhackernews--dense-time (time)

66
tools/package-lint.sh
View File

@ -1,47 +1,33 @@
#!/bin/sh -ex #!/bin/sh -e
# The following is a derivative work of . tools/retry.sh
# https://github.com/purcell/package-lint
# licensed under GNU General Public License v3.0.
EMACS="${EMACS:=emacs}" EMACS="${EMACS:=emacs}"
INIT_PACKAGE_EL="(progn
(require 'package)
(push '(\"melpa\" . \"http://melpa.org/packages/\") package-archives)
(package-initialize)
(package-refresh-contents))"
# rm -rf "$HOME"/.emacs.d/elpa/package-lint-*
# Get mainline package-lint, then replace package-lint.el with dickmao's.
# quelpa doesn't get data/stdlib-changes.gz for whatever reason.
( cd /tmp ; curl -OskL https://raw.githubusercontent.com/dickmao/package-lint/datetime/package-lint.el )
"$EMACS" -Q -batch \
--eval "$INIT_PACKAGE_EL" \
--eval "(package-install (quote package-lint))" \
--eval "(let ((dir (file-name-directory (locate-library \"package-lint\")))) \
(ignore-errors (delete-file (expand-file-name \"package-lint.elc\" dir))) \
(copy-file (expand-file-name \"package-lint.el\" \
\"/tmp\") (expand-file-name \"package-lint.el\" dir) t))"
BASENAME=$(basename "$1") BASENAME=$(basename "$1")
"$EMACS" -Q -batch \
--eval "$INIT_PACKAGE_EL" \
-l package-lint.el \
--visit "$1" \
--eval "(checkdoc-eval-current-buffer)" \
--eval "(princ (with-current-buffer checkdoc-diagnostic-buffer (buffer-string)))" \
2>&1 | egrep -a "^$BASENAME:" | egrep -v "Messages should start" && [ -n "${EMACS_LINT_IGNORE+x}" ]
# Lint ourselves !( cask emacs -Q --batch \
# Lint failures are ignored if EMACS_LINT_IGNORE is defined, so that lint --visit "$1" \
# failures on Emacs 24.2 and below don't cause the tests to fail, as these --eval "(checkdoc-eval-current-buffer)" \
# versions have buggy imenu that reports (defvar foo) as a definition of foo. --eval "(princ (with-current-buffer checkdoc-diagnostic-buffer \
(buffer-string)))" \
2>&1 | egrep -a "^$BASENAME:" | egrep -v "Messages should start" | grep "." )
# this repo uses datetime versions
( cd /tmp ; travis_retry curl -OskL https://raw.githubusercontent.com/dickmao/package-lint/datetime/package-lint.el )
cask emacs -Q --batch \
--eval "(let ((dir (file-name-directory (locate-library \"package-lint\")))) \
(ignore-errors (delete-file (expand-file-name \
\"package-lint.elc\" dir))) \
(copy-file (expand-file-name \"package-lint.el\" \"/tmp\") \
(expand-file-name \"package-lint.el\" dir) t))"
# Reduce purity via: # Reduce purity via:
# --eval "(fset 'package-lint--check-defs-prefix (symbol-function 'ignore))" \ # --eval "(fset 'package-lint--check-defs-prefix (symbol-function 'ignore))" \
"$EMACS" -Q -batch \ travis_retry cask emacs -Q --batch \
--eval "$INIT_PACKAGE_EL" \ -l package-lint \
-l package-lint.el \ --eval "(package-initialize)" \
-f package-lint-batch-and-exit \ --eval "(push (quote (\"melpa\" . \"http://melpa.org/packages/\")) \
"$1" || [ -n "${EMACS_LINT_IGNORE+x}" ] package-archives)" \
--eval "(package-refresh-contents)" \
-f package-lint-batch-and-exit "$1"