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 name: CI
on: on:
pull_request:
paths-ignore:
- '**.md'
- '**.rst'
push: push:
paths-ignore: paths-ignore:
- '**.md' - '**.md'
- '**.rst'
branches-ignore: branches-ignore:
- 'master' - 'master'
- 'main'
jobs: jobs:
build: build:
runs-on: ${{ matrix.os }} runs-on: ${{ matrix.os }}
strategy: strategy:
matrix: matrix:
os: [ubuntu-latest] os: [ubuntu-latest, macos-latest]
emacs_version: [27.2, 28.2, 29.2] emacs_version: [25.1, 26.3]
ruby_version: [2.6] 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: steps:
- uses: actions/checkout@v2 - uses: actions/checkout@v2
- uses: ruby/setup-ruby@v1 - uses: actions/setup-ruby@v1
with: with:
ruby-version: ${{ matrix.ruby_version }} ruby-version: ${{ matrix.ruby_version }}
@ -33,58 +34,38 @@ jobs:
with: with:
version: ${{ matrix.emacs_version }} version: ${{ matrix.emacs_version }}
- uses: actions/cache@v2 - uses: dickmao/setup-paths@master
id: cache-cask-packages
with: with:
path: .cask paths: local/bin:local/cask/bin
key: cache-cask-packages-000
- uses: actions/cache@v2 - uses: actions/cache@v1
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
if: startsWith(runner.os, 'Linux') if: startsWith(runner.os, 'Linux')
with: with:
path: ~/.cache/rubocop_cache path: ~/.cache/rubocop_cache
key: ${{ runner.os }}-rubocop key: ${{ runner.os }}-rubocop
- uses: actions/cache@v2 - uses: actions/cache@v1
if: startsWith(runner.os, 'macOS') if: startsWith(runner.os, 'macOS')
with: with:
path: ~/Library/Caches/rubocop_cache path: ~/Library/Caches/rubocop_cache
key: ${{ runner.os }}-rubocop key: ${{ runner.os }}-rubocop
- uses: actions/cache@v2 - uses: actions/cache@v1
with: with:
path: ~/local path: ~/local
key: ${{ runner.os }}-local-000 key: ${{ runner.os }}-local-000
- uses: actions/cache@v2 - uses: actions/cache@v1
with: with:
path: ~/.emacs.d path: ~/.emacs.d
key: emacs.d key: emacs.d
- uses: actions/cache@v2 - uses: actions/cache@v1
with: with:
path: ~/.cask path: ~/.cask
key: cask-000 key: cask-000
- uses: actions/cache@v2 - uses: actions/cache@v1
with: with:
path: nndiscourse/vendor/bundle path: nndiscourse/vendor/bundle
key: ${{ runner.os }}-gems-${{ hashFiles('**/Gemfile.lock') }} key: ${{ runner.os }}-gems-${{ hashFiles('**/Gemfile.lock') }}
@ -93,7 +74,7 @@ jobs:
- name: bundler - name: bundler
run: | run: |
gem install --user-install bundler:2.0.2 gem install --user-install bundler
- name: apt-get - name: apt-get
if: startsWith(runner.os, 'Linux') if: startsWith(runner.os, 'Linux')
@ -114,7 +95,11 @@ jobs:
emacs --version emacs --version
gpg --version gpg --version
- name: cask
run: |
sh tools/install-cask.sh
cask link list
- name: test - name: test
run: | run: |
make test-run
make test make test

2
Cask
View File

