Merge pull request #257 from vermiculus/more-ordering

More ordering

5 files changed, 227 insertions, 194 deletions

diff --git a/README.org b/README.org
index 4071561..9fec35b 100644
--- a/README.org
+++ b/README.org
@@ -17,35 +17,32 @@ Emacs itself.
 View questions with one of the ~sx-tab-~ commands.  These translate to the
 different 'tabs' that you can view on the official site.  Implemented tabs
 include:
-- =frontpage= :: The default front page of questions.
-- =newest= :: Newest questions first.
-- =topvoted= :: Highest-voted questions first.
-- =hot= :: Questions with the most views, answers, and votes over the last few
-           days.
-- =week= :: Questions with the most views, answers, and votes this week.
-- =month= :: Questions with the most views, answers, and votes this month.
-The meaning of these tabs hopefully needs no explanation, but the official
-behavior is given as a tooltip on any site in the StackExchange network.
-
-Each of these opens up a list of questions.  Switch sites with =:=.  Navigate
-this list of questions with =jk= or =np=.  =jk= will also view the question in a
-separate buffer.  =v= will visit the question in your browser where =w= will
-simply copy a link.  Upvote and downvote with =u= and =d=.  =RET= will take you
-to the question buffer, where =RET= on headlines will expand and collapse each
-section.  Add comments with =c=.
+
+- ~sx-tab-all-questions~      :: All questions.
+- ~sx-tab-unanswered~         :: Unanswered questions.
+- ~sx-tab-unanswered-my-tags~ :: Unanswered questions in your followed tags.
+- ~sx-tab-featured~           :: Featured questions.
+- ~sx-tab-starred~            :: Your starred questions.
+
+Each of these opens up a list of questions, and you can further customize the
+ordering of the list with =O=.  Other keys include:
+
+- =s s= :: Switch site.
+- =n= and =p= :: Navigate the list.
+- =j= and =k= :: Navigate while viewing the question in a separate buffer.
+- =v= :: Visit the thing-at-point in your browser
+- =w= :: Copy the thing-at-point (usually a link).
+- =u= and =d= :: Upvote and downvote.
+- =RET= :: Open the question buffer.
 
 As always, =C-h m= is the definitive resource for the functions of this mode.
 
 * Installation
-SX is now available on MELPA!  Install it via the usual method or run =M-x
-package-install RET sx RET=.
-
-To install the development version, follow the usual steps:
-- Clone this repository
-- Add this directory to your ~load-path~
-- Issue ~(require 'sx-load)~
-This should give you access to the ~sx-tab-~ functions (the main entry points at
-this time).
+SX is now available on MELPA!  Both the stable release and the development
+version can be found there.  Install it via the Package Menu or just run
+#+BEGIN_SRC text
+M-x package-install RET sx RET=
+#+END_SRC
 
 If you are going to be doing any asking / answering / commenting / upvoting /
 downvoting / /etc./, you must use ~sx-authenticate~ to provide SX with an
diff --git a/sx-question-list.el b/sx-question-list.el
index 4f298a3..f8f8fc6 100644
--- a/sx-question-list.el
+++ b/sx-question-list.el
@@ -245,12 +245,11 @@ This list must follow the form described in
    sx-question-list--key-definitions)
   "Header-line used on the question list.")
 
-(defconst sx-question-list--order-methods
+(defvar sx-question-list--order-methods
   '(("Recent Activity" . activity)
     ("Creation Date"   . creation)
     ("Most Voted"      . votes)
-    ("Score"           . votes)
-    ("Hot"             . hot))
+    ("Score"           . votes))
   "Alist of possible values to be passed to the `sort' keyword.")
 (make-variable-buffer-local 'sx-question-list--order-methods)
 
@@ -263,6 +262,20 @@ is used."
                 (mapcar #'car sx-question-list--order-methods))))
     (cdr-safe (assoc-string order sx-question-list--order-methods))))
 
