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

Add Requirements to docs #6

Closed
ksonney wants to merge 0 commits from docUpdate into master
pull from: docUpdate
merge into: dickmao:master
Conversation 1 Commits - Files Changed 20
20 changed files with 522 additions and 513 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

63
.github/workflows/test.yml vendored
View File

@ -1,31 +1,32 @@
name: CI
on:
pull_request:
paths-ignore:
- '**.md'
- '**.rst'
push:
paths-ignore:
- '**.md'
- '**.rst'
branches-ignore:
- 'master'
- 'main'
jobs:
build:
runs-on: ${{ matrix.os }}
strategy:
matrix:
os: [ubuntu-latest]
emacs_version: [27.2, 28.2, 29.2]
os: [ubuntu-latest, macos-latest]
emacs_version: [25.1, 26.3]
ruby_version: [2.6]
include:
- emacs_version: 24.1
lint_ignore: 1
- emacs_version: 24.2
lint_ignore: 1
env:
EMACS_LINT_IGNORE: ${{ matrix.lint_ignore }}
steps:
- uses: actions/checkout@v2
- uses: ruby/setup-ruby@v1
- uses: actions/setup-ruby@v1
with:
ruby-version: ${{ matrix.ruby_version }}
@ -33,58 +34,38 @@ jobs:
with:
version: ${{ matrix.emacs_version }}
- uses: actions/cache@v2
id: cache-cask-packages
- uses: dickmao/setup-paths@master
with:
path: .cask
key: cache-cask-packages-000
paths: local/bin:local/cask/bin
- uses: actions/cache@v2
id: cache-cask-executable
with:
path: ~/.cask
key: cache-cask-executable-000
- uses: conao3/setup-cask@master
if: steps.cache-cask-executable.outputs.cache-hit != 'true'
with:
version: snapshot
- name: paths
run: |
echo "$HOME/local/bin" >> $GITHUB_PATH
echo "$HOME/.cask/bin" >> $GITHUB_PATH
echo "$HOME/.local/bin" >> $GITHUB_PATH
echo "LD_LIBRARY_PATH=$HOME/.local/lib" >> $GITHUB_ENV
- uses: actions/cache@v2
- uses: actions/cache@v1
if: startsWith(runner.os, 'Linux')
with:
path: ~/.cache/rubocop_cache
key: ${{ runner.os }}-rubocop
- uses: actions/cache@v2
- uses: actions/cache@v1
if: startsWith(runner.os, 'macOS')
with:
path: ~/Library/Caches/rubocop_cache
key: ${{ runner.os }}-rubocop
- uses: actions/cache@v2
- uses: actions/cache@v1
with:
path: ~/local
key: ${{ runner.os }}-local-000
- uses: actions/cache@v2
- uses: actions/cache@v1
with:
path: ~/.emacs.d
key: emacs.d
- uses: actions/cache@v2
- uses: actions/cache@v1
with:
path: ~/.cask
key: cask-000
- uses: actions/cache@v2
- uses: actions/cache@v1
with:
path: nndiscourse/vendor/bundle
key: ${{ runner.os }}-gems-${{ hashFiles('**/Gemfile.lock') }}
@ -93,7 +74,7 @@ jobs:
- name: bundler
run: |
gem install --user-install bundler:2.0.2
gem install --user-install bundler
- name: apt-get
if: startsWith(runner.os, 'Linux')
@ -114,7 +95,11 @@ jobs:
emacs --version
gpg --version
- name: cask
run: |
sh tools/install-cask.sh
cask link list
- name: test
run: |
make test-run
make test

2
Cask
View File