@ -2,7 +2,7 @@
(source melpa) (source melpa)
(package-file "nndiscourse.el") (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 (development
(depends-on "ert-runner") (depends-on "ert-runner")

85
Makefile
View File

@ -27,19 +27,11 @@ README.rst: README.in.rst nndiscourse.el
clean: clean:
$(CASK) clean-elc $(CASK) clean-elc
$(MAKE) -C nndiscourse $@ $(MAKE) -C nndiscourse $@
rm -f ert-profile*
rm -f tests/log/* rm -f tests/log/*
rm -rf tests/test-install 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 .PHONY: cask
cask: bundler $(CASK_DIR) cask: $(CASK_DIR)
$(CASK_DIR): Cask $(CASK_DIR): Cask
$(CASK) install $(CASK) install
@ -47,57 +39,48 @@ $(CASK_DIR): Cask
.PHONY: test-compile .PHONY: test-compile
test-compile: cask autoloads 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 \ ! ($(CASK) eval \
"(cl-letf (((symbol-function (quote cask-files)) (lambda (&rest _args) (mapcar (function symbol-name) (quote ($(TESTSSRC))))))) \ "(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) (let ((byte-compile-error-on-warn t)) (cask-cli/build)))" 2>&1 | egrep -a "(Warning|Error):") ; (ret=$$? ; rm -f $(ELCTESTS) && exit $$ret)
$(MAKE) -C nndiscourse $@
TESTFILES = $(shell $(CASK) files) 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 define TESTRUN
--eval "(custom-set-variables \ --eval "(custom-set-variables \
(backquote (nndiscourse-test-dir ,(file-name-as-directory (make-temp-file \"testrun-\" t)))) \ (quote (gnus-select-method (quote (nndiscourse \"\")))) \
(quote (gnus-select-method (quote (nndiscourse \"meta.discourse.org\" (nndiscourse-scheme \"https\"))))) \ (backquote (venv-location ,(file-name-as-directory (make-temp-file \"testrun-\" t)))) \
(quote (gnus-verbose 8)))" \ (quote (gnus-verbose 8)) \
(quote (nndiscourse-log-rpc t)))" \
--eval "(setq debug-on-error t)" \ --eval "(setq debug-on-error t)" \
--eval "(fset (quote gnus-y-or-n-p) (function ignore))" \ --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)))))"
endef endef
.PHONY: test-run .PHONY: test-run
test-run: cask test-run:
$(CASK) emacs -Q --batch -l nndiscourse \ $(CASK) emacs -Q --batch \
$(TESTRUN) \ $(TESTRUN) \
--eval "(gnus-open-server gnus-select-method)" \ --eval "(require 'nndiscourse)" \
--eval "(sleep-for .43)" \ --eval "(cl-assert (nndiscourse-rpc-get))" \
--eval "(cl-assert nndiscourse-processes)" \ --eval "(sleep-for 0 7300)" \
--eval "(nndiscourse-dump-diagnostics (nth 1 gnus-select-method))" -f nndiscourse-dump-diagnostics \
--eval "(cl-assert nndiscourse-processes)"
.PHONY: test-run-interactive .PHONY: test-run-interactive
test-run-interactive: cask autoloads test-run-interactive:
$(CASK) emacs -Q -l nndiscourse \ $(CASK) emacs -Q \
$(TESTRUN) \ $(TESTRUN) \
-f gnus -f gnus
.PHONY: test-unit .PHONY: test-unit
test-unit: cask autoloads test-unit:
$(CASK) exec ert-runner -L . -L tests $(TESTS) $(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 .PHONY: test
test: test-compile test-unit test-int test: test-compile test-unit test-int
.PHONY: test-int .PHONY: test-int
test-int: test-clean test-int:
rm -f tests/.newsrc.eld rm -f tests/.newsrc.eld
$(CASK) exec ecukes --debug --reporter magnars $(CASK) exec ecukes --debug --reporter magnars
@ -109,9 +92,31 @@ dist-clean:
dist: dist-clean dist: dist-clean
$(CASK) package $(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 .PHONY: install
install: dist bundler install: dist backup-melpa
$(EMACS) -Q --batch -l package \ $(EMACS) -Q --batch --eval "(package-initialize)" \
--eval "(add-to-list 'package-archives '(\"melpa\" . \"https://melpa.org/packages/\"))" \ --eval "(add-to-list 'package-archives '(\"melpa\" . \"http://melpa.org/packages/\"))" \
--eval "(package-refresh-contents)" \ --eval "(package-refresh-contents)" \
--eval "(package-install-file (car (file-expand-wildcards \"dist/nndiscourse-$(VERSION).tar\")))" --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) .. COMMENTARY (see Makefile)
.. |build-status| .. |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 :target: https://github.com/dickmao/nndiscourse/actions
:alt: Build Status :alt: Build Status
.. |melpa-dev| .. |melpa-dev|
image:: https://melpa.org/packages/nndiscourse-badge.svg image:: http://melpa.milkbox.net/packages/nndiscourse-badge.svg
:target: http://melpa.org/#/nndiscourse :target: http://melpa.milkbox.net/#/nndiscourse
:alt: MELPA current version :alt: MELPA development 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:: screenshot.png .. image:: screenshot.png
.. |--| unicode:: U+2013 .. en dash .. |--| unicode:: U+2013 .. en dash
.. |---| unicode:: U+2014 .. em dash, trimming surrounding whitespace .. |---| unicode:: U+2014 .. em dash, trimming surrounding whitespace
:trim: :trim:
Does not work for sites requiring login 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.
======================================= ============
Some discourse instances allow unfettered public viewing, e.g., - `rbenv`_
``emacs-china.org``, ``devforum.roblox.com``. Others require login, e.g., - `rbenv.el`_
``discourse.doomemacs.org``. At the time I wrote nndiscourse, it was - `bundler`_
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>`_, .. _rbenv: https://github.com/rbenv/rbenv
it still looks really hard and undocumented. .. _rbenv.el: https://github.com/senny/rbenv.el
.. _bundler: https://bundler.io/
Install 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 M-x package-refresh-contents RET
git clone https://github.com/dickmao/nndiscourse.git M-x package-initialize RET
make -C nndiscourse install M-x package-install RET nndiscourse RET
Alternatively, directly clone this repo and ``make install``.
Also see Troubleshooting_.
Usage 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. 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 .. _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| .. |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 :target: https://github.com/dickmao/nndiscourse/actions
:alt: Build Status :alt: Build Status
.. |melpa-dev| .. |melpa-dev|
image:: https://melpa.org/packages/nndiscourse-badge.svg image:: http://melpa.milkbox.net/packages/nndiscourse-badge.svg
:target: http://melpa.org/#/nndiscourse :target: http://melpa.milkbox.net/#/nndiscourse
:alt: MELPA current version :alt: MELPA development 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:: screenshot.png .. image:: screenshot.png
.. |--| unicode:: U+2013 .. en dash .. |--| unicode:: U+2013 .. en dash
.. |---| unicode:: U+2014 .. em dash, trimming surrounding whitespace .. |---| unicode:: U+2014 .. em dash, trimming surrounding whitespace
:trim: :trim:
Does not work for sites requiring login Requirements
======================================= ============
Some discourse instances allow unfettered public viewing, e.g., - `rbenv`_
``emacs-china.org``, ``devforum.roblox.com``. Others require login, e.g., - `rbenv.el`_
``discourse.doomemacs.org``. At the time I wrote nndiscourse, it was - `bundler`_
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>`_, .. _rbenv: https://github.com/rbenv/rbenv
it still looks really hard and undocumented. .. _rbenv.el: https://github.com/senny/rbenv.el
.. _bundler: https://bundler.io/
Install 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 M-x package-refresh-contents RET
git clone https://github.com/dickmao/nndiscourse.git M-x package-initialize RET
make -C nndiscourse install M-x package-install RET nndiscourse RET
Alternatively, directly clone this repo and ``make install``.
Also see Troubleshooting_.
Usage 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. 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 .. _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 go to word "david"
And I press "RET" And I press "RET"
And I switch to buffer "*Article nndiscourse+meta.discourse.org:bug*" 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 prospective unreads for "nndiscourse+meta.discourse.org:bug" is 1
And I switch to buffer "*Summary nndiscourse+meta.discourse.org:bug*" And I switch to buffer "*Summary nndiscourse+meta.discourse.org:bug*"
And I press "q" And I press "q"

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

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

8
features/support/env.el
View File

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

630
nndiscourse.el
View File

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

27
nndiscourse/Gemfile.lock
View File

@ -8,17 +8,6 @@ GIT
faraday_middleware (~> 0.10) faraday_middleware (~> 0.10)
rack (>= 1.6) 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 PATH
remote: . remote: .
specs: specs:
@ -41,16 +30,21 @@ GEM
http-cookie (1.0.3) http-cookie (1.0.3)
domain_name (~> 0.5) domain_name (~> 0.5)
jaro_winkler (1.5.4) 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) mime-types (2.99.3)
multi_json (1.15.0) multi_json (1.14.1)
multipart-post (2.1.1) multipart-post (2.1.1)
netrc (0.11.0) netrc (0.11.0)
parallel (1.19.1) parallel (1.19.1)
parser (2.7.0.2) parser (2.7.0.2)
ast (~> 2.4.0) ast (~> 2.4.0)
rack (2.2.3) rack (1.6.12)
rainbow (3.0.0) rainbow (3.0.0)
rake (13.0.1) rake (11.3.0)
rest-client (1.8.0) rest-client (1.8.0)
http-cookie (>= 1.0.2, < 2.0) http-cookie (>= 1.0.2, < 2.0)
mime-types (>= 1.16, < 3.0) mime-types (>= 1.16, < 3.0)
@ -79,7 +73,7 @@ GEM
thor (0.20.3) thor (0.20.3)
unf (0.1.4) unf (0.1.4)
unf_ext unf_ext
unf_ext (0.0.7.7) unf_ext (0.0.7.6)
unicode-display_width (1.6.1) unicode-display_width (1.6.1)
PLATFORMS PLATFORMS
@ -88,9 +82,8 @@ PLATFORMS
DEPENDENCIES DEPENDENCIES
bundler (~> 2.0) bundler (~> 2.0)
discourse_api! discourse_api!
jimson!
nndiscourse! nndiscourse!
rake (~> 13.0) rake (~> 11.1)
rspec (~> 3.4) rspec (~> 3.4)
rubocop (~> 0.69) 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_runtime_dependency 'thor', '~> 0.20.3'
spec.add_development_dependency 'bundler', '~> 2.0' 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 'rspec', '~> 3.4'
spec.add_development_dependency 'rubocop', '~> 0.69' spec.add_development_dependency 'rubocop', '~> 0.69'
end end

2
scratch.el
View File

@ -326,7 +326,7 @@
;; eww doesn't fly for lack of javascript ;; eww doesn't fly for lack of javascript
(build-query "http://localhost:3000") (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') ;; 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') ;; proc = Nndiscourse::Process.new('http://localhost:3000', 'b28f0cea1b4fb749b9a3b8683760388c', 'priapushk')
;; (let ((user-api-key ;; (let ((user-api-key

5
tests/nndiscourse-test.el
View File

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

1
tests/test-uncacheable.el
View File

@ -1,4 +1,3 @@
;;; -*- lexical-binding: t; coding: utf-8 -*-
(require 'nndiscourse-test) (require 'nndiscourse-test)
;; since nndiscourse has fixed numbering, maybe we *can* use gnus-cache ;; 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 #!/bin/sh -ex
export EMACS="${EMACS:=emacs}" EMACS="${EMACS:=emacs}"
export BASENAME=$(basename "$1") BASENAME=$(basename "$1")
( cask emacs -Q --batch \ ( cask emacs -Q --batch \
--visit "$1" \ --visit "$1" \
@ -10,12 +10,11 @@ export BASENAME=$(basename "$1")
(buffer-string)))" \ (buffer-string)))" \
2>&1 | egrep -a "^$BASENAME:" ) && false 2>&1 | egrep -a "^$BASENAME:" ) && false
!( cask emacs -Q --batch \ cask emacs -Q --batch \
-l package-lint \ -l package-lint \
--eval "(package-initialize)" \ --eval "(package-initialize)" \
--eval "(push (quote (\"melpa\" . \"http://melpa.org/packages/\")) \ --eval "(push (quote (\"melpa\" . \"http://melpa.org/packages/\")) \
package-archives)" \ package-archives)" \
--eval "(package-refresh-contents)" \ --eval "(package-refresh-contents)" \
--eval "(setq debug-on-error t)" \ --eval "(setq debug-on-error t)" \
-f package-lint-batch-and-exit "$1" \ -f package-lint-batch-and-exit "$1"
2>&1 | egrep -a "^$BASENAME:" | egrep -v "non-snapshot" | egrep .)

4
tools/recipe
View File

@ -1,3 +1,3 @@
(nndiscourse :repo "dickmao/nndiscourse" nndiscourse :repo "dickmao/nndiscourse"
:fetcher github :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
}