Merge branch 'master' into small-improvements

8 files changed, 169 insertions, 46 deletions

diff --git a/sx-button.el b/sx-button.el
index 46855e7..d32314d 100644
--- a/sx-button.el
+++ b/sx-button.el
@@ -98,9 +98,14 @@ usually part of a code-block."
 (defun sx-button-follow-link (&optional pos)
   "Follow link at POS.  If POS is nil, use `point'."
   (interactive)
-  (browse-url
-   (or (get-text-property (or pos (point)) 'sx-button-url)
-       (sx-user-error "No url under point: %s" (or pos (point))))))
+  (let ((url (or (get-text-property (or pos (point)) 'sx-button-url)
+                 (sx-user-error "No url under point: %s" (or pos (point))))))
+    ;; If we didn't recognize the link, this errors immediately.  If
+    ;; we mistakenly recognize it, it will error when we try to fetch
+    ;; whatever we thought it was.
+    (condition-case nil (sx-open-link url)
+      ;; When it errors, don't blame the user, just visit externally.
+      (error (sx-visit-externally url)))))
 
 
 ;;; Help-echo definitions
@@ -117,6 +122,12 @@ usually part of a code-block."
     "link")
   "Help echoed in the minibuffer when point is on a user.")
 
+(defconst sx-button--tag-help-echo
+  (format sx-button--help-echo
+    "Tag search"
+    "tag")
+  "Help echoed in the minibuffer when point is on a tag.")
+
 (defconst sx-button--question-title-help-echo
   (format sx-button--help-echo
     "hide content"
@@ -158,6 +169,13 @@ usually part of a code-block."
   'face      'sx-user-name
   :supertype 'sx-button)
 
+(declare-function sx-search-tag-at-point "sx-search")
+(define-button-type 'sx-button-tag
+  'action    #'sx-search-tag-at-point
+  'help-echo sx-button--tag-help-echo
+  'face      'sx-tag
+  :supertype 'sx-button)
+
 (define-button-type 'sx-button-comment
   'help-echo (concat "mouse-1, RET"
                      (propertize ": write a comment"
diff --git a/sx-question-list.el b/sx-question-list.el
index 06af161..def490b 100644
--- a/sx-question-list.el
+++ b/sx-question-list.el
@@ -27,6 +27,7 @@
 
 (require 'sx)
 (require 'sx-time)
+(require 'sx-tag)
 (require 'sx-site)
 (require 'sx-question)
 (require 'sx-question-mode)
@@ -81,11 +82,6 @@
   ""
   :group 'sx-question-list-faces)
 
-(defface sx-question-list-tags
-  '((t :inherit sx-question-mode-tags))
-  ""
-  :group 'sx-question-list-faces)
-
 (defface sx-question-list-date
   '((t :inherit font-lock-comment-face))
   ""
@@ -170,8 +166,7 @@ Also see `sx-question-list-refresh'."
          " "
          ;; @TODO: Make this width customizable. (Or maybe just make
          ;; the whole thing customizable)
-         (propertize (format "%-40s" (mapconcat #'sx-question--tag-format .tags " "))
-                     'face 'sx-question-list-tags)
+         (format "%-40s" (sx-tag--format-tags .tags sx-question-list--site))
          " "
          (sx-user--format "%15d %4r" .owner)
          (propertize " " 'display "\n")))))))
diff --git a/sx-question-print.el b/sx-question-print.el
index 778b580..abf3236 100644
--- a/sx-question-print.el
+++ b/sx-question-print.el
@@ -79,11 +79,6 @@ Some faces of this mode might be defined in the `sx-user' group."
   :type 'string
   :group 'sx-question-mode)
 
-(defface sx-question-mode-tags
-  '((t :underline nil :inherit font-lock-function-name-face))
-  "Face used on the question tags in the question buffer."
-  :group 'sx-question-mode-faces)
-
 (defface sx-question-mode-score
   '((t))
   "Face used for the score in the question buffer."
@@ -228,8 +223,8 @@ DATA can represent a question or an answer."
           ;; Tags
           (sx-question-mode--insert-header
            sx-question-mode-header-tags
-           (mapconcat #'sx-question--tag-format .tags " ")
-           'sx-question-mode-tags))
+           (sx-tag--format-tags .tags .site_par)
+           nil))
         ;; Body
         (insert "\n"
                 (propertize sx-question-mode-separator
@@ -304,7 +299,10 @@ where `value' is given `face' as its face.
   (while args
     (insert
      (propertize (pop args) 'face 'sx-question-mode-header)
-     (propertize (pop args) 'face (pop args)))))
+     (let ((header (pop args))
+           (face (pop args)))
+       (if face (propertize header 'face face)
+         header)))))
 
 
 ;;;; Printing and Font-locking the content (body)
@@ -322,7 +320,9 @@ E.g.:
 
 (defconst sx-question-mode--link-regexp
   ;; Done at compile time.
-  (rx (or (and "[" (group-n 1 (1+ (not (any "]")))) "]"
+  (rx (or (and "[" (optional (group-n 6 "meta-")) "tag:"
+               (group-n 5 (+ (not (any " ]")))) "]")
+          (and "[" (group-n 1 (1+ (not (any "]")))) "]"
                (or (and "(" (group-n 2 (1+ (not (any ")")))) ")")
                    (and "[" (group-n 3 (1+ (not (any "]")))) "]")))
           (group-n 4 (and (and "http" (opt "s") "://") ""
@@ -370,18 +370,25 @@ E.g.:
   (save-excursion
     (goto-char (point-min))
     (while (search-forward-regexp sx-question-mode--link-regexp nil t)
-      (let* ((text (match-string-no-properties 1))
-             (url (or (match-string-no-properties 2)
-                      (match-string-no-properties 4)
-                      (sx-question-mode-find-reference
-                       (match-string-no-properties 3)
-                       text)))
-             (full-text (match-string-no-properties 0)))
-        (when (stringp url)
-          (replace-match "")
-          (sx-question-mode--insert-link
-           (or (if sx-question-mode-pretty-links text full-text) url)
-           url))))))
+      ;; Tags are tag-buttons.
+      (let ((tag (match-string-no-properties 5)))
+        (if (and tag (> (length tag) 0))
+            (progn (replace-match "")
+                   ;; `match-string' 6 is the "meta-" prefix.
+                   (sx-tag--insert tag (match-string 6)))
+          ;; Other links are link-buttons.
+          (let* ((text (match-string-no-properties 1))
+                 (url (or (match-string-no-properties 2)
+                          (match-string-no-properties 4)
+                          (sx-question-mode-find-reference
+                           (match-string-no-properties 3)
+                           text)))
+                 (full-text (match-string-no-properties 0)))
+            (when (stringp url)
+              (replace-match "")
+              (sx-question-mode--insert-link
+               (or (if sx-question-mode-pretty-links text full-text) url)
+               url))))))))
 
 (defun sx-question-mode--insert-link (text url)
   "Return a link propertized version of string TEXT.
diff --git a/sx-question.el b/sx-question.el
index 1df4900..1162eb9 100644
--- a/sx-question.el
+++ b/sx-question.el
@@ -148,7 +148,8 @@ See `sx-question--user-read-list'."
            ;; Question wasn't present.
            (t
             (sx-sorted-insert-skip-first
-             q-cell site-cell (lambda (x y) (> (car x) (car y))))))))
+             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?
@@ -196,20 +197,14 @@ If no cache exists for it, initialize one with SITE."
 
 
 ;;;; 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)))
 
-(defun sx-question--tag-format (tag)
-  "Formats TAG for display."
-  (concat "[" tag "]"))
-
 
 ;;; 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))))
diff --git a/sx-search.el b/sx-search.el
index 55964b9..b245cbe 100644
--- a/sx-search.el
+++ b/sx-search.el
@@ -32,6 +32,7 @@
 
 (require 'sx)
 (require 'sx-question-list)
+(require 'sx-question-mode)
 (require 'sx-tag)
 
 (defvar sx-search--query-history nil
@@ -117,6 +118,25 @@ prefix argument, the user is asked for everything."
     (sx-question-list-refresh 'redisplay)
     (switch-to-buffer (current-buffer))))
 
+
+;;; Tag
+(defun sx-search-tag-at-point (&optional pos)
+  "Follow tag under position POS or point."
+  (interactive)
+  (let ((tag (save-excursion
+               (when pos (goto-char pos))
+               (or (get-text-property (point) 'sx-tag)
+                   (thing-at-point 'symbol))))
+        (meta (save-excursion
+                (when pos (goto-char pos))
+                (get-text-property (point) 'sx-tag-meta)))
+        (site (replace-regexp-in-string
+               (rx string-start "meta.") ""
+               (or sx-question-list--site
+                   (sx-assoc-let sx-question-mode--data .site_par)))))
+    (sx-search (concat (when meta "meta.") site)
+               nil tag)))
+
 (provide 'sx-search)
 ;;; sx-search.el ends here
 
diff --git a/sx-tag.el b/sx-tag.el
index b2ad375..3c00ae2 100644
--- a/sx-tag.el
+++ b/sx-tag.el
@@ -23,6 +23,13 @@
 
 (require 'sx)
 (require 'sx-method)
+(require 'sx-button)
+
+(defface sx-tag
+  '((t :underline nil :inherit font-lock-function-name-face))
+  "Face used on the question tags in the question buffer."
+  :group 'sx-question-mode-faces
+  :group 'sx-question-list-faces)
 
 
 ;;; Getting the list from a site
@@ -133,6 +140,37 @@ tags."
       (push input list))
     (reverse list)))
 
+
+;;; Printing
+(defun sx-tag--format (tag &optional meta)
+  "Format and return TAG for display.
+If META is non-nil, the tag is for the meta site."
+  (with-temp-buffer
+    (sx-tag--insert tag meta)
+    (buffer-string)))
+
+(defun sx-tag--insert (tag &optional meta)
+  "Insert TAG button.
+If META is non-nil, the tag is for the meta site."
+  (insert-text-button (concat "[" tag "]")
+                      'sx-button-copy tag
+                      'sx-tag tag
+                      'sx-tag-meta meta
+                      :type 'sx-button-tag))
+
+(defun sx-tag--format-tags (tags &optional site)
+  "Format and concatenate a sequence of TAGS.
+Returns a string of all tags in TAGS, separated by a space.
+
+SITE is the site to which the tags refer, it is only used to
+decide whether they are main or meta tags.  SITE can also be t or
+nil, which respectively indicate meta and main."
+  (let ((is-meta
+         (if (stringp site) (string-match (rx string-start "meta.") site)
+           site)))
+    (mapconcat (lambda (tag) (sx-tag--format tag is-meta))
+               tags " ")))
+
 (provide 'sx-tag)
 ;;; sx-tag.el ends here
 
diff --git a/test/test-printing.el b/test/test-printing.el
index 7384829..8016444 100644
--- a/test/test-printing.el
+++ b/test/test-printing.el
@@ -13,7 +13,7 @@
 (defmacro question-list-regex (title votes answers &rest tags)
   "Construct a matching regexp for TITLE, VOTES, and ANSWERS.
 Each element of TAGS is appended at the end of the expression
-after being run through `sx-question--tag-format'."
+after being run through `sx-tag--format'."
   `(rx line-start
        (+ whitespace) ,(number-to-string votes)
        (+ whitespace) ,(number-to-string answers)
@@ -22,17 +22,35 @@ after being run through `sx-question--tag-format'."
        (+ (any whitespace digit))
        (or "y" "d" "h" "m" "mo" "s") " ago"
        (+ whitespace)
-       (eval (mapconcat #'sx-question--tag-format
-                        (list ,@tags) " "))))
+       (eval (mapconcat #'sx-tag--format (list ,@tags) " "))))
 
 
 ;;; Tests
+(ert-deftest time-since ()
+  (cl-letf (((symbol-function #'float-time)
+           (lambda () 1420148997.)))
+    (should
+     (string=
+      "67m"
+      (sx-time-since 1420145000.)))
+    (should
+     (string=
+      "12h"
+      (sx-time-since 1420105000.)))))
+
 (ert-deftest question-list-tag ()
-  "Test `sx-question--tag-format'."
+  "Test `sx-tag--format'."
   (should
-   (string=
-    (sx-question--tag-format "tag")
-    "[tag]")))
+   (string= (sx-tag--format "tag") "[tag]"))
+  (with-temp-buffer
+    (insert (sx-tag--format "tag"))
+    (should (get-char-property (point-min) 'button))
+    (should
+     (eq (get-char-property (point-min) 'face) 'sx-tag))
+    (should
+     (string= (get-char-property (point-min) 'sx-tag) "tag"))
+    (should
+     (string= (get-char-property (point-min) 'sx-button-copy) "tag"))))
 
 (ert-deftest question-list-display ()
   (cl-letf (((symbol-function #'sx-request-make)
@@ -134,6 +152,17 @@ after being run through `sx-question--tag-format'."
     (should
      (equal object '((answers . [something "answer"]))))))
 
+
+;;; question-mode
+(ert-deftest sx-display-question ()
+  ;; Check it doesn't error.
+  (sx-display-question (elt sx-test-data-questions 0))
+  ;; Check it does error.
+  (should-error
+   (sx-display-question sx-test-data-questions))
+  (should-error
+   (sx-display-question sx-test-data-questions nil 1)))
+
 (ert-deftest sx-question-mode--fill-and-fontify ()
   "Check complicated questions are filled correctly."
   (should
@@ -190,3 +219,4 @@ if you used the Stack Exchange login method, you'd...
   [1]: http://i.stack.imgur.com/ktFTs.png
   [2]: http://i.stack.imgur.com/5l2AY.png
   [3]: http://i.stack.imgur.com/22myl.png")))
+
diff --git a/test/tests.el b/test/tests.el
index ce42a9f..be1552b 100644
--- a/test/tests.el
+++ b/test/tests.el
@@ -59,4 +59,24 @@
     (apply #'message message args)))
 
 (mapc #'sx-load-test
-      '(api macros printing util search))
+  '(api macros printing util search state))
+
+(ert-deftest user-entry-functions ()
+  "Ensures all entry functions are autoloaded."
+  (should
+   (cl-every
+    #'fboundp
+    '(sx-ask
+      sx-authenticate
+      sx-bug-report
+      sx-switchto-map
+      sx-tab-featured
+      sx-tab-frontpage
+      sx-tab-hot
+      sx-tab-month
+      sx-tab-newest
+      sx-tab-starred
+      sx-tab-topvoted
+      sx-tab-unanswered
+      sx-tab-week
+      sx-version))))