@ -2,7 +2,7 @@
(source melpa)
(package-file "nndiscourse.el")
(files "nndiscourse.el" ("nndiscourse" "nndiscourse/.ruby-version" "nndiscourse/Gemfile" "nndiscourse/Gemfile.lock" "nndiscourse/nndiscourse.gemspec" "nndiscourse/nndiscourse.thor" "nndiscourse/lib"))
(files "nndiscourse.el" ("nndiscourse" "nndiscourse/Gemfile" "nndiscourse/Gemfile.lock" "nndiscourse/nndiscourse.gemspec" "nndiscourse/nndiscourse.thor" "nndiscourse/lib"))
(development
(depends-on "ert-runner")

85
Makefile
View File

@ -27,19 +27,11 @@ README.rst: README.in.rst nndiscourse.el
clean:
$(CASK) clean-elc
$(MAKE) -C nndiscourse $@
rm -f ert-profile*
rm -f tests/log/*
rm -rf tests/test-install
.PHONY: bundler
bundler:
$(MAKE) $(HOME)/.gem/ruby/2.6.0/gems/bundler-2.0.2/bundler.gemspec
$(HOME)/.gem/ruby/2.6.0/gems/bundler-2.0.2/bundler.gemspec:
cd nndiscourse ; gem install --user-install bundler:2.0.2
.PHONY: cask
cask: bundler $(CASK_DIR)
cask: $(CASK_DIR)
$(CASK_DIR): Cask
$(CASK) install
@ -47,57 +39,48 @@ $(CASK_DIR): Cask
.PHONY: test-compile
test-compile: cask autoloads
$(MAKE) -C nndiscourse $@
sh -e tools/package-lint.sh ./nndiscourse.el
! ($(CASK) eval "(let ((byte-compile-error-on-warn t)) (cask-cli/build))" 2>&1 | egrep -a "(Warning|Error):") ; (ret=$$? ; $(CASK) clean-elc && exit $$ret)
! ($(CASK) eval \
"(cl-letf (((symbol-function (quote cask-files)) (lambda (&rest _args) (mapcar (function symbol-name) (quote ($(TESTSSRC))))))) \
(let ((byte-compile-error-on-warn t)) (cask-cli/build)))" 2>&1 | egrep -a "(Warning|Error):") ; (ret=$$? ; rm -f $(ELCTESTS) && exit $$ret)
TESTFILES = $(shell $(CASK) files)
$(MAKE) -C nndiscourse $@
sh -e tools/package-lint.sh ./nndiscourse.el
! ($(CASK) eval "(let ((byte-compile-error-on-warn t)) (cask-cli/build))" 2>&1 | egrep -a "(Warning|Error):") ; (ret=$$? ; $(CASK) clean-elc && exit $$ret)
define TESTRUN
--eval "(custom-set-variables \
(backquote (nndiscourse-test-dir ,(file-name-as-directory (make-temp-file \"testrun-\" t)))) \
(quote (gnus-select-method (quote (nndiscourse \"meta.discourse.org\" (nndiscourse-scheme \"https\"))))) \
(quote (gnus-verbose 8)))" \
(quote (gnus-select-method (quote (nndiscourse \"\")))) \
(backquote (venv-location ,(file-name-as-directory (make-temp-file \"testrun-\" t)))) \
(quote (gnus-verbose 8)) \
(quote (nndiscourse-log-rpc t)))" \
--eval "(setq debug-on-error t)" \
--eval "(fset (quote gnus-y-or-n-p) (function ignore))" \
--eval "(dolist (f (mapcar (function symbol-name) (quote ($(TESTFILES))))) \
(let* ((parent (file-name-directory f)) \
(dest (concat (file-name-as-directory nndiscourse-test-dir) (or parent \".\")))) \
(make-directory dest t) \
(funcall (if (file-directory-p f) (function copy-directory) (function copy-file)) f (concat (file-name-as-directory dest) (file-name-nondirectory f)))))"
--eval "(fset (quote gnus-y-or-n-p) (function ignore))"
endef
.PHONY: test-run
test-run: cask
$(CASK) emacs -Q --batch -l nndiscourse \
test-run:
$(CASK) emacs -Q --batch \
$(TESTRUN) \
--eval "(gnus-open-server gnus-select-method)" \
--eval "(sleep-for .43)" \
--eval "(cl-assert nndiscourse-processes)" \
--eval "(nndiscourse-dump-diagnostics (nth 1 gnus-select-method))"
--eval "(require 'nndiscourse)" \
--eval "(cl-assert (nndiscourse-rpc-get))" \
--eval "(sleep-for 0 7300)" \
-f nndiscourse-dump-diagnostics \
--eval "(cl-assert nndiscourse-processes)"
.PHONY: test-run-interactive
test-run-interactive: cask autoloads
$(CASK) emacs -Q -l nndiscourse \
test-run-interactive:
$(CASK) emacs -Q \
$(TESTRUN) \
-f gnus
.PHONY: test-unit
test-unit: cask autoloads
test-unit:
$(CASK) exec ert-runner -L . -L tests $(TESTS)
.PHONY: test-clean
test-clean:
rm -rf tests/.emacs* tests/.newsrc* tests/Mail tests/News tests/request tests/request-log
.PHONY: test
test: test-compile test-unit test-int
.PHONY: test-int
test-int: test-clean
test-int:
rm -f tests/.newsrc.eld
$(CASK) exec ecukes --debug --reporter magnars
@ -109,9 +92,31 @@ dist-clean:
dist: dist-clean
$(CASK) package
.PHONY: backup-melpa
backup-melpa:
$(EMACS) -Q --batch --eval "(package-initialize)" --eval \
"(with-temp-buffer \
(insert-file-contents-literally (car (file-expand-wildcards \"dist/nndiscourse-$(VERSION).tar\"))) \
(tar-mode) \
(let* ((my-desc (package-tar-file-info)) \
(name (package-desc-name my-desc)) \
(other-pkgs (cdr (assq name package-alist)))) \
(when other-pkgs \
(mapcar (lambda (odesc) \
(let* ((odir (package-desc-dir odesc)) \
(parent (file-name-directory odir)) \
(leaf (file-name-nondirectory odir))) \
(if (equal (package-desc-version my-desc) \
(package-desc-version odesc)) \
(delete-directory odir t) \
(rename-file odir \
(expand-file-name (format \"BACKUP-%s\" leaf) parent) \
t)))) \
other-pkgs))))"
.PHONY: install
install: dist bundler
$(EMACS) -Q --batch -l package \
--eval "(add-to-list 'package-archives '(\"melpa\" . \"https://melpa.org/packages/\"))" \
install: dist backup-melpa
$(EMACS) -Q --batch --eval "(package-initialize)" \
--eval "(add-to-list 'package-archives '(\"melpa\" . \"http://melpa.org/packages/\"))" \
--eval "(package-refresh-contents)" \
--eval "(package-install-file (car (file-expand-wildcards \"dist/nndiscourse-$(VERSION).tar\")))"

53
README.in.rst
View File

@ -1,43 +1,48 @@
|build-status| |melpa-dev|
|build-status|
.. COMMENTARY (see Makefile)
.. |build-status|
image:: https://github.com/dickmao/nndiscourse/workflows/CI/badge.svg?branch=dev
image:: https://github.com/dickmao/nndiscourse/workflows/CI/badge.svg
:target: https://github.com/dickmao/nndiscourse/actions
:alt: Build Status
.. |melpa-dev|
image:: https://melpa.org/packages/nndiscourse-badge.svg
:target: http://melpa.org/#/nndiscourse
:alt: MELPA current version
.. image:: https://github.com/dickmao/gnus-imap-walkthrough/blob/master/thumbnail.png
:target: https://youtu.be/DMpZtC98F_M
:alt: Replacing Thunderbird With Gnus
image:: http://melpa.milkbox.net/packages/nndiscourse-badge.svg
:target: http://melpa.milkbox.net/#/nndiscourse
:alt: MELPA development version
.. image:: screenshot.png
.. |--| unicode:: U+2013 .. en dash
.. |---| unicode:: U+2014 .. em dash, trimming surrounding whitespace
:trim:
Does not work for sites requiring login
=======================================
Some discourse instances allow unfettered public viewing, e.g.,
``emacs-china.org``, ``devforum.roblox.com``. Others require login, e.g.,
``discourse.doomemacs.org``. At the time I wrote nndiscourse, it was
impossible to get login going, and while `it does seem possible now
<https://meta.discourse.org/t/user-api-keys-specification/48536/33?u=dickmao>`_,
it still looks really hard and undocumented.
Requirements
dickmao commented 2020-03-01 19:27:53 +00:00 (Migrated from github.com)
Review

rbenv.el should be gotten automatically, and I'm not completely sure rbenv is required.
bundler is required, and I will perhaps address this explicitly if this package gets any attention. Thank you for your early interest.

`rbenv.el` should be gotten automatically, and I'm not completely sure rbenv is required. bundler is required, and I will perhaps address this explicitly if this package gets any attention. Thank you for your early interest.
============
- `rbenv`_
- `rbenv.el`_
- `bundler`_
.. _rbenv: https://github.com/rbenv/rbenv
.. _rbenv.el: https://github.com/senny/rbenv.el
.. _bundler: https://bundler.io/
Install
=======
Alas, you'll need Cask_. Then,
As described in `Getting started`_, ensure melpa's whereabouts in ``init.el`` or ``.emacs``::
(add-to-list 'package-archives '("melpa" . "https://melpa.org/packages/"))
Then
::
rbenv install 2.6.2
git clone https://github.com/dickmao/nndiscourse.git
make -C nndiscourse install
M-x package-refresh-contents RET
M-x package-initialize RET
M-x package-install RET nndiscourse RET
Alternatively, directly clone this repo and ``make install``.
Also see Troubleshooting_.
Usage
=====
@ -67,5 +72,9 @@ From the summary buffer, ``/o`` redisplays posts already read. ``x`` undisplays
Gnus beginners may find the interface bewildering. In particular, categories with no unread posts do not display. Use ``L`` to bring them out of hiding.
.. _Cask: https://github.com/cask/cask
Troubleshooting
===============
Clone this repo. Then install Cask_. Then try ``make test-run-interactive``.
.. _Cask: https://cask.readthedocs.io/en/latest/guide/installation.html
.. _Getting started: http://melpa.org/#/getting-started

53
README.rst
View File

@ -1,42 +1,47 @@
|build-status| |melpa-dev|
|build-status|
dickmao commented 2020-03-01 19:25:06 +00:00 (Migrated from github.com)
Review

It appears when you make README.rst, the logic to extract commentary from nndiscourse.el got lost.

It appears when you `make README.rst`, the logic to extract commentary from `nndiscourse.el` got lost.
.. |build-status|
image:: https://github.com/dickmao/nndiscourse/workflows/CI/badge.svg?branch=dev
image:: https://github.com/dickmao/nndiscourse/workflows/CI/badge.svg
:target: https://github.com/dickmao/nndiscourse/actions
:alt: Build Status
.. |melpa-dev|
image:: https://melpa.org/packages/nndiscourse-badge.svg
:target: http://melpa.org/#/nndiscourse
:alt: MELPA current version
.. image:: https://github.com/dickmao/gnus-imap-walkthrough/blob/master/thumbnail.png
:target: https://youtu.be/DMpZtC98F_M
:alt: Replacing Thunderbird With Gnus
image:: http://melpa.milkbox.net/packages/nndiscourse-badge.svg
:target: http://melpa.milkbox.net/#/nndiscourse
:alt: MELPA development version
.. image:: screenshot.png
.. |--| unicode:: U+2013 .. en dash
.. |---| unicode:: U+2014 .. em dash, trimming surrounding whitespace
:trim:
Does not work for sites requiring login
=======================================
Some discourse instances allow unfettered public viewing, e.g.,
``emacs-china.org``, ``devforum.roblox.com``. Others require login, e.g.,
``discourse.doomemacs.org``. At the time I wrote nndiscourse, it was
impossible to get login going, and while `it does seem possible now
<https://meta.discourse.org/t/user-api-keys-specification/48536/33?u=dickmao>`_,
it still looks really hard and undocumented.
Requirements
============
- `rbenv`_
- `rbenv.el`_
- `bundler`_
.. _rbenv: https://github.com/rbenv/rbenv
.. _rbenv.el: https://github.com/senny/rbenv.el
.. _bundler: https://bundler.io/
Install
=======
Alas, you'll need Cask_. Then,
As described in `Getting started`_, ensure melpa's whereabouts in ``init.el`` or ``.emacs``::
(add-to-list 'package-archives '("melpa" . "https://melpa.org/packages/"))
Then
::
rbenv install 2.6.2
git clone https://github.com/dickmao/nndiscourse.git
make -C nndiscourse install
M-x package-refresh-contents RET
M-x package-initialize RET
M-x package-install RET nndiscourse RET
Alternatively, directly clone this repo and ``make install``.
Also see Troubleshooting_.
Usage
=====
@ -66,5 +71,9 @@ From the summary buffer, ``/o`` redisplays posts already read. ``x`` undisplays
Gnus beginners may find the interface bewildering. In particular, categories with no unread posts do not display. Use ``L`` to bring them out of hiding.
.. _Cask: https://github.com/cask/cask
Troubleshooting
===============
Clone this repo. Then install Cask_. Then try ``make test-run-interactive``.
.. _Cask: https://cask.readthedocs.io/en/latest/guide/installation.html
.. _Getting started: http://melpa.org/#/getting-started

2
features/rpc.feature
View File

@ -9,7 +9,7 @@ Scenario: install
And I go to word "david"
And I press "RET"
And I switch to buffer "*Article nndiscourse+meta.discourse.org:bug*"
Then I should see "hartz"
Then I should see "Recent Changes"
And prospective unreads for "nndiscourse+meta.discourse.org:bug" is 1
And I switch to buffer "*Summary nndiscourse+meta.discourse.org:bug*"
And I press "q"

10
features/step-definitions/nndiscourse-steps.el
View File

@ -37,7 +37,7 @@
(When "^gnus \\(try \\)?start\\(\\)$"
(lambda (demote _workaround)
(if-let ((it (get-buffer gnus-group-buffer)))
(aif (get-buffer gnus-group-buffer)
(switch-to-buffer it)
(if-demote demote
(When "I call \"gnus\"")
@ -45,10 +45,10 @@
(When "^gnus stop$"
(lambda ()
(when-let ((it (get-buffer gnus-group-buffer)))
(switch-to-buffer it)
(And "I press \"q\"")
(switch-to-buffer "*scratch*"))))
(aif (get-buffer gnus-group-buffer)
(progn (switch-to-buffer it)
(And "I press \"q\"")
(switch-to-buffer "*scratch*")))))
(When "^I open latest \"\\(.+\\)\"$"
(lambda (relative-prefix)

8
features/support/env.el
View File

@ -28,9 +28,8 @@
,@forms))
(defun cleanup ()
(let ((quick-file (concat (or (bound-and-true-p gnus-newsrc-file)
(bound-and-true-p gnus-current-startup-file))
".eld")))
(let* ((newsrc-file gnus-current-startup-file)
(quick-file (concat newsrc-file ".eld")))
(when (file-exists-p quick-file)
(message "Deleting %s" quick-file)
(delete-file quick-file))))
@ -71,8 +70,7 @@
,@body))
(Before
(dolist (server (mapcar #'car nndiscourse-processes))
(setf (nndiscourse-by-server server :last-scan-time) 0))
(setq nndiscourse--last-scan-time 0)
(setq ecukes-reporter-before-scenario-hook
(lambda (scenario)
(with-scenario scenario

630
nndiscourse.el
View File

@ -6,7 +6,7 @@
;; Version: 0.1.0
;; Keywords: news
;; URL: https://github.com/dickmao/nndiscourse
;; Package-Requires: ((emacs "27.1") (rbenv "0.0.3") (json-rpc "0.0.1"))
;; Package-Requires: ((emacs "25.1") (dash "2.16") (dash-functional "1.2.0") (anaphora "1.0.4") (rbenv "0.0.3"))
;; This file is NOT part of GNU Emacs.
@ -29,9 +29,6 @@
;;; Code:
(eval-when-compile (require 'cl-lib)
(cl-assert (fboundp 'libxml-parse-html-region) nil
"nndiscourse requires emacs built with libxml support"))
(require 'nnoo)
(require 'gnus)
(require 'gnus-start)
@ -47,6 +44,9 @@
(require 'cl-lib)
(require 'json)
(require 'subr-x)
(require 'dash)
(require 'dash-functional)
(require 'anaphora)
(require 'json-rpc)
(require 'rbenv)
@ -57,11 +57,6 @@
(defvoo nndiscourse-scheme "https"
"URI scheme for address.")
(defcustom nndiscourse-test-dir nil
"Test bundler install from here (see Makefile)."
:type 'directory
:group 'nndiscourse)
(defcustom nndiscourse-render-post t
"If non-nil, follow link upon `gnus-summary-select-article'.
Otherwise, just display link."
@ -78,53 +73,14 @@ Otherwise, just display link."
:type 'string
:group 'nndiscourse)
(defvoo nndiscourse-status-string "" "Out-of-band message.")
(defvar nndiscourse-status-string "" "Out-of-band message.")
(defvar nndiscourse-by-server-hashtb (gnus-make-hashtable))
(defvar nndiscourse--last-id nil "Keep track of where we are.")
(defsubst nndiscourse--gethash (string hashtable &optional dflt)
"Get value of STRING from HASHTABLE, or DFLT if undefined.
Starting in emacs-src commit c1b63af, Gnus moved from obarrays
to normal hashtables."
(unless (stringp string)
(setq string (format "%s" string)))
(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)))
(defvar nndiscourse--debug-request-posts nil "Keep track of ids to re-request for testing.")
(defmacro nndiscourse--sethash (string value hashtable)
"Set value of STRING to VALUE in HASHTABLE.
Starting in emacs-src commit c1b63af, Gnus moved from obarrays
to normal hashtables."
(declare (indent defun))
`(,(if (fboundp 'gnus-sethash)
'gnus-sethash
'puthash)
(format "%s" ,string) ,value ,hashtable))
(defmacro nndiscourse-by-server (server key)
"Get generalized variable for SERVER value of KEY.
Thought I could use macros here to setf it."
`(let ((foo (nndiscourse--gethash ,server nndiscourse-by-server-hashtb)))
(alist-get ,key foo)))
(defun nndiscourse-obarrayp (obj)
"Return t if OBJ is an obarray. `obarrayp' did not exist in emacs-25."
(and (vectorp obj) (< 0 (length obj))))
(defun nndiscourse-by-server-initial ()
"Ensure deep copy of seed values for `nndiscourse-by-server'."
(mapcar (lambda (x) (cons (car x)
(if (nndiscourse-obarrayp (cdr x)) (copy-sequence (cdr x))
(if (hash-table-p (cdr x))
(copy-hash-table (cdr x))
(cdr x)))))
`((:last-id . nil)
(:last-scan-time . ,(- (truncate (float-time)) 100))
(:headers-hashtb . ,(gnus-make-hashtable))
(:refs-hashtb . ,(gnus-make-hashtable))
(:categories-hashtb . ,(gnus-make-hashtable)))))
(defvar nndiscourse--last-scan-time (- (truncate (float-time)) 100)
"Don't scan more than once every few seconds.")
(defmacro nndiscourse--callback (result &optional callback)
"Set RESULT to return value of CALLBACK."
@ -140,20 +96,27 @@ Thought I could use macros here to setf it."
(defvar nndiscourse-processes nil
"Association list of ( server-name-qua-url . nndiscourse-proc-info ).")
(defun nndiscourse-good-server (server)
(defsubst nndiscourse--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."
(declare (indent defun))
(unless (stringp string)
(setq string (format "%s" string)))
(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 nndiscourse-good-server (server)
"SERVER needs to be a non-zero length string."
(or (and (stringp server) (not (zerop (length server)))
(prog1 t
(unless (nndiscourse--gethash server nndiscourse-by-server-hashtb)
(nndiscourse--sethash server
(nndiscourse-by-server-initial)
nndiscourse-by-server-hashtb))))
(or (and (stringp server) (not (zerop (length server))))
(prog1 nil (backtrace))))
(defsubst nndiscourse--replace-hash (string func hashtable)
"Set value of STRING to FUNC on STRING's extant value in HASHTABLE.
Starting in emacs-src commit c1b63af, Gnus moved from obarrays
to normal hashtables."
"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."
(declare (indent defun))
(unless (stringp string)
(setq string (prin1-to-string string)))
@ -163,23 +126,31 @@ to normal hashtables."
(set (intern string hashtable) replace-with)
(puthash string replace-with hashtable))))
(defmacro nndiscourse--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."
(declare (indent defun))
`(,(if (fboundp 'gnus-sethash)
'gnus-sethash
'puthash)
(format "%s" ,string) ,value ,hashtable))
(defmacro nndiscourse--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."
Starting in emacs-src commit c1b63af, Gnus moved from obarrays to normal hashtables."
(declare (indent nil))
(let ((workaround 'gnus-gethash-safe))
`(,(if (fboundp 'gnus-gethash-safe)
'mapatoms
'maphash)
,(if (fboundp 'gnus-gethash-safe)
`(lambda (k) (funcall
(apply-partially
,func
(symbol-name k) (,workaround k ,table))))
func)
,table)))
`(,(if (fboundp 'gnus-gethash-safe)
'mapatoms
'maphash)
,(if (fboundp 'gnus-gethash-safe)
`(lambda (k) (funcall
(apply-partially
,func
(symbol-name k) (gnus-gethash-safe k ,table))))
func)
,table))
(defvar nndiscourse-summary-voting-map
(let ((map (make-sparse-keymap)))
@ -201,47 +172,81 @@ to normal hashtables."
(copy-keymap nndiscourse-summary-mode-map)) ;; how does Gnus do this?
(define-minor-mode nndiscourse-article-mode
"Minor mode for nndiscourse articles.
Disallow `gnus-article-reply-with-original'.
"Minor mode for nndiscourse articles. Disallow `gnus-article-reply-with-original'.
\\{gnus-article-mode-map}"
\\{gnus-article-mode-map}
"
:lighter " Discourse"
:keymap nndiscourse-article-mode-map)
(define-minor-mode nndiscourse-summary-mode
"Disallow \"reply\" commands in `gnus-summary-mode-map'.
\\{nndiscourse-summary-mode-map}"
\\{nndiscourse-summary-mode-map}
"
:lighter " Discourse"
:keymap nndiscourse-summary-mode-map)
(defsubst nndiscourse--server-buffer-name (server)
"Arbitrary proc buffer name for SERVER."
(when (nndiscourse-good-server server)
(format " *%s*" server)))
(defsubst nndiscourse--server-buffer (server &optional create)
"Get proc buffer for SERVER. Create if necessary if CREATE."
(when (nndiscourse-good-server server)
(let ((name (nndiscourse--server-buffer-name server)))
(if create
(get-buffer-create name)
(get-buffer name)))))
(defvar-local nndiscourse--headers-hashtb (gnus-make-hashtable)
"Group -> headers. Buffer-local to individual servers' proc buffer.")
(defsubst nndiscourse-get-headers (server group)
"List headers for SERVER GROUP."
(nndiscourse--gethash group (nndiscourse-by-server server :headers-hashtb)))
(and (buffer-live-p (nndiscourse--server-buffer server))
(with-current-buffer (nndiscourse--server-buffer server)
(nndiscourse--gethash group nndiscourse--headers-hashtb))))
(defun nndiscourse-set-headers (server group new-headers)
(defmacro nndiscourse-set-headers (server group new-headers)
"Assign headers for SERVER GROUP to NEW-HEADERS."
(nndiscourse--sethash group new-headers (nndiscourse-by-server server :headers-hashtb)))
(declare (indent defun))
`(with-current-buffer (nndiscourse--server-buffer ,server)
(nndiscourse--sethash ,group ,new-headers nndiscourse--headers-hashtb)))
(defvar-local nndiscourse--refs-hashtb (gnus-make-hashtable)
"Id -> parent. Buffer-local to individual servers' proc buffer.")
(defun nndiscourse-get-refs (server id)
"Amongst SERVER refs, return list of descending ancestors for ID."
(cl-loop for prev-id = id then cur-id
for cur-id = (nndiscourse--gethash prev-id (nndiscourse-by-server server :refs-hashtb))
until (not cur-id)
collect cur-id into rresult
finally return (nreverse rresult)))
(declare (indent defun))
(with-current-buffer (nndiscourse--server-buffer server)
(cl-loop for prev-id = id then cur-id
for cur-id = (nndiscourse--gethash prev-id nndiscourse--refs-hashtb)
until (not cur-id)
collect cur-id into rresult
finally return (nreverse rresult))))
(defun nndiscourse-set-ref (server id parent-id)
(defmacro nndiscourse-set-ref (server id parent-id)
"Amongst SERVER refs, associate ID to PARENT-ID."
(nndiscourse--sethash id parent-id (nndiscourse-by-server server :refs-hashtb)))
`(with-current-buffer (nndiscourse--server-buffer ,server)
(nndiscourse--sethash ,id ,parent-id nndiscourse--refs-hashtb)))
(defvar-local nndiscourse--categories-hashtb (gnus-make-hashtable)
"Category id -> group. Buffer-local to individual servers' proc buffer.")
(defun nndiscourse-get-category (server category-id)
"Amongst SERVER categories, return group for CATEGORY-ID."
(nndiscourse--gethash category-id (nndiscourse-by-server server :categories-hashtb)))
(declare (indent defun))
(with-current-buffer (nndiscourse--server-buffer server)
(nndiscourse--gethash (format "%s" category-id) nndiscourse--categories-hashtb)))
(defun nndiscourse-set-category (server category-id group)
(defmacro nndiscourse-set-category (server category-id group)
"Amongst SERVER categories, associate CATEGORY-ID to GROUP."
(nndiscourse--sethash category-id group (nndiscourse-by-server server :categories-hashtb)))
(declare (indent defun))
`(with-current-buffer (nndiscourse--server-buffer ,server)
(nndiscourse--sethash ,category-id ,group nndiscourse--categories-hashtb)))
(defmacro nndiscourse--with-mutex (mtx &rest body)
"If capable of threading, lock with MTX and execute BODY."
@ -272,23 +277,16 @@ reinstantiated with every call.
Return response of METHOD ARGS of type `json-object-type' or nil if failure."
(when (and (nndiscourse-good-server server) (nndiscourse-server-opened server))
(condition-case err
(if-let ((port (nndiscourse-proc-info-port
(cdr (assoc server nndiscourse-processes))))
(connection (json-rpc-connect nndiscourse-localhost port))
(sock (json-rpc-process connection)))
(unwind-protect
(progn
(set-process-query-on-exit-flag sock nil)
(when (fboundp 'set-process-thread)
(set-process-thread sock nil))
(nndiscourse--with-mutex nndiscourse--mutex-rpc-request
(gnus-message 7 "nndiscourse-rpc-request: send %s %s" method
(mapconcat (lambda (s) (format "%s" s)) args " "))
(json-rpc connection method args)))
(json-rpc-close connection))
(error (prog1 nil
(gnus-message 3 "nndiscourse-rpc-request: could not connect to %s:%s"
nndiscourse-localhost port))))
(let* ((port (nndiscourse-proc-info-port
(cdr (assoc server nndiscourse-processes))))
(connection (json-rpc-connect nndiscourse-localhost port)))
(when-let ((threads-p (fboundp 'set-process-thread))
(proc (json-rpc-process connection)))
(set-process-thread proc nil))
(nndiscourse--with-mutex nndiscourse--mutex-rpc-request
(gnus-message 7 "nndiscourse-rpc-request: send %s %s" method
(mapconcat (lambda (s) (format "%s" s)) args " "))
(json-rpc connection method args)))
(error (prog1 nil
(gnus-message 3 "nndiscourse-rpc-request: %s" (error-message-string err)))))))
@ -301,41 +299,25 @@ Return response of METHOD ARGS of type `json-object-type' or nil if failure."
(eq 'nndiscourse (car (gnus-group-method group)))))
(deffoo nndiscourse-request-close ()
"Nnimap does nothing also."
(nndiscourse-close-server)
t)
(deffoo nndiscourse-request-type (_group &optional _article)
'news)
(defsubst nndiscourse--server-buffer-name (server)
"Arbitrary proc buffer name for SERVER."
(when (nndiscourse-good-server server)
(format " *%s*" server)))
(defsubst nndiscourse--server-buffer (server &optional create)
"Get proc buffer for SERVER. Create if necessary if CREATE."
(when (nndiscourse-good-server server)
(let ((name (nndiscourse--server-buffer-name server)))
(if create
(get-buffer-create name)
(get-buffer name)))))
(deffoo nndiscourse-server-opened (&optional server)
(when (nndiscourse-good-server server)
(buffer-live-p (nndiscourse--server-buffer server))))
(nndiscourse--server-buffer server))
(deffoo nndiscourse-status-message (&optional server)
(when (nndiscourse-good-server server)
nndiscourse-status-string))
(deffoo nndiscourse-status-message (&optional _server)
"")
(defun nndiscourse--initialize ()
"Run `bundle install` if necessary."
(let ((default-directory
(expand-file-name "nndiscourse"
(or nndiscourse-test-dir
(file-name-directory
(or (locate-library "nndiscourse")
default-directory)))))
(file-name-directory
(or (locate-library "nndiscourse")
default-directory))))
(bundle-exec (executable-find "bundle")))
(unless bundle-exec
(error "`nndiscourse--initialize': nndiscourse requires bundler"))
@ -354,70 +336,68 @@ Return response of METHOD ARGS of type `json-object-type' or nil if failure."
I am counting on `gnus-check-server` in `gnus-read-active-file-1' in
`gnus-get-unread-articles' to open server upon install."
(when (nndiscourse-good-server server)
(or (nndiscourse-server-opened server)
(let ((original-global-rbenv-mode global-rbenv-mode))
(unless global-rbenv-mode
(let (rbenv-show-active-ruby-in-modeline)
(global-rbenv-mode)))
(unwind-protect
(progn
(when defs ;; defs should be non-nil when called from `gnus-open-server'
(nndiscourse--initialize))
(nnoo-change-server 'nndiscourse server defs)
(let* ((proc-buf (nndiscourse--server-buffer server t))
(proc (get-buffer-process proc-buf)))
(if (process-live-p proc)
proc
(let* ((free-port (with-temp-buffer
(let ((proc (make-network-process
:name "free-port"
:noquery t
:host nndiscourse-localhost
:buffer (current-buffer)
:server t
:stop t
:service t)))
(prog1 (process-contact proc :service)
(delete-process proc)))))
(ruby-command (split-string (format "%s exec thor cli:serve %s://%s -p %s"
(executable-find "bundle")
nndiscourse-scheme
server
free-port)))
(stderr-buffer (get-buffer-create (format " *%s-stderr*" server))))
(with-current-buffer stderr-buffer
(add-hook 'after-change-functions
(apply-partially #'nndiscourse--message-user server)
nil t))
(nndiscourse-register-process
free-port
(let ((default-directory
(expand-file-name "nndiscourse"
(or nndiscourse-test-dir
(file-name-directory
(or (locate-library "nndiscourse")
default-directory))))))
(let ((new-proc (make-process :name server
:buffer proc-buf
:command ruby-command
:noquery t
:sentinel #'nndiscourse-sentinel
:stderr stderr-buffer)))
(cl-loop repeat 10
until (condition-case nil
(prog1 t
(delete-process
(make-network-process :name "test-port"
:noquery t
:host nndiscourse-localhost
:service free-port
:buffer nil
:stop t)))
(file-error nil))
do (accept-process-output new-proc 0.3))
new-proc)))))))
(unless original-global-rbenv-mode
(global-rbenv-mode -1)))))))
(let ((original-global-rbenv-mode global-rbenv-mode))
(unless global-rbenv-mode
(let (rbenv-show-active-ruby-in-modeline)
(global-rbenv-mode)))
(unwind-protect
(progn
(when defs ;; defs should be non-nil when called from `gnus-open-server'
(nndiscourse--initialize))
(nnoo-change-server 'nndiscourse server defs)
(let* ((proc-buf (nndiscourse--server-buffer server t))
(proc (get-buffer-process proc-buf)))
(if (process-live-p proc)
proc
(let* ((free-port (with-temp-buffer
(let ((proc (make-network-process
:name "free-port"
:noquery t
:host nndiscourse-localhost
:buffer (current-buffer)
:server t
:stop t
:service t)))
(prog1 (process-contact proc :service)
(delete-process proc)))))
(ruby-command (split-string (format "%s exec thor cli:serve %s://%s -p %s"
(executable-find "bundle")
nndiscourse-scheme
server
free-port)))
(stderr-buffer (get-buffer-create (format " *%s-stderr*" server))))
(with-current-buffer stderr-buffer
(add-hook 'after-change-functions
(apply-partially 'nndiscourse--message-user server)
nil t))
(nndiscourse-register-process
free-port
(let ((default-directory
(expand-file-name "nndiscourse"
(file-name-directory
(or (locate-library "nndiscourse")
default-directory)))))
(let ((new-proc (make-process :name server
:buffer proc-buf
:command ruby-command
:noquery t
:sentinel #'nndiscourse-sentinel
:stderr stderr-buffer)))
(cl-loop repeat 10
until (condition-case nil
(prog1 t
(delete-process
(make-network-process :name "test-port"
:noquery t
:host nndiscourse-localhost
:service free-port
:buffer nil
:stop t)))
(file-error nil))
do (accept-process-output new-proc 0.3))
new-proc)))))))
(unless original-global-rbenv-mode
(global-rbenv-mode -1))))))
(defun nndiscourse-alist-get (key alist &optional default remove testfn)
"Replicated library function for emacs-25.
@ -479,26 +459,22 @@ Return PROC if success, nil otherwise."
(defun nndiscourse-deregister-process (server)
"Disavow any knowledge of SERVER's process."
(when-let ((it (nndiscourse-alist-get server nndiscourse-processes nil nil #'equal)))
(awhen (nndiscourse-alist-get server nndiscourse-processes nil nil #'equal)
(let ((proc (nndiscourse-proc-info-process it)))
(gnus-message 5 "`nndiscourse-deregister-process': deregistering %s %s pid=%s"
server (process-name proc) (process-id proc))
(delete-process proc)))
(setf (nndiscourse-alist-get server nndiscourse-processes nil nil #'equal) nil))
(deffoo nndiscourse-close-server (&optional server defs)
(deffoo nndiscourse-close-server (&optional server _defs)
"Patterning after nnimap.el."
(when (nndiscourse-good-server server)
(nndiscourse-deregister-process server)
(when-let ((it (nndiscourse--server-buffer server)))
(kill-buffer it))
;; keep state in nndiscourse-by-server-hashtb?
(when (nnoo-change-server 'nndiscourse server defs)
(nnoo-close-server 'nndiscourse server))
(awhen (nndiscourse--server-buffer server)
(kill-buffer it))
(when (nnoo-change-server 'nndiscourse server nil)
(nnoo-close-server 'nndiscourse server)
t))
(deffoo nndiscourse-close-group (_group &optional server)
(nnoo-change-server 'nndiscourse server nil)
(deffoo nndiscourse-close-group (_group &optional _server)
t)
(defmacro nndiscourse--with-group (server group &rest body)
@ -507,11 +483,11 @@ Disambiguate GROUP if it's empty.
Then execute BODY."
(declare (debug (form &rest form))
(indent defun))
`(let* ((group (or ,group (gnus-group-real-name gnus-newsgroup-name)))
`(let* ((server (or ,server (nnoo-current-server 'nndiscourse)))
(group (or ,group (gnus-group-real-name gnus-newsgroup-name)))
(gnus-newsgroup-name (or gnus-newsgroup-name
(gnus-group-full-name
group (cons 'nndiscourse (list server)))))
(server (or ,server (nth 1 (gnus-find-method-for-group gnus-newsgroup-name)))))
group (cons 'nndiscourse (list server))))))
,@body))
(defsubst nndiscourse--first-article-number (server group)
@ -524,6 +500,7 @@ Then execute BODY."
(defun nndiscourse--get-header (server group article-number)
"Amongst SERVER GROUP headers, binary search ARTICLE-NUMBER."
(declare (indent defun))
(let ((headers (nndiscourse-get-headers server group)))
(cl-flet ((id-of (k) (plist-get (elt headers k) :id)))
(cl-do* ((x article-number)
@ -591,7 +568,7 @@ Originally written by Paul Issartel."
(symbol-function 'nndiscourse--score-pending)))
(deffoo nndiscourse-request-group-scan (group &optional server info)
"\\[gnus-group-get-new-news-this-group] from *Group* calls this."
"M-g from *Group* calls this."
(nndiscourse--with-group server group
(gnus-message 5 "nndiscourse-request-group-scan: scanning %s..." group)
(nndiscourse-request-scan nil server)
@ -614,8 +591,8 @@ Originally written by Paul Issartel."
(nndiscourse--with-group server group
(let* ((num-headers (length (nndiscourse-get-headers server group)))
(status (format "211 %d %d %d %s" num-headers
(or (nndiscourse--first-article-number server group) 1)
(or (nndiscourse--last-article-number server group) 0)
(aif (nndiscourse--first-article-number server group) it 1)
(aif (nndiscourse--last-article-number server group) it 0)
group)))
(gnus-message 7 "nndiscourse-request-group: %s" status)
(nnheader-insert "%s\n" status))
@ -623,6 +600,7 @@ Originally written by Paul Issartel."
(defun nndiscourse--request-item (id server)
"Retrieve ID from SERVER as a property list."
(push id nndiscourse--debug-request-posts)
(let* ((port (nndiscourse-proc-info-port (cdr (assoc server nndiscourse-processes))))
(conn (json-rpc-connect nndiscourse-localhost port))
(utf-decoder (lambda (x)
@ -633,7 +611,7 @@ Originally written by Paul Issartel."
'utf-8))))
(add-function :filter-return (symbol-function 'json-read-string) utf-decoder)
(unwind-protect
(condition-case err (json-rpc conn "get_post" id)
(condition-case err (json-rpc conn "get_post" id)
(error (gnus-message 3 "nndiscourse--request-item: %s" (error-message-string err))
nil))
(remove-function (symbol-function 'json-read-string) utf-decoder))))
@ -642,7 +620,7 @@ Originally written by Paul Issartel."
"Query SERVER /categories.json."
(seq-filter (lambda (x) (eq json-false (plist-get x :read_restricted)))
(let ((cats (funcall #'nndiscourse-rpc-request server "categories")))
(when (seqp cats) cats))))
(if (seqp cats) cats nil))))
(cl-defun nndiscourse-get-topics (server slug &key (page 0))
"Query SERVER /c/SLUG/l/latest.json, optionally for PAGE."
@ -654,25 +632,24 @@ Originally written by Paul Issartel."
"Query SERVER /posts.json for posts before BEFORE."
(plist-get (let ((result (funcall #'nndiscourse-rpc-request server
"posts" :before before)))
(when (listp result) result))
:latest_posts))
(if (listp result) result nil)) :latest_posts))
(defun nndiscourse--number-to-header (server group topic-id post-number)
"O(n) search for SERVER GROUP TOPIC-ID POST-NUMBER in headers."
(declare (indent defun))
(when-let ((headers (nndiscourse-get-headers server group))
(found (seq-position
headers (cons topic-id post-number)
(lambda (plst loc)
(cl-destructuring-bind (topic-id* . post-number*) loc
(and (= topic-id* (plist-get plst :topic_id))
(= post-number* (plist-get plst :post_number))))))))
(-when-let* ((headers (nndiscourse-get-headers server group))
(found (seq-position
headers (cons topic-id post-number)
(lambda (plst loc)
(cl-destructuring-bind (topic-id* . post-number*) loc
(and (= topic-id* (plist-get plst :topic_id))
(= post-number* (plist-get plst :post_number))))))))
(elt headers found)))
(defun nndiscourse--earliest-header (server group topic-id)
"O(n) search for first header satisfying SERVER GROUP TOPIC-ID."
(declare (indent defun))
(when-let ((headers (nndiscourse-get-headers server group)))
(-when-let* ((headers (nndiscourse-get-headers server group)))
(seq-find (lambda (plst) (= topic-id (plist-get plst :topic_id)))
headers)))
@ -682,86 +659,72 @@ Originally written by Paul Issartel."
(nndiscourse--maphash (lambda (&rest _args) (cl-incf result)) table-or-obarray)
result))
(defsubst nndiscourse-hash-values (table-or-obarray)
"Return right hand sides in TABLE-OR-OBARRAY."
(let (result)
(nndiscourse--maphash (lambda (_key value) (push value result)) table-or-obarray)
result))
(defsubst nndiscourse-hash-keys (table-or-obarray)
"Return left hand sides in TABLE-OR-OBARRAY."
(let (result)
(nndiscourse--maphash (lambda (key _value) (push key result)) table-or-obarray)
result))
(defun nndiscourse--incoming (server)
"Drink from the SERVER firehose."
(interactive)
(when (zerop (nndiscourse-hash-count (nndiscourse-by-server server :categories-hashtb)))
(setq nndiscourse--debug-request-posts nil)
(when (zerop (nndiscourse-hash-count nndiscourse--categories-hashtb))
(nndiscourse-request-list server))
(cl-loop
with new-posts
for page-bottom = 1 then (plist-get (elt posts (1- (length posts))) :id)
for posts = (nndiscourse-get-posts server :before (1- page-bottom))
until (null posts)
do (unless (nndiscourse-by-server server :last-id)
(setf (nndiscourse-by-server server :last-id)
do (unless nndiscourse--last-id
(setq nndiscourse--last-id
(1- (plist-get (elt posts (1- (length posts))) :id))))
do (cl-do* ((k 0 (1+ k))
(plst (and (< k (length posts)) (elt posts k))
(and (< k (length posts)) (elt posts k))))
((or (null plst)
(<= (plist-get plst :id) (nndiscourse-by-server server :last-id))))
(<= (plist-get plst :id) nndiscourse--last-id)))
(push plst new-posts))
until (<= (1- (plist-get (elt posts (1- (length posts))) :id))
(nndiscourse-by-server server :last-id))
nndiscourse--last-id)
finally
(let ((counts (gnus-make-hashtable)))
(dolist (plst new-posts)
(setf (nndiscourse-by-server server :last-id) (plist-get plst :id))
(when-let ((not-deleted (not (plist-get plst :deleted_at)))
(type (plist-get plst :post_type))
(category-id (plist-get plst :category_id))
(group (nndiscourse-get-category server category-id))
(full-group (gnus-group-full-name
group
(cons 'nndiscourse (list server)))))
(if-let ((it (plist-get plst :reply_to_post_number)))
(setq nndiscourse--last-id (plist-get plst :id))
(-when-let* ((not-deleted (not (plist-get plst :deleted_at)))
(type (plist-get plst :post_type))
(category-id (plist-get plst :category_id))
(group (nndiscourse-get-category server category-id))
(full-group (gnus-group-full-name
group
(cons 'nndiscourse (list server)))))
(aif (plist-get plst :reply_to_post_number)
(nndiscourse-set-ref server
(plist-get plst :id)
(plist-get (nndiscourse--number-to-header
server group
(plist-get plst :topic_id) it)
:id))
(when-let ((it (plist-get (nndiscourse--earliest-header
server group
(plist-get plst :topic_id))
:id)))
(awhen (plist-get (nndiscourse--earliest-header
server group
(plist-get plst :topic_id))
:id)
(nndiscourse-set-ref server (plist-get plst :id) it)))
(nndiscourse--replace-hash type (lambda (x) (1+ (or x 0))) counts)
(if-let ((info (gnus-get-info full-group)))
(progn
(unless (gnus-info-read info)
(with-suppressed-warnings ((obsolete gnus-range-normalize))
(setf (gnus-info-read info)
(gnus-range-normalize `(1 . ,(1- (plist-get plst :id)))))))
(when-let ((last-number (nndiscourse--last-article-number server group))
(next-number (plist-get plst :id))
(gap `(,(1+ last-number) . ,(1- next-number))))
(setf (gnus-info-read info)
(gnus-range-normalize `(1 . ,(1- (plist-get plst :id))))))
(-when-let* ((last-number (nndiscourse--last-article-number server group))
(next-number (plist-get plst :id))
(gap `(,(1+ last-number) . ,(1- next-number))))
(when (<= (car gap) (cdr gap))
(with-suppressed-warnings ((obsolete gnus-range-normalize)
(obsolete gnus-range-add))
(setf (gnus-info-read info)
(gnus-range-add (gnus-info-read info)
(gnus-range-normalize gap))))
(when (gnus-info-marks info)
(setf (alist-get 'unexist (gnus-info-marks info)) nil)))))
(setf (gnus-info-read info)
(gnus-range-add (gnus-info-read info) (gnus-range-normalize gap)))
(setf (alist-get 'unexist (gnus-info-marks info))
(gnus-range-add (alist-get 'unexist (gnus-info-marks info))
(gnus-range-normalize gap))))))
(gnus-message 3 "nndiscourse--incoming: cannot update read for %s" group))
(nndiscourse-set-headers server group
(nconc (nndiscourse-get-headers server group) (list plst)))))
(gnus-message
5 (concat "nndiscourse--incoming: "
(format "last-id: %s, " (nndiscourse-by-server server :last-id))
(format "last-id: %s, " nndiscourse--last-id)
(let ((result ""))
(nndiscourse--maphash
(lambda (key value)
@ -771,12 +734,12 @@ Originally written by Paul Issartel."
(deffoo nndiscourse-request-scan (&optional _group server)
(when (nndiscourse-good-server server)
(if (> 2 (- (truncate (float-time)) (nndiscourse-by-server server :last-scan-time)))
(if (> 2 (- (truncate (float-time)) nndiscourse--last-scan-time))
(gnus-message 7 "nndiscourse-request-scan: last scanned at %s"
(current-time-string (nndiscourse-by-server server :last-scan-time)))
(current-time-string nndiscourse--last-scan-time))
(cl-destructuring-bind (seconds num-gc seconds-gc)
(benchmark-run (nndiscourse--incoming server))
(setf (nndiscourse-by-server server :last-scan-time) (truncate (float-time)))
(setq nndiscourse--last-scan-time (truncate (float-time)))
(gnus-message 5 (concat "nndiscourse-request-scan: Took %s seconds,"
" with %s gc runs taking %s seconds")
seconds num-gc seconds-gc)))))
@ -846,7 +809,7 @@ article header. Gnus manual does say the term `header` is oft conflated."
'disposition "inline"
'charset "utf-8")
(save-excursion (mml-insert-tag '/part))
(when-let
(-when-let*
((parent (car (last (nndiscourse-get-refs server (plist-get header :id)))))
(parent-author
(or (plist-get (nndiscourse--get-header server group parent)
@ -875,63 +838,53 @@ article header. Gnus manual does say the term `header` is oft conflated."
'nov)))
;; Primarily because `gnus-get-unread-articles' won't update unreads
;; upon install (nndiscourse won't yet be in type-cache),
;; upon install (nndiscourse won't yet be in type-cache).
;; I am counting on logic in `gnus-read-active-file-1' in `gnus-get-unread-articles'
;; to get here upon install.
(deffoo nndiscourse-retrieve-groups (_groups &optional server)
(deffoo nndiscourse-retrieve-groups (groups &optional server)
(when (nndiscourse-good-server server)
;; Utterly insane thing where `gnus-active-to-gnus-format' expects
;; utterly insane thing where `gnus-active-to-gnus-format' expects
;; `gnus-request-list' output to be in `nntp-server-buffer'
;; and populates `gnus-active-hashtb'
(nndiscourse-request-list server)
(with-current-buffer nntp-server-buffer
(with-suppressed-warnings ((obsolete gnus-select-method))
(let (gnus-server-method-cache
(gnus-select-method '(nnnil)))
(gnus-active-to-gnus-format
(gnus-server-to-method (format "nndiscourse:%s" server))
gnus-active-hashtb nil t))))
(gnus-active-to-gnus-format
(gnus-server-to-method (format "nndiscourse:%s" server))
gnus-active-hashtb nil t))
(mapc (lambda (group)
(let ((full-name (gnus-group-full-name group `(nndiscourse ,server))))
(gnus-get-unread-articles-in-group (gnus-get-info full-name)
(gnus-active full-name))))
(nndiscourse-hash-values (nndiscourse-by-server server :categories-hashtb)))
groups)
;; `gnus-read-active-file-2' will now repeat what I just did. Brutal.
'active))
(deffoo nndiscourse-request-list (&optional server)
(let ((groups (nndiscourse-hash-values (nndiscourse-by-server server :categories-hashtb))))
(let (groups)
(when (and (nndiscourse-good-server server) (nndiscourse-server-opened server))
(with-current-buffer nntp-server-buffer
(unless groups
(mapc
(lambda (plst)
(let ((group (plist-get plst :slug)))
(when (and group (not (zerop (length group))))
(let* ((category-id (plist-get plst :id))
(full-name (gnus-group-full-name group `(nndiscourse ,server)))
(subcategory-ids (append (plist-get plst :subcategory_ids) nil))
(must-subscribe (not (gnus-get-info full-name))))
(erase-buffer)
;; only `gnus-activate-group' seems to call `gnus-parse-active'
(gnus-activate-group full-name nil nil `(nndiscourse ,server))
(when must-subscribe
(funcall (if (fboundp 'gnus-group-set-subscription)
#'gnus-group-set-subscription
(with-no-warnings
#'gnus-group-unsubscribe-group))
full-name gnus-level-default-subscribed t))
(nndiscourse-set-category server category-id group)
(dolist (sub-id subcategory-ids)
(nndiscourse-set-category server sub-id group))
(push group groups)))))
(nndiscourse-get-categories server)))
(mapc
(lambda (plst)
(let* ((group (plist-get plst :slug))
(category-id (plist-get plst :id))
(full-name (gnus-group-full-name group `(nndiscourse ,server))))
(erase-buffer)
;; only `gnus-activate-group' seems to call `gnus-parse-active'
(unless (gnus-get-info full-name)
(gnus-activate-group full-name nil nil `(nndiscourse ,server))
(gnus-group-unsubscribe-group full-name
gnus-level-default-subscribed t))
(nndiscourse-set-category server category-id group)
(push group groups)))
(nndiscourse-get-categories server))
(erase-buffer)
(mapc (lambda (group)
(insert
(format "%s %d %d y\n" group
(or (nndiscourse--last-article-number server group) 0)
(or (nndiscourse--first-article-number server group) 1))))
(aif (nndiscourse--last-article-number server group)
it 0)
(aif (nndiscourse--first-article-number server group)
it 1))))
groups)))
t))
@ -941,7 +894,7 @@ article header. Gnus manual does say the term `header` is oft conflated."
(gnus-message 2 "nndiscourse-sentinel: process %s %s"
(car (process-command process))
(replace-regexp-in-string "\n$" "" event))
(nndiscourse-close-server (process-name process))
(nndiscourse-deregister-process (process-name process))
(gnus-backlog-shutdown)))
(defun nndiscourse--message-user (server beg end _prev-len)
@ -962,18 +915,17 @@ article header. Gnus manual does say the term `header` is oft conflated."
(defun nndiscourse--browse-post (&rest _args)
"What happens when I click on discourse Subject."
(when-let ((group-article gnus-article-current)
(server (nth 1 (gnus-find-method-for-group (car group-article))))
(header (nndiscourse--get-header
server
(gnus-group-real-name (car group-article))
(cdr group-article)))
(url (format "%s://%s/t/%s/%s/%s"
nndiscourse-scheme
server
(plist-get header :topic_slug)
(plist-get header :topic_id)
(plist-get header :post_number))))
(-when-let* ((group-article gnus-article-current)
(header (nndiscourse--get-header
(nnoo-current-server 'nndiscourse)
(gnus-group-real-name (car group-article))
(cdr group-article)))
(url (format "%s://%s/t/%s/%s/%s"
nndiscourse-scheme
(nnoo-current-server 'nndiscourse)
(plist-get header :topic_slug)
(plist-get header :topic_id)
(plist-get header :post_number))))
(browse-url url)))
(defun nndiscourse--header-button-alist ()
@ -992,10 +944,9 @@ article header. Gnus manual does say the term `header` is oft conflated."
(defsubst nndiscourse--fallback-link ()
"Cannot render post."
(let* ((header (nndiscourse--get-header
(nth 1 (gnus-find-method-for-group (car gnus-article-current)))
(gnus-group-real-name (car gnus-article-current))
(cdr gnus-article-current)))
(let* ((header (nndiscourse--get-header (nnoo-current-server 'nndiscourse)
(gnus-group-real-name (car gnus-article-current))
(cdr gnus-article-current)))
(body (nndiscourse--massage (plist-get header :cooked))))
(with-current-buffer gnus-original-article-buffer
(article-goto-body)
@ -1016,19 +967,6 @@ article header. Gnus manual does say the term `header` is oft conflated."
(error (error-message-string err))))))
"In case of shr failures, dump original link.")
(defun nndiscourse-dump-diagnostics (server)
"Makefile recipe test-run. SERVER second element of `gnus-select-method'."
(if-let ((it (nndiscourse-alist-get server nndiscourse-processes nil nil #'equal)))
(dolist (b `(,byte-compile-log-buffer
,gnus-group-buffer
"*Messages*"
,(buffer-name (process-buffer (nndiscourse-proc-info-process it)))
,(format " *%s-stderr*" server)))
(when (buffer-live-p (get-buffer b))
(princ (format "\nBuffer: %s\n%s\n\n" b (with-current-buffer b (buffer-string)))
#'external-debugging-output)))
(error "Server %s not found among %s" server (mapcar #'car nndiscourse-processes))))
(defsubst nndiscourse--dense-time (time)
"Convert TIME to a floating point number.
@ -1044,7 +982,7 @@ Written by John Wiegley (https://github.com/jwiegley/dot-emacs)."
(if (> (length date) 0)
(let*
((then (nndiscourse--dense-time
(apply #'encode-time (parse-time-string date))))
(apply 'encode-time (parse-time-string date))))
(now (nndiscourse--dense-time (current-time)))
(diff (- now then))
(str
@ -1088,9 +1026,9 @@ Written by John Wiegley (https://github.com/jwiegley/dot-emacs)."
Written by John Wiegley (https://github.com/jwiegley/dot-emacs).")
;; Evade melpazoid!
(funcall #'fset 'gnus-user-format-function-S
(symbol-function 'nndiscourse--format-time-elapsed))
;; Evade package-lint!
(fset 'gnus-user-format-function-S
(symbol-function 'nndiscourse--format-time-elapsed))
(let ((custom-defaults
;; For now, revert any user overrides that I can't predict.
@ -1140,8 +1078,8 @@ Written by John Wiegley (https://github.com/jwiegley/dot-emacs).")
"dickmao")
;; I believe I did try buffer-localizing hooks, and it wasn't sufficient
(add-hook 'gnus-article-mode-hook #'nndiscourse-article-mode-activate)
(add-hook 'gnus-summary-mode-hook #'nndiscourse-summary-mode-activate)
(add-hook 'gnus-article-mode-hook 'nndiscourse-article-mode-activate)
(add-hook 'gnus-summary-mode-hook 'nndiscourse-summary-mode-activate)
;; `gnus-newsgroup-p' requires valid method post-mail to return t
(add-to-list 'gnus-valid-select-methods '("nndiscourse" post-mail) t)

1
nndiscourse/.ruby-version
View File

@ -1 +0,0 @@
2.6.2

1
nndiscourse/Gemfile
View File

@ -3,7 +3,6 @@
source 'https://rubygems.org'
gem 'discourse_api', github: 'dickmao/discourse_api', branch: 'dev'
gem 'jimson', github: 'dickmao/jimson', branch: 'next'
# Specify your gem's dependencies in nndiscourse.gemspec
gemspec

27
nndiscourse/Gemfile.lock
View File

@ -8,17 +8,6 @@ GIT
faraday_middleware (~> 0.10)
rack (>= 1.6)
GIT
remote: https://github.com/dickmao/jimson.git
revision: 22160cf954fdad3d44c4d597b2f47cc7fe58200e
branch: next
specs:
jimson (0.11.0)
blankslate (~> 3.1, >= 3.1.3)
multi_json (~> 1, >= 1.11.2)
rack (~> 2, >= 2.1.4)
rest-client (~> 1, >= 1.7.3)
PATH
remote: .
specs:
@ -41,16 +30,21 @@ GEM
http-cookie (1.0.3)
domain_name (~> 0.5)
jaro_winkler (1.5.4)
jimson (0.11.0)
blankslate (~> 3.1, >= 3.1.3)
multi_json (~> 1, >= 1.11.2)
rack (~> 1, >= 1.4.5)
rest-client (~> 1, >= 1.7.3)
mime-types (2.99.3)
multi_json (1.15.0)
multi_json (1.14.1)
multipart-post (2.1.1)
netrc (0.11.0)
parallel (1.19.1)
parser (2.7.0.2)
ast (~> 2.4.0)
rack (2.2.3)
rack (1.6.12)
rainbow (3.0.0)
rake (13.0.1)
rake (11.3.0)
rest-client (1.8.0)
http-cookie (>= 1.0.2, < 2.0)
mime-types (>= 1.16, < 3.0)
@ -79,7 +73,7 @@ GEM
thor (0.20.3)
unf (0.1.4)
unf_ext
unf_ext (0.0.7.7)
unf_ext (0.0.7.6)
unicode-display_width (1.6.1)
PLATFORMS
@ -88,9 +82,8 @@ PLATFORMS
DEPENDENCIES
bundler (~> 2.0)
discourse_api!
jimson!
nndiscourse!
rake (~> 13.0)
rake (~> 11.1)
rspec (~> 3.4)
rubocop (~> 0.69)

2
nndiscourse/nndiscourse.gemspec
View File

@ -21,7 +21,7 @@ Gem::Specification.new do |spec|
spec.add_runtime_dependency 'thor', '~> 0.20.3'
spec.add_development_dependency 'bundler', '~> 2.0'
spec.add_development_dependency 'rake', '~> 13.0'
spec.add_development_dependency 'rake', '~> 11.1'
spec.add_development_dependency 'rspec', '~> 3.4'
spec.add_development_dependency 'rubocop', '~> 0.69'
end

2
scratch.el
View File

@ -326,7 +326,7 @@
;; eww doesn't fly for lack of javascript
(build-query "http://localhost:3000")
;; client = DiscourseApi::Client.new("http://localhost:3000")
;; client = DiscourseApi::Client.new("localhost:3000")
;; client = DiscourseApi::Client.new('http://localhost:3000', 'b28f0cea1b4fb749b9a3b8683760388c', 'priapushk', 'User-Api-Key', 'User-Api-Client-Id')
;; proc = Nndiscourse::Process.new('http://localhost:3000', 'b28f0cea1b4fb749b9a3b8683760388c', 'priapushk')
;; (let ((user-api-key

5
tests/nndiscourse-test.el
View File

@ -26,7 +26,6 @@
(require 'ert)
(require 'message)
(setq ert-runner-profile nil)
(mapc (lambda (key-params)
(when (string-match-p (car key-params) "nndiscourse")
(let ((params (cdr key-params)))
@ -38,12 +37,12 @@
"Wait until PREDICATE function returns non-`nil'.
PREDARGS is argument list for the PREDICATE function.
MS is milliseconds to wait. INTERVAL is polling interval in milliseconds."
(let* ((int (or interval (if ms (max 300 (/ ms 10)) 300)))
(let* ((int (aif interval it (aif ms (max 300 (/ ms 10)) 300)))
(count (max 1 (if ms (truncate (/ ms int)) 25))))
(unless (or (cl-loop repeat count
when (apply predicate predargs)
return t
do (sleep-for (/ int 1000.0)))
do (sleep-for 0 int))
continue)
(error "Timeout: %s" predicate))))

1
tests/test-uncacheable.el
View File

@ -1,4 +1,3 @@
;;; -*- lexical-binding: t; coding: utf-8 -*-
(require 'nndiscourse-test)
;; since nndiscourse has fixed numbering, maybe we *can* use gnus-cache

49
tools/install-cask.sh 100644
View File

@ -0,0 +1,49 @@
#!/bin/bash
# Install cask for Travis CI
# or if already installed, then check for updates
# Author: gonewest818 https://github.com/clojure-emacs/cider/pull/2139
set -x
WORKDIR=${HOME}/local
CASKDIR=$WORKDIR/cask
. tools/retry.sh
update_elpa_keys() {
mkdir -p $HOME/.emacs.d/elpa/gnupg || true
chmod 700 $HOME/.emacs.d/elpa/gnupg
GPG=gpg
if which gpg2 ; then GPG=gpg2 ; fi
travis_retry ${GPG} --keyserver hkp://pool.sks-keyservers.net:80 --homedir $HOME/.emacs.d/elpa/gnupg --recv-keys 066DAFCB81E42C40
mkdir -p $(cask package-directory) || true
mkdir -p $HOME/.cask || true
rsync -azSHe ssh $HOME/.cask $(dirname $(dirname $(dirname $(cask package-directory))))
rsync -azSHe ssh $HOME/.emacs.d/elpa/gnupg $(cask package-directory)
}
cask_upgrade_cask_or_reset() {
cask upgrade-cask || { rm -rf $HOME/.emacs.d/.cask && false; }
}
cask_install_or_reset() {
cask install </dev/null
find $(cask package-directory)/archives -print | xargs ls -l
find $(cask package-directory)/gnupg -print | xargs ls -l
# travis cache
rsync -azSHe ssh $(dirname $(dirname $(cask package-directory))) $HOME/
}
# Bootstrap the cask tool and its dependencies
if [ ! -d $CASKDIR ] ; then
git clone https://github.com/cask/cask.git $CASKDIR
fi
# Install dependencies for cider as descriped in ./Cask
# Effect is identical to "make elpa", but here we can retry
# in the event of network failures.
update_elpa_keys
travis_retry cask_upgrade_cask_or_reset
travis_retry cask_install_or_reset && touch elpa-emacs

9
tools/package-lint.sh
View File

@ -1,7 +1,7 @@
#!/bin/sh -ex
export EMACS="${EMACS:=emacs}"
export BASENAME=$(basename "$1")
EMACS="${EMACS:=emacs}"
BASENAME=$(basename "$1")
( cask emacs -Q --batch \
--visit "$1" \
@ -10,12 +10,11 @@ export BASENAME=$(basename "$1")
(buffer-string)))" \
2>&1 | egrep -a "^$BASENAME:" ) && false
!( cask emacs -Q --batch \
cask emacs -Q --batch \
-l package-lint \
--eval "(package-initialize)" \
--eval "(push (quote (\"melpa\" . \"http://melpa.org/packages/\")) \
package-archives)" \
--eval "(package-refresh-contents)" \
--eval "(setq debug-on-error t)" \
-f package-lint-batch-and-exit "$1" \
2>&1 | egrep -a "^$BASENAME:" | egrep -v "non-snapshot" | egrep .)
-f package-lint-batch-and-exit "$1"

4
tools/recipe
View File

@ -1,3 +1,3 @@
(nndiscourse :repo "dickmao/nndiscourse"
nndiscourse :repo "dickmao/nndiscourse"
:fetcher github
:files ("nndiscourse.el" ("nndiscourse" "nndiscourse/.ruby-version" "nndiscourse/Gemfile" "nndiscourse/Gemfile.lock" "nndiscourse/nndiscourse.gemspec" "nndiscourse/nndiscourse.thor" "nndiscourse/lib")))
:files ("nndiscourse.el" ("nndiscourse" ("nndiscourse/Gemfile" "nndiscourse/Gemfile.lock" "nndiscourse/nndiscourse.gemspec" "nndiscourse/nndiscourse.thor" "nndiscourse/lib")))

28
tools/retry.sh 100644
View File

@ -0,0 +1,28 @@
# Copied retry logic from Travis CI [http://bit.ly/2jPDCtV]
# Author: gonewest818 https://github.com/clojure-emacs/cider/pull/2139
ANSI_RED="\033[31;1m"
ANSI_GREEN="\033[32;1m"
ANSI_RESET="\033[0m"
ANSI_CLEAR="\033[0K"
travis_retry() {
local result=0
local count=1
while [ $count -le 3 ]; do
[ $result -ne 0 ] && {
echo -e "\n${ANSI_RED}The command \"$@\" failed. Retrying, $count of 3.${ANSI_RESET}\n" >&2
}
"$@"
result=$?
[ $result -eq 0 ] && break
count=$(($count + 1))
sleep 1
done
[ $count -gt 3 ] && {
echo -e "\n${ANSI_RED}The command \"$@\" failed 3 times.${ANSI_RESET}\n" >&2
}
return $result
}