+(defun sx-question-list--make-pager (method &optional submethod)
+  "Return a function suitable for use as a question list pager.
+Meant to be used as `sx-question-list--next-page-function'."
+  (lambda (page)
+    (sx-method-call method
+      :keywords `((page . ,page)
+                  ,@(when sx-question-list--order
+                      `((order . ,(if sx-question-list--descending 'desc 'asc))
+                        (sort . ,sx-question-list--order))))
+      :site sx-question-list--site
+      :auth t
+      :submethod submethod
+      :filter sx-browse-filter)))
+
 
 ;;; Mode Definition
 (define-derived-mode sx-question-list-mode
@@ -357,6 +370,9 @@ into consideration.  The same holds for `sx-question-list--order'.
                       (kbd ,(car x)) #',(cadr x))))
   sx-question-list--key-definitions)
 
+(sx--define-conditional-key sx-question-list-mode-map "O" #'sx-question-list-order-by
+  (and (boundp 'sx-question-list--order) sx-question-list--order))
+
 (defun sx-question-list-hide (data)
   "Hide question under point.
 Non-interactively, DATA is a question alist."
@@ -422,7 +438,14 @@ Non-interactively, DATA is a question alist."
 (make-variable-buffer-local 'sx-question-list--site)
 
 (defvar sx-question-list--order nil
-  "Order being displayed in the *question-list* buffer.")
+  "Order being displayed in the *question-list* buffer.
+This is also affected by `sx-question-list--descending'.")
+(make-variable-buffer-local 'sx-question-list--order)
+
+(defvar sx-question-list--descending t
+  "In which direction should `sx-question-list--order' be sorted.
+If non-nil (default), descending.
+If nil, ascending.")
 (make-variable-buffer-local 'sx-question-list--order)
 
 (defun sx-question-list-refresh (&optional redisplay no-update)
@@ -597,17 +620,22 @@ Sets `sx-question-list--site' and then call
     (setq sx-question-list--site site)
     (sx-question-list-refresh 'redisplay)))
 
-(defun sx-question-list-order-by (sort)
+(defun sx-question-list-order-by (sort &optional ascend)
   "Order questions in the current list by the method SORT.
 Sets `sx-question-list--order' and then calls
-`sx-question-list-refresh' with `redisplay'."
+`sx-question-list-refresh' with `redisplay'.
+
+With a prefix argument or a non-nil ASCEND, invert the sorting
+order."
   (interactive
    (list (when sx-question-list--order
-           (sx-question-list--interactive-order-prompt))))
+           (sx-question-list--interactive-order-prompt))
+         current-prefix-arg))
   (unless sx-question-list--order
     (sx-user-error "This list can't be reordered"))
   (when (and sort (symbolp sort))
     (setq sx-question-list--order sort)
+    (setq sx-question-list--descending (not ascend))
     (sx-question-list-refresh 'redisplay)))
 
 (provide 'sx-question-list)
diff --git a/sx-search.el b/sx-search.el
index b245cbe..d0fa892 100644
--- a/sx-search.el
+++ b/sx-search.el
@@ -65,13 +65,18 @@ KEYWORDS is passed to `sx-method-call'."
 
 (defconst sx-search--order-methods
   (cons '("Relevance" . relevance)
-        (cl-remove-if (lambda (x) (eq (cdr x) 'hot))
-                      (default-value 'sx-question-list--order-methods)))
+        (default-value 'sx-question-list--order-methods))
   "Alist of possible values to be passed to the `sort' keyword.")
 
-(defvar sx-search-default-order 'activity 
+(defcustom sx-search-default-order 'activity
   "Default ordering method used on new searches.
-Possible values are the cdrs of `sx-search--order-methods'.")
+Possible values are the cdrs of `sx-search--order-methods'."
+  :type (cons 'choice
+              (mapcar (lambda (c) `(const :tag ,(car c) ,(cdr c)))
+                (cl-remove-duplicates
+                 sx-search--order-methods
+                 :key #'cdr)))
+  :group 'sx-question-list)
 
 
 ;;;###autoload
@@ -111,6 +116,7 @@ prefix argument, the user is asked for everything."
             (sx-search-get-questions
              sx-question-list--site page
              query tags excluded-tags
+             (cons 'order (if sx-question-list--descending 'desc 'asc))
              (cons 'sort sx-question-list--order))))
     (setq sx-question-list--site site)
     (setq sx-question-list--order sx-search-default-order)
diff --git a/sx-tab.el b/sx-tab.el
index 2d605a5..98b1b26 100644
--- a/sx-tab.el
+++ b/sx-tab.el
@@ -24,16 +24,11 @@
 
 ;;; Tabs:
 
-;; - FrontPage          :: The standard front page
-;; - Newest             :: Newest questions
-;; - TopVoted           :: Top-voted questions
-;; - Hot                :: Hot questions recently
-;; - Week               :: Hot questions for the week
-;; - Month              :: Hot questions for the month
-;; - Unanswered         :: Unanswered questions
-;; - Unanswered My-tags :: Unanswered questions (subscribed tags)
-;; - Featured           :: Featured questions
-;; - Starred            :: Favorite questions
+;; - `sx-tab-all-questions'      :: All questions.
+;; - `sx-tab-unanswered'         :: Unanswered questions.
+;; - `sx-tab-unanswered-my-tags' :: Unanswered questions in your followed tags.
+;; - `sx-tab-featured'           :: Featured questions.
+;; - `sx-tab-starred'            :: Starred questions.
 
 ;;; Code:
 
@@ -45,7 +40,7 @@
   "List of the names of all defined tabs.")
 
 (defun sx-tab-switch (tab)
-  "Switch to another question-list tab."
+  "Switch to another question-list TAB."
   (interactive
    (list (sx-completing-read
           "Switch to tab: " sx-tab--list
@@ -53,9 +48,36 @@
           t)))
   (funcall (intern (format "sx-tab-%s" (downcase tab)))))
 
+(defconst sx-tab--order-methods
+  `(,@(default-value 'sx-question-list--order-methods)
+    ("Hottest Now"     . hot)
+    ("Weekly Hottest"  . week)
+    ("Monthly Hottest" . month))
+  "Alist of possible values to be passed to the `sort' keyword.")
+
+(defcustom sx-tab-default-order 'activity
+  "Default ordering method used on `sx-tab-questions' and the likes.
+Possible values are the cdrs of `sx-tab--order-methods'."
+  :type (cons 'choice
+              (mapcar (lambda (c) `(const :tag ,(car c) ,(cdr c)))
+                (cl-remove-duplicates
+                 sx-tab--order-methods
+                 :key #'cdr)))
+  :group 'sx-question-list)
+
+(eval-and-compile
+  (defconst sx-tab--docstring-format
+    "Display a list of %s questions for SITE.
+The variable `sx-tab-default-order' can be used to customize the
+sorting of the resulting list.
+
+NO-UPDATE (the prefix arg) is passed to `sx-question-list-refresh'.
+If SITE is nil, use `sx-default-site'."
+    "Format used on the docstring of `sx-tab-*' commands."))
+
 
 ;;; The main macro
-(defmacro sx-tab--define (tab pager &optional printer refresher
+(defmacro sx-tab--define (tab pager &optional printer refresher obsolete
                               &rest body)
   "Define a StackExchange tab called TAB.
 TAB is a capitalized string.
@@ -69,24 +91,27 @@ respectively used to set the value of the variables
 `sx-question-list--refresh-function', and
 `sx-question-list--next-page-function'.
 
+If OBSOLETE is non-nil, it should be a string indicating the tab
+to use instead of this one.
+
 BODY is evaluated after activating the mode and setting these
 variables, but before refreshing the display."
   (declare (indent 1) (debug t))
   (let* ((name (downcase tab))
          (buffer-variable
-          (intern (concat "sx-tab--" name "-buffer"))))
+          (intern (format "sx-tab--%s-buffer"
+                    (if obsolete (downcase obsolete)
+                      name))))
+         (function-name
+          (intern (concat "sx-tab-" name)))
+         (use-instead
+          (when obsolete (intern (concat "sx-tab-" (downcase obsolete))))))
     `(progn
-       (defvar ,buffer-variable nil
-         ,(format "Buffer where the %s questions are displayed."
-            tab))
-       (defun
-           ,(intern (concat "sx-tab-" name))
-           (&optional no-update site)
-         ,(format "Display a list of %s questions for SITE.
-
-NO-UPDATE (the prefix arg) is passed to `sx-question-list-refresh'.
-If SITE is nil, use `sx-default-site'."
-            tab)
+       ,(unless obsolete
+          `(defvar ,buffer-variable nil
+             ,(format "Buffer where the %s questions are displayed." tab)))
+       (defun ,function-name (&optional no-update site)
+         ,(format sx-tab--docstring-format tab)
          (interactive
           (list current-prefix-arg
                 (sx--interactive-site-prompt)))
@@ -95,187 +120,163 @@ If SITE is nil, use `sx-default-site'."
          ;; Create the buffer
          (unless (buffer-live-p ,buffer-variable)
            (setq ,buffer-variable
-                 (generate-new-buffer "*question-list*")))
+                 (generate-new-buffer
+                  ,(format "*question-list: %s *" (or obsolete tab)))))
          ;; Fill the buffer with content.
          (with-current-buffer ,buffer-variable
            (sx-question-list-mode)
-           ,(when printer
-              `(setq sx-question-list--print-function ,printer))
-           ,(when refresher
-              `(setq sx-question-list--refresh-function ,refresher))
-           ,(when pager
-              `(setq sx-question-list--next-page-function ,pager))
+           (when ,printer (setq sx-question-list--print-function ,printer))
+           (when ,refresher (setq sx-question-list--refresh-function ,refresher))
+           (setq sx-question-list--next-page-function ,pager)
            (setq sx-question-list--site site)
-           (setq sx-question-list--current-tab ,tab)
+           (setq sx-question-list--order 'activity)
+           (setq sx-question-list--current-tab ,(or obsolete tab))
            ,@body
            (sx-question-list-refresh 'redisplay no-update))
          (switch-to-buffer ,buffer-variable))
+       ,(when obsolete
+          `(make-obsolete ',function-name ',use-instead nil))
        ;; Add this tab to the list of existing tabs. So we can prompt
        ;; the user with completion and stuff.
-       (add-to-list 'sx-tab--list ,tab))))
+       (unless ,obsolete
+         (add-to-list 'sx-tab--list ,tab)))))
 
 
-;;; FrontPage
-(sx-tab--define "FrontPage"
-  (lambda (page)
-    (sx-question-get-questions
-     sx-question-list--site page '((sort . activity)))))
+;;; Entry commands
+(sx-tab--define "All-Questions"
+  (sx-question-list--make-pager 'questions)
+  nil nil nil
+  (setq sx-question-list--order-methods
+        sx-tab--order-methods))
 ;;;###autoload
-(autoload 'sx-tab-frontpage
+(autoload 'sx-tab-all-questions
   (expand-file-name
-   "sx-tab"
-   (when load-file-name
-     (file-name-directory load-file-name)))
+   "sx-tab" (when load-file-name (file-name-directory load-file-name)))
   nil t)
 
-
-;;; Newest
-(sx-tab--define "Newest"
-  (lambda (page)
-    (sx-question-get-questions
-     sx-question-list--site page '((sort . creation)))))
+(sx-tab--define "Unanswered"
+  (sx-question-list--make-pager 'questions 'unanswered))
 ;;;###autoload
-(autoload 'sx-tab-newest
+(autoload 'sx-tab-unanswered
   (expand-file-name
-   "sx-tab"
-   (when load-file-name
-     (file-name-directory load-file-name)))
+   "sx-tab" (when load-file-name (file-name-directory load-file-name)))
   nil t)
 
-
-
-;;; TopVoted
-(sx-tab--define "TopVoted"
-  (lambda (page)
-    (sx-question-get-questions
-     sx-question-list--site page '((sort . votes)))))
+(sx-tab--define "Unanswered-My-Tags"
+  (sx-question-list--make-pager 'questions 'unanswered/my-tags))
 ;;;###autoload
-(autoload 'sx-tab-topvoted
+(autoload 'sx-tab-unanswered-my-tags
   (expand-file-name
-   "sx-tab"
-   (when load-file-name
-     (file-name-directory load-file-name)))
+   "sx-tab" (when load-file-name (file-name-directory load-file-name)))
   nil t)
 
-
-
-;;; Hot
-(sx-tab--define "Hot"
-  (lambda (page)
-    (sx-question-get-questions
-     sx-question-list--site page '((sort . hot)))))
+(sx-tab--define "Featured"
+  (sx-question-list--make-pager 'questions 'featured))
 ;;;###autoload
-(autoload 'sx-tab-hot
+(autoload 'sx-tab-featured
   (expand-file-name
-   "sx-tab"
-   (when load-file-name
-     (file-name-directory load-file-name)))
+   "sx-tab" (when load-file-name (file-name-directory load-file-name)))
   nil t)
 
-
-
-;;; Week
-(sx-tab--define "Week"
-  (lambda (page)
-    (sx-question-get-questions
-     sx-question-list--site page '((sort . week)))))
+(sx-tab--define "Starred"
+  (sx-question-list--make-pager 'me 'favorites))
 ;;;###autoload
-(autoload 'sx-tab-week
+(autoload 'sx-tab-starred
   (expand-file-name
-   "sx-tab"
-   (when load-file-name
-     (file-name-directory load-file-name)))
+   "sx-tab" (when load-file-name (file-name-directory load-file-name)))
   nil t)
 
+
+;;; Inter-modes navigation
+(defun sx-tab-meta-or-main ()
+  "Switch to the meta version of a main site, or vice-versa.
+Inside a question, go to the frontpage of the site this question
+belongs to."
+  (interactive)
+  (if (and (derived-mode-p 'sx-question-list-mode)
+           sx-question-list--site)
+      (sx-question-list-switch-site
+       (if (string-match "\\`meta\\." sx-question-list--site)
+           (replace-match "" :fixedcase nil sx-question-list--site)
+         (concat "meta." sx-question-list--site)))
+    (sx-tab-all-questions nil (sx--site (sx--data-here 'question)))))
 
 
-;;; Month
-(sx-tab--define "Month"
-  (lambda (page)
-    (sx-question-get-questions
-     sx-question-list--site page '((sort . month)))))
+;;; Obsolete tabs
+(defconst sx-tab--basic-question-pager
+  (sx-question-list--make-pager 'questions))
+
+(sx-tab--define "FrontPage"
+  sx-tab--basic-question-pager
+  nil nil "All-Questions"
+  (setq sx-question-list--order 'activity)
+  (setq sx-question-list--order-methods
+        sx-tab--order-methods))
 ;;;###autoload
-(autoload 'sx-tab-month
+(autoload 'sx-tab-frontpage
   (expand-file-name
-   "sx-tab"
-   (when load-file-name
-     (file-name-directory load-file-name)))
+   "sx-tab" (when load-file-name (file-name-directory load-file-name)))
   nil t)
 
-
-;;; Unanswered
-(sx-tab--define "Unanswered"
-  (lambda (page)
-    (sx-question-get-questions
-     sx-question-list--site page nil 'unanswered)))
+(sx-tab--define "Newest"
+  sx-tab--basic-question-pager
+  nil nil "All-Questions"
+  (setq sx-question-list--order 'creation)
+  (setq sx-question-list--order-methods
+        sx-tab--order-methods))
 ;;;###autoload
-(autoload 'sx-tab-unanswered
+(autoload 'sx-tab-newest
   (expand-file-name
-   "sx-tab"
-   (when load-file-name
-     (file-name-directory load-file-name)))
+   "sx-tab" (when load-file-name (file-name-directory load-file-name)))
   nil t)
 
-
-;;; Unanswered My-tags
-(sx-tab--define "Unanswered-my-tags"
-  (lambda (page)
-    (sx-question-get-questions
-     sx-question-list--site page nil 'unanswered/my-tags)))
+(sx-tab--define "TopVoted"
+  sx-tab--basic-question-pager
+  nil nil "All-Questions"
+  (setq sx-question-list--order 'votes)
+  (setq sx-question-list--order-methods
+        sx-tab--order-methods))
 ;;;###autoload
-(autoload 'sx-tab-unanswered-my-tags
+(autoload 'sx-tab-topvoted
   (expand-file-name
-   "sx-tab"
-   (when load-file-name
-     (file-name-directory load-file-name)))
+   "sx-tab" (when load-file-name (file-name-directory load-file-name)))
   nil t)
 
-
-;;; Featured
-(sx-tab--define "Featured"
-  (lambda (page)
-    (sx-question-get-questions
-     sx-question-list--site page nil 'featured)))
+(sx-tab--define "Hot"
+  sx-tab--basic-question-pager
+  nil nil "All-Questions"
+  (setq sx-question-list--order 'hot)
+  (setq sx-question-list--order-methods
+        sx-tab--order-methods))
 ;;;###autoload
-(autoload 'sx-tab-featured
+(autoload 'sx-tab-hot
   (expand-file-name
-   "sx-tab"
-   (when load-file-name
-     (file-name-directory load-file-name)))
+   "sx-tab" (when load-file-name (file-name-directory load-file-name)))
   nil t)
 
-
-;;; Starred
-(sx-tab--define "Starred"
-  (lambda (page)
-    (sx-method-call 'me
-      :page page
-      :site sx-question-list--site
-      :auth t
-      :submethod 'favorites
-      :filter sx-browse-filter)))
+(sx-tab--define "Week"
+  sx-tab--basic-question-pager
+  nil nil "All-Questions"
+  (setq sx-question-list--order 'week)
+  (setq sx-question-list--order-methods
+        sx-tab--order-methods))
 ;;;###autoload
-(autoload 'sx-tab-featured
+(autoload 'sx-tab-week
   (expand-file-name
-   "sx-tab"
-   (when load-file-name
-     (file-name-directory load-file-name)))
+   "sx-tab" (when load-file-name (file-name-directory load-file-name)))
   nil t)
 
-
-;;; Inter-modes navigation
-(defun sx-tab-meta-or-main ()
-  "Switch to the meta version of a main site, or vice-versa.
-Inside a question, go to the frontpage of the site this question
-belongs to."
-  (interactive)
-  (if (and (derived-mode-p 'sx-question-list-mode)
-           sx-question-list--site)
-      (sx-question-list-switch-site
-       (if (string-match "\\`meta\\." sx-question-list--site)
-           (replace-match "" :fixedcase nil sx-question-list--site)
-         (concat "meta." sx-question-list--site)))
-    (sx-tab-frontpage nil (sx--site (sx--data-here 'question)))))
+(sx-tab--define "Month"
+  sx-tab--basic-question-pager
+  nil nil "All-Questions"
+  (setq sx-question-list--order 'month)
+  (setq sx-question-list--order-methods
+        sx-tab--order-methods))
+;;;###autoload
+(autoload 'sx-tab-month
+  (expand-file-name
+   "sx-tab" (when load-file-name (file-name-directory load-file-name)))
+  nil t)
 
 (provide 'sx-tab)
 ;;; sx-tab.el ends here
diff --git a/test/test-printing.el b/test/test-printing.el
index 850edd8..4c72f68 100644
--- a/test/test-printing.el
+++ b/test/test-printing.el
@@ -55,10 +55,11 @@ after being run through `sx-tag--format'."
 (ert-deftest question-list-display ()
   (cl-letf (((symbol-function #'sx-request-make)
              (lambda (&rest _) sx-test-data-questions)))
-    (sx-tab-frontpage nil "emacs")
-    (switch-to-buffer "*question-list*")
+    (sx-tab-all-questions nil "emacs")
+    (switch-to-buffer sx-tab--all-questions-buffer)
     (goto-char (point-min))
-    (should (equal (buffer-name) "*question-list*"))
+    (should (equal (buffer-name)
+                   (format "*question-list: %s *" sx-question-list--current-tab)))
     (line-should-match
      (question-list-regex
       "Focus-hook: attenuate colours when losing focus"
@@ -69,9 +70,9 @@ after being run through `sx-tag--format'."
       "Babel doesn't wrap results in verbatim"
       0 1 "org-mode" "org-export" "org-babel"))
     ;; ;; Use this when we have a real sx-question buffer.
-    ;; (call-interactively 'sx-question-list-display-question)
-    ;; (should (equal (buffer-name) "*sx-question*"))
-    (switch-to-buffer "*question-list*")
+    ;; (save-excursion
+    ;;   (call-interactively 'sx-question-list-display-question)
+    ;;   (should (equal (buffer-name) "*sx-question*")))
     (sx-question-list-previous 4)
     (line-should-match
      (question-list-regex