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

cite parent #3

Merged
dickmao merged 1 commits from dev into master 2020-02-14 17:26:22 +00:00
Conversation 0 Commits 1 Files Changed 1
1 changed files with 63 additions and 51 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

114
nndiscourse.el
View File

@ -126,7 +126,7 @@ Starting in emacs-src commit c1b63af, Gnus moved from obarrays to normal hashtab
(let* ((capture (nndiscourse--gethash string hashtable)) (let* ((capture (nndiscourse--gethash string hashtable))
(replace-with (funcall func capture))) (replace-with (funcall func capture)))
(if (fboundp 'gnus-sethash) (if (fboundp 'gnus-sethash)
(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) (defmacro nndiscourse--sethash (string value hashtable)
@ -221,7 +221,7 @@ Starting in emacs-src commit c1b63af, Gnus moved from obarrays to normal hashtab
(defvar-local nndiscourse--refs-hashtb (gnus-make-hashtable) (defvar-local nndiscourse--refs-hashtb (gnus-make-hashtable)
"Id -> parent. Buffer-local to individual servers' proc buffer.") "Id -> parent. Buffer-local to individual servers' proc buffer.")
(defun nndiscourse-get-ref (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."
(declare (indent defun)) (declare (indent defun))
(with-current-buffer (nndiscourse--server-buffer server) (with-current-buffer (nndiscourse--server-buffer server)
@ -649,6 +649,13 @@ Originally written by Paul Issartel."
(= 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)
"O(n) search for first header satisfying SERVER GROUP TOPIC-ID."
(declare (indent defun))
(-when-let* ((headers (nndiscourse-get-headers server group)))
(seq-find (lambda (plst) (= topic-id (plist-get plst :topic_id)))
headers)))
(defsubst nndiscourse-hash-count (table-or-obarray) (defsubst nndiscourse-hash-count (table-or-obarray)
"Return number items in TABLE-OR-OBARRAY." "Return number items in TABLE-OR-OBARRAY."
(let ((result 0)) (let ((result 0))
@ -688,13 +695,18 @@ Originally written by Paul Issartel."
(full-group (gnus-group-full-name (full-group (gnus-group-full-name
group group
(cons 'nndiscourse (list server))))) (cons 'nndiscourse (list server)))))
(when-let ((parent-number (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 (plist-get plst :topic_id) server group
parent-number) (plist-get plst :topic_id) it)
: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) (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
@ -742,7 +754,7 @@ Originally written by Paul Issartel."
(defsubst nndiscourse--make-references (server id) (defsubst nndiscourse--make-references (server id)
"For SERVER, construct a space delimited string of message ancestors of ID." "For SERVER, construct a space delimited string of message ancestors of ID."
(mapconcat (lambda (ref) (nndiscourse--make-message-id ref)) (mapconcat (lambda (ref) (nndiscourse--make-message-id ref))
(nndiscourse-get-ref server id) " ")) (nndiscourse-get-refs server id) " "))
(defsubst nndiscourse--make-header (server group article-number) (defsubst nndiscourse--make-header (server group article-number)
"Construct mail headers from article header. "Construct mail headers from article header.
@ -797,7 +809,7 @@ article header. Gnus manual does say the term `header` is oft conflated."
"Score: " score "\n" "Score: " score "\n"
"\n") "\n")
(-when-let* (-when-let*
((parent (plist-get header :parent)) ((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)
:username) :username)
@ -1110,75 +1122,75 @@ Written by John Wiegley (https://github.com/jwiegley/dot-emacs).")
"Override `mm-with-part' massaging message from HANDLE then executing FORMS." "Override `mm-with-part' massaging message from HANDLE then executing FORMS."
`(let* ((handle ,handle)) `(let* ((handle ,handle))
(when (and (mm-handle-buffer handle) (when (and (mm-handle-buffer handle)
(buffer-name (mm-handle-buffer handle))) (buffer-name (mm-handle-buffer handle)))
(with-temp-buffer (with-temp-buffer
(set-buffer-multibyte (buffer-local-value 'enable-multibyte-characters (set-buffer-multibyte (buffer-local-value 'enable-multibyte-characters
(mm-handle-buffer handle))) (mm-handle-buffer handle)))
(insert-buffer-substring (mm-handle-buffer handle)) (insert-buffer-substring (mm-handle-buffer handle))
(mm-decode-content-transfer-encoding (mm-decode-content-transfer-encoding
(mm-handle-encoding handle) (mm-handle-encoding handle)
(mm-handle-media-type handle)) (mm-handle-media-type handle))
,@forms)))) ,@forms))))
(defun nndiscourse-shr (handle) (defun nndiscourse-shr (handle)
"Override `mm-shr' for HANDLE." "Override `mm-shr' for HANDLE."
(require 'shr) (require 'shr)
(let ((shr-width (if shr-use-fonts (let ((shr-width (if shr-use-fonts
nil nil
fill-column)) fill-column))
(shr-content-function (lambda (id) (shr-content-function (lambda (id)
(let ((handle (mm-get-content-id id))) (let ((handle (mm-get-content-id id)))
(when handle (when handle
(nndiscourse-with-part handle (nndiscourse-with-part handle
(buffer-string)))))) (buffer-string))))))
(shr-inhibit-images mm-html-inhibit-images) (shr-inhibit-images mm-html-inhibit-images)
(shr-blocked-images mm-html-blocked-images) (shr-blocked-images mm-html-blocked-images)
charset coding char document) charset coding char document)
(nndiscourse-with-part (or handle (setq handle (mm-dissect-buffer t))) (nndiscourse-with-part (or handle (setq handle (mm-dissect-buffer t)))
(setq case-fold-search t) (setq case-fold-search t)
(or (setq charset (or (setq charset
(mail-content-type-get (mm-handle-type handle) 'charset)) (mail-content-type-get (mm-handle-type handle) 'charset))
(progn (progn
(goto-char (point-min)) (goto-char (point-min))
(and (re-search-forward "\ (and (re-search-forward "\
<meta\\s-+http-equiv=[\"']?content-type[\"']?\\s-+content=[\"']?\ <meta\\s-+http-equiv=[\"']?content-type[\"']?\\s-+content=[\"']?\
text/html;\\s-*charset=\\([^\t\n\r \"'>]+\\)[^>]*>" nil t) text/html;\\s-*charset=\\([^\t\n\r \"'>]+\\)[^>]*>" nil t)
(setq coding (mm-charset-to-coding-system (match-string 1) (setq coding (mm-charset-to-coding-system (match-string 1)
nil t)))) nil t))))
(setq charset mail-parse-charset)) (setq charset mail-parse-charset))
(when (and (or coding (when (and (or coding
(setq coding (mm-charset-to-coding-system charset nil t))) (setq coding (mm-charset-to-coding-system charset nil t)))
(not (eq coding 'ascii))) (not (eq coding 'ascii)))
(insert (prog1 (insert (prog1
(decode-coding-string (buffer-string) coding) (decode-coding-string (buffer-string) coding)
(erase-buffer) (erase-buffer)
(set-buffer-multibyte t)))) (set-buffer-multibyte t))))
(goto-char (point-min)) (goto-char (point-min))
(while (re-search-forward (while (re-search-forward
"&#\\(?:x\\([89][0-9a-f]\\)\\|\\(1[2-5][0-9]\\)\\);" nil t) "&#\\(?:x\\([89][0-9a-f]\\)\\|\\(1[2-5][0-9]\\)\\);" nil t)
(when (setq char (when (setq char
(cdr (assq (if (match-beginning 1) (cdr (assq (if (match-beginning 1)
(string-to-number (match-string 1) 16) (string-to-number (match-string 1) 16)
(string-to-number (match-string 2))) (string-to-number (match-string 2)))
mm-extra-numeric-entities))) mm-extra-numeric-entities)))
(replace-match (char-to-string char)))) (replace-match (char-to-string char))))
;; Remove "soft hyphens". ;; Remove "soft hyphens".
(goto-char (point-min)) (goto-char (point-min))
(while (search-forward "­" nil t) (while (search-forward "­" nil t)
(replace-match "" t t)) (replace-match "" t t))
(setq document (libxml-parse-html-region (point-min) (point-max)))) (setq document (libxml-parse-html-region (point-min) (point-max))))
(save-restriction (save-restriction
(narrow-to-region (point) (point)) (narrow-to-region (point) (point))
(shr-insert-document document) (shr-insert-document document)
(unless (bobp) (unless (bobp)
(insert "\n")) (insert "\n"))
(mm-handle-set-undisplayer (mm-handle-set-undisplayer
handle handle
(let ((min (point-min-marker)) (let ((min (point-min-marker))
(max (point-max-marker))) (max (point-max-marker)))
(lambda () (lambda ()
(let ((inhibit-read-only t)) (let ((inhibit-read-only t))
(delete-region min max)))))))) (delete-region min max))))))))
(setf (alist-get 'shr mm-text-html-renderer-alist) 'nndiscourse-shr) (setf (alist-get 'shr mm-text-html-renderer-alist) 'nndiscourse-shr)