diff --git a/.travis.yml b/.travis.yml index 0c3ad63..7bd98c0 100644 --- a/.travis.yml +++ b/.travis.yml @@ -38,7 +38,7 @@ matrix: - env: EMACS_CI=emacs-snapshot include: - 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 env: EMACS_CI=emacs-26-2 PY=python3 PIP="${PY} -m pip install --user" - os: osx @@ -50,4 +50,5 @@ before_script: - sh tools/install-cask.sh 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) diff --git a/Cask b/Cask index db399b2..b077980 100644 --- a/Cask +++ b/Cask @@ -1,3 +1,4 @@ +(source gnu) (source melpa) (package-file "nnhackernews.el") @@ -5,4 +6,5 @@ (development (depends-on "ert-runner") + (depends-on "package-lint") (depends-on "ecukes")) diff --git a/Makefile b/Makefile index 9125cb8..9fd7d77 100644 --- a/Makefile +++ b/Makefile @@ -39,8 +39,8 @@ clean: test-clean .PHONY: test-compile test-compile: - sh -e tools/package-lint.sh nnhackernews.el 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 clean-elc diff --git a/nnhackernews.el b/nnhackernews.el index d06406a..5253170 100644 --- a/nnhackernews.el +++ b/nnhackernews.el @@ -6,7 +6,7 @@ ;; Version: 0.1.0 ;; Keywords: news ;; 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. @@ -83,6 +83,10 @@ Do not set this to \"localhost\" as a numeric IP is required for the oauth hands (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--debug-request-items nil "Keep track of ids to re-request for testing.") @@ -563,6 +567,13 @@ Originally written by Paul Issartel." (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--rescore (group &optional force) "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)) (save-window-excursion (let ((gnus-auto-select-subject nil) - (gnus-summary-next-group-on-exit nil)) - (gnus-summary-read-group group nil t) - (nnhackernews--summary-exit)))))))) + (gnus-summary-next-group-on-exit nil) + (unread (length (gnus-list-of-unread-articles group)))) + (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 (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 (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)) + (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." @@ -1009,42 +1025,45 @@ Optionally provide STATIC-MAX-ITEM and STATIC-NEWSTORIES to prevent querying out ,nnhackernews--group-show ,nnhackernews--group-job ,nnhackernews--group-stories))) - (when-let ((max-item (or static-max-item (nnhackernews--request-max-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)))))) + (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) @@ -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)))) (url (replace-regexp-in-string path "/comment" url)) (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 (setq ret (and (eq tag 'html) (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 (lambda (article &optional all-headers _header) - (condition-case err - (gnus-article-prepare article all-headers) - (error - (if nnhackernews-render-story - (progn - (gnus-message 7 "nnhackernews--display-article: '%s' (falling back...)" - (error-message-string err)) - (nnhackernews--fallback-link) - (gnus-article-prepare article all-headers)) - (error (error-message-string err)))))) + (nnhackernews--with-mutex nnhackernews--mutex-display-article + (condition-case err + (gnus-article-prepare article all-headers) + (error + (if nnhackernews-render-story + (progn + (gnus-message 7 "nnhackernews--display-article: '%s' (falling back...)" + (error-message-string err)) + (nnhackernews--fallback-link) + (gnus-article-prepare article all-headers)) + (error (error-message-string err))))))) "In case of shr failures, dump original link.") (defsubst nnhackernews--dense-time (time) diff --git a/tools/package-lint.sh b/tools/package-lint.sh index c8f2af1..9b05007 100644 --- a/tools/package-lint.sh +++ b/tools/package-lint.sh @@ -1,47 +1,33 @@ -#!/bin/sh -ex +#!/bin/sh -e -# The following is a derivative work of -# https://github.com/purcell/package-lint -# licensed under GNU General Public License v3.0. +. tools/retry.sh 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") -"$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 -# Lint failures are ignored if EMACS_LINT_IGNORE is defined, so that lint -# failures on Emacs 24.2 and below don't cause the tests to fail, as these -# versions have buggy imenu that reports (defvar foo) as a definition of foo. +!( cask emacs -Q --batch \ + --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" | 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: # --eval "(fset 'package-lint--check-defs-prefix (symbol-function 'ignore))" \ -"$EMACS" -Q -batch \ - --eval "$INIT_PACKAGE_EL" \ - -l package-lint.el \ - -f package-lint-batch-and-exit \ - "$1" || [ -n "${EMACS_LINT_IGNORE+x}" ] +travis_retry cask emacs -Q --batch \ + -l package-lint \ + --eval "(package-initialize)" \ + --eval "(push (quote (\"melpa\" . \"http://melpa.org/packages/\")) \ + package-archives)" \ + --eval "(package-refresh-contents)" \ + -f package-lint-batch-and-exit "$1"