Add Requirements to docs #6
|
|
@ -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
2
Cask
|
|
@ -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
85
Makefile
|
|
@ -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\")))"
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
||||
============
|
||||
- `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
53
README.rst
|
|
@ -1,42 +1,47 @@
|
|||
|build-status| |melpa-dev|
|
||||
|build-status|
|
||||
|
||||
|
||||
Review
It appears when you 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
|
||||
|
|
|
|||
|
|
@ -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"
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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
630
nndiscourse.el
|
|
@ -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 +0,0 @@
|
|||
2.6.2
|
||||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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,4 +1,3 @@
|
|||
;;; -*- lexical-binding: t; coding: utf-8 -*-
|
||||
(require 'nndiscourse-test)
|
||||
|
||||
;; since nndiscourse has fixed numbering, maybe we *can* use gnus-cache
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
@ -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"
|
||||
|
|
|
|||
|
|
@ -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")))
|
||||
|
|
|
|||
|
|
@ -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
|
||||
}
|
||||
Loading…
Reference in New Issue
rbenv.elshould 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.