Dev #10

Merged
dickmao merged 8 commits from dev into master 2019-11-11 17:36:26 +00:00
5 changed files with 123 additions and 113 deletions

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

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

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)
(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) (gnus-summary-read-group group nil t)
(nnhackernews--summary-exit)))))))) (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))))
@ -1009,7 +1025,10 @@ 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))))
(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))) (let* ((stories (or static-newstories (nnhackernews--request-newstories)))
(earliest-story (nth (1- (min nnhackernews-max-items-per-scan (earliest-story (nth (1- (min nnhackernews-max-items-per-scan
(length stories))) (length stories)))
@ -1044,7 +1063,7 @@ Optionally provide STATIC-MAX-ITEM and STATIC-NEWSTORIES to prevent querying out
(lambda (key value) (lambda (key value)
(setq result (concat result (format "%s +%s " key value)))) (setq result (concat result (format "%s +%s " key value))))
counts) counts)
result)))))) 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,6 +1375,7 @@ 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)
(nnhackernews--with-mutex nnhackernews--mutex-display-article
(condition-case err (condition-case err
(gnus-article-prepare article all-headers) (gnus-article-prepare article all-headers)
(error (error
@ -1364,7 +1385,7 @@ Optionally provide STATIC-MAX-ITEM and STATIC-NEWSTORIES to prevent querying out
(error-message-string err)) (error-message-string err))
(nnhackernews--fallback-link) (nnhackernews--fallback-link)
(gnus-article-prepare article all-headers)) (gnus-article-prepare article all-headers))
(error (error-message-string err)))))) (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)

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" \ !( cask emacs -Q --batch \
-l package-lint.el \
--visit "$1" \ --visit "$1" \
--eval "(checkdoc-eval-current-buffer)" \ --eval "(checkdoc-eval-current-buffer)" \
--eval "(princ (with-current-buffer checkdoc-diagnostic-buffer (buffer-string)))" \ --eval "(princ (with-current-buffer checkdoc-diagnostic-buffer \
2>&1 | egrep -a "^$BASENAME:" | egrep -v "Messages should start" && [ -n "${EMACS_LINT_IGNORE+x}" ] (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))"
# 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.
# 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"