237 lines
8.1 KiB
EmacsLisp
237 lines
8.1 KiB
EmacsLisp
|
;;; sx-question.el --- question logic -*- lexical-binding: t; -*-
|
|||
|
|
|
|||
|
|
;; Copyright (C) 2014 Sean Allred
|
|||
|
|
|
|||
|
|
;; Author: Sean Allred <code@seanallred.com>
|
|||
|
|
|
|||
|
|
;; This program is free software; you can redistribute it and/or modify
|
|||
|
|
;; it under the terms of the GNU General Public License as published by
|
|||
|
|
;; the Free Software Foundation, either version 3 of the License, or
|
|||
|
|
;; (at your option) any later version.
|
|||
|
|
|
|||
|
|
;; This program is distributed in the hope that it will be useful,
|
|||
|
|
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
|
|||
|
|
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
|
|||
|
|
;; GNU General Public License for more details.
|
|||
|
|
|
|||
|
|
;; You should have received a copy of the GNU General Public License
|
|||
|
|
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
|
|||
|
|
|
|||
|
|
;;; Commentary:
|
|||
|
|
|
|||
|
|
;; This file provides an API for retrieving questions and defines
|
|||
|
|
;; additional logic for marking questions as read or hidden.
|
|||
|
|
|
|||
|
|
|
|||
|
|
;;; Code:
|
|||
|
|
|
|||
|
|
(require 'sx)
|
|||
|
|
(require 'sx-filter)
|
|||
|
|
(require 'sx-method)
|
|||
|
|
|
|||
|
|
(defun sx-question-get-questions (site &optional page keywords submethod)
|
|||
|
|
"Get SITE questions. Return page PAGE (the first if nil).
|
|||
|
|
Return a list of question. Each question is an alist of
|
|||
|
|
properties returned by the API with an added (site SITE)
|
|||
|
|
property.
|
|||
|
|
|
|||
|
|
KEYWORDS are added to the method call along with PAGE.
|
|||
|
|
|
|||
|
|
`sx-method-call' is used with `sx-browse-filter'."
|
|||
|
|
(sx-method-call 'questions
|
|||
|
|
:keywords `((page . ,page) ,@keywords)
|
|||
|
|
:site site
|
|||
|
|
:auth t
|
|||
|
|
:submethod submethod
|
|||
|
|
:filter sx-browse-filter))
|
|||
|
|
|
|||
|
|
(defun sx-question-get-question (site question-id)
|
|||
|
|
"Query SITE for a QUESTION-ID and return it.
|
|||
|
|
If QUESTION-ID doesn't exist on SITE, raise an error."
|
|||
|
|
(let ((res (sx-method-call 'questions
|
|||
|
|
:id question-id
|
|||
|
|
:site site
|
|||
|
|
:auth t
|
|||
|
|
:filter sx-browse-filter)))
|
|||
|
|
(if res (elt res 0)
|
|||
|
|
(error "Couldn't find question %S in %S"
|
|||
|
|
question-id site))))
|
|||
|
|
|
|||
|
|
(defun sx-question-get-from-answer (site answer-id)
|
|||
|
|
"Get question from SITE to which ANSWER-ID belongs.
|
|||
|
|
If ANSWER-ID doesn't exist on SITE, raise an error."
|
|||
|
|
(let ((res (sx-method-call 'answers
|
|||
|
|
:id answer-id
|
|||
|
|
:site site
|
|||
|
|
:submethod 'questions
|
|||
|
|
:auth t
|
|||
|
|
:filter sx-browse-filter)))
|
|||
|
|
(if res (elt res 0)
|
|||
|
|
(error "Couldn't find answer %S in %S"
|
|||
|
|
answer-id site))))
|
|||
|
|
|
|||
|
|
(defun sx-question-get-from-comment (site comment-id)
|
|||
|
|
"Get question from SITE to which COMMENT-ID belongs.
|
|||
|
|
If COMMENT-ID doesn't exist on SITE, raise an error.
|
|||
|
|
|
|||
|
|
Note this requires two API requests. One for the comment and one
|
|||
|
|
for the post."
|
|||
|
|
(let ((res (sx-method-call 'comments
|
|||
|
|
:id comment-id
|
|||
|
|
:site site
|
|||
|
|
:auth t
|
|||
|
|
:filter sx-browse-filter)))
|
|||
|
|
(unless res
|
|||
|
|
(error "Couldn't find comment %S in %S" comment-id site))
|
|||
|
|
(sx-assoc-let (elt res 0)
|
|||
|
|
(funcall (if (string= .post_type "answer")
|
|||
|
|
#'sx-question-get-from-answer
|
|||
|
|
#'sx-question-get-question)
|
|||
|
|
.site_par
|
|||
|
|
.post_id))))
|
|||
|
|
|
|||
|
|
|
|||
|
|
;;; Question Properties
|
|||
|
|
|
|||
|
|
;;;; Read/unread
|
|||
|
|
(defvar sx-question--user-read-list nil
|
|||
|
|
"Alist of questions read by the user.
|
|||
|
|
|
|||
|
|
Each element has the form
|
|||
|
|
|
|||
|
|
(SITE . QUESTION-LIST)
|
|||
|
|
|
|||
|
|
where each element in QUESTION-LIST has the form
|
|||
|
|
|
|||
|
|
(QUESTION_ID . LAST-VIEWED-DATE).")
|
|||
|
|
|
|||
|
|
(defun sx-question--ensure-read-list (site)
|
|||
|
|
"Ensure `sx-question--user-read-list' has been read from cache.
|
|||
|
|
If no cache exists for it, initialize one with SITE."
|
|||
|
|
(unless sx-question--user-read-list
|
|||
|
|
(setq sx-question--user-read-list
|
|||
|
|
(sx-cache-get 'read-questions `'((,site))))))
|
|||
|
|
|
|||
|
|
(defun sx-question--read-p (question)
|
|||
|
|
"Non-nil if QUESTION has been read since last updated.
|
|||
|
|
See `sx-question--user-read-list'."
|
|||
|
|
(sx-assoc-let question
|
|||
|
|
(sx-question--ensure-read-list .site_par)
|
|||
|
|
(let ((ql (cdr (assoc .site_par sx-question--user-read-list))))
|
|||
|
|
(and ql
|
|||
|
|
(>= (or (cdr (assoc .question_id ql)) 0)
|
|||
|
|
.last_activity_date)))))
|
|||
|
|
|
|||
|
|
(defmacro sx-sorted-insert-skip-first (newelt list &optional predicate)
|
|||
|
|
"Inserted NEWELT into LIST sorted by PREDICATE.
|
|||
|
|
This is designed for the (site id id ...) lists. So the first car
|
|||
|
|
is intentionally skipped."
|
|||
|
|
`(let ((tail ,list)
|
|||
|
|
(x ,newelt))
|
|||
|
|
(while (and ;; We're not at the end.
|
|||
|
|
(cdr-safe tail)
|
|||
|
|
;; We're not at the right place.
|
|||
|
|
(funcall (or #',predicate #'<) x (cadr tail)))
|
|||
|
|
(setq tail (cdr tail)))
|
|||
|
|
(setcdr tail (cons x (cdr tail)))))
|
|||
|
|
|
|||
|
|
(defun sx-question--mark-read (question)
|
|||
|
|
"Mark QUESTION as being read until it is updated again.
|
|||
|
|
Returns nil if question (in its current state) was already marked
|
|||
|
|
read, i.e., if it was `sx-question--read-p'.
|
|||
|
|
See `sx-question--user-read-list'."
|
|||
|
|
(prog1
|
|||
|
|
(sx-assoc-let question
|
|||
|
|
(sx-question--ensure-read-list .site_par)
|
|||
|
|
(let ((site-cell (assoc .site_par sx-question--user-read-list))
|
|||
|
|
(q-cell (cons .question_id .last_activity_date))
|
|||
|
|
cell)
|
|||
|
|
(cond
|
|||
|
|
;; First question from this site.
|
|||
|
|
((null site-cell)
|
|||
|
|
(push (list .site_par q-cell) sx-question--user-read-list))
|
|||
|
|
;; Question already present.
|
|||
|
|
((setq cell (assoc .question_id site-cell))
|
|||
|
|
;; Current version is newer than cached version.
|
|||
|
|
(when (or (not (numberp (cdr cell)))
|
|||
|
|
(> .last_activity_date (cdr cell)))
|
|||
|
|
(setcdr cell .last_activity_date)))
|
|||
|
|
;; Question wasn't present.
|
|||
|
|
(t
|
|||
|
|
(sx-sorted-insert-skip-first
|
|||
|
|
q-cell site-cell
|
|||
|
|
(lambda (x y) (> (or (car x) -1) (or (car y) -1))))))))
|
|||
|
|
;; Save the results.
|
|||
|
|
;; @TODO This causes a small lag on `j' and `k' as the list gets
|
|||
|
|
;; large. Should we do this on a timer?
|
|||
|
|
(sx-cache-set 'read-questions sx-question--user-read-list)))
|
|||
|
|
|
|||
|
|
|
|||
|
|
;;;; Hidden
|
|||
|
|
(defvar sx-question--user-hidden-list nil
|
|||
|
|
"Alist of questions hidden by the user.
|
|||
|
|
|
|||
|
|
Each element has the form
|
|||
|
|
|
|||
|
|
(SITE QUESTION_ID QUESTION_ID ...)")
|
|||
|
|
|
|||
|
|
(defun sx-question--ensure-hidden-list (site)
|
|||
|
|
"Ensure the `sx-question--user-hidden-list' has been read from cache.
|
|||
|
|
|
|||
|
|
If no cache exists for it, initialize one with SITE."
|
|||
|
|
(unless sx-question--user-hidden-list
|
|||
|
|
(setq sx-question--user-hidden-list
|
|||
|
|
(sx-cache-get 'hidden-questions `'((,site))))))
|
|||
|
|
|
|||
|
|
(defun sx-question--hidden-p (question)
|
|||
|
|
"Non-nil if QUESTION has been hidden."
|
|||
|
|
(sx-assoc-let question
|
|||
|
|
(sx-question--ensure-hidden-list .site_par)
|
|||
|
|
(let ((ql (cdr (assoc .site_par sx-question--user-hidden-list))))
|
|||
|
|
(and ql (memq .question_id ql)))))
|
|||
|
|
|
|||
|
|
(defun sx-question--mark-hidden (question)
|
|||
|
|
"Mark QUESTION as being hidden."
|
|||
|
|
(sx-assoc-let question
|
|||
|
|
(let ((site-cell (assoc .site_par sx-question--user-hidden-list)))
|
|||
|
|
;; If question already hidden, do nothing.
|
|||
|
|
(unless (memq .question_id site-cell)
|
|||
|
|
(if (null site-cell)
|
|||
|
|
;; First question from this site.
|
|||
|
|
(push (list .site_par .question_id) sx-question--user-hidden-list)
|
|||
|
|
;; Not first question and question wasn't present.
|
|||
|
|
;; Add it in, but make sure it's sorted (just in case we
|
|||
|
|
;; decide to rely on it later).
|
|||
|
|
(sx-sorted-insert-skip-first .question_id site-cell >))
|
|||
|
|
;; Save the results.
|
|||
|
|
(sx-cache-set 'hidden-questions sx-question--user-hidden-list)))))
|
|||
|
|
|
|||
|
|
|
|||
|
|
;;;; Other data
|
|||
|
|
(defun sx-question--accepted-answer-id (question)
|
|||
|
|
"Return accepted answer in QUESTION or nil if none exists."
|
|||
|
|
(sx-assoc-let question
|
|||
|
|
(and (integerp .accepted_answer_id)
|
|||
|
|
.accepted_answer_id)))
|
|||
|
|
|
|||
|
|
|
|||
|
|
;;; Question Mode Answer-Sorting Functions
|
|||
|
|
(sx--create-comparator sx-answer-higher-score-p
|
|||
|
|
"Return t if answer A has a higher score than answer B."
|
|||
|
|
#'> (lambda (x) (cdr (assq 'score x))))
|
|||
|
|
|
|||
|
|
(sx--create-comparator sx-answer-newer-p
|
|||
|
|
"Return t if answer A was posted later than answer B."
|
|||
|
|
#'> (lambda (x) (cdr (assq 'creation_date x))))
|
|||
|
|
|
|||
|
|
(sx--create-comparator sx-answer-more-active-p
|
|||
|
|
"Return t if answer A was updated after answer B."
|
|||
|
|
#'> (lambda (x) (cdr (assq 'last_activity_date x))))
|
|||
|
|
|
|||
|
|
(provide 'sx-question)
|
|||
|
|
;;; sx-question.el ends here
|
|||
|
|
|
|||
|
|
;; Local Variables:
|
|||
|
|
;; indent-tabs-mode: nil
|
|||
|
|
;; End:
|