diff options
| -rw-r--r-- | sx-interaction.el | 9 | ||||
| -rw-r--r-- | sx-question-list.el | 8 | ||||
| -rw-r--r-- | sx-question.el | 15 | ||||
| -rw-r--r-- | sx-request.el | 2 | ||||
| -rw-r--r-- | sx-tab.el | 8 | ||||
| -rw-r--r-- | sx.el | 116 | ||||
| -rw-r--r-- | test/test-api.el | 13 | ||||
| -rw-r--r-- | test/test-macros.el | 22 | ||||
| -rw-r--r-- | test/test-printing.el | 73 | ||||
| -rw-r--r-- | test/test-util.el | 31 | ||||
| -rw-r--r-- | test/tests.el | 177 |
11 files changed, 262 insertions, 212 deletions
diff --git a/sx-interaction.el b/sx-interaction.el index 619f259..b2673c8 100644 --- a/sx-interaction.el +++ b/sx-interaction.el @@ -359,11 +359,12 @@ from context at point." (let ((default (or sx-question-list--site (sx-assoc-let sx-question-mode--data .site_par) sx-default-site))) - (funcall (if ido-mode #'ido-completing-read #'completing-read) - (format "Site (%s): " default) - (sx-site-get-api-tokens) nil t nil nil - default))) + (sx-completing-read + (format "Site (%s): " default) + (sx-site-get-api-tokens) nil t nil nil + default))) +;;;###autoload (defun sx-ask (site) "Start composing a question for SITE. SITE is a string, indicating where the question will be posted." diff --git a/sx-question-list.el b/sx-question-list.el index 4f71251..a5cd005 100644 --- a/sx-question-list.el +++ b/sx-question-list.el @@ -333,6 +333,11 @@ Non-interactively, DATA is a question alist." (tabulated-list-get-id) (sx-user-error "Not in `sx-question-list-mode'")))) (sx-question--mark-hidden data) + ;; The current entry will not be present after the list is + ;; redisplayed. To avoid `tabulated-list-mode' getting lost (and + ;; sending us to the top) we move to the next entry before + ;; redisplaying. + (forward-line 1) (when (called-interactively-p 'any) (sx-question-list-refresh 'redisplay 'noupdate))) @@ -554,12 +559,11 @@ This does not update `sx-question-mode--window'." (defun sx-question-list-switch-site (site) "Switch the current site to SITE and display its questions. -Use `ido-completing-read' if variable `ido-mode' is active. Retrieve completions from `sx-site-get-api-tokens'. Sets `sx-question-list--site' and then call `sx-question-list-refresh' with `redisplay'." (interactive - (list (funcall (if ido-mode #'ido-completing-read #'completing-read) + (list (sx-completing-read "Switch to site: " (sx-site-get-api-tokens) (lambda (site) (not (equal site sx-question-list--site))) t))) diff --git a/sx-question.el b/sx-question.el index 3fcc438..85d3cc5 100644 --- a/sx-question.el +++ b/sx-question.el @@ -159,14 +159,13 @@ If no cache exists for it, initialize one with SITE." (let ((site-cell (assoc .site_par sx-question--user-hidden-list))) ;; If question already hidden, do nothing. (unless (memq .question_id site-cell) - ;; First question from this site. - (push (list .site_par .question_id) sx-question--user-hidden-list) - ;; Question wasn't present. - ;; Add it in, but make sure it's sorted (just in case we need - ;; it later). - (sx-sorted-insert-skip-first .question_id site-cell >) - ;; This causes a small lag on `j' and `k' as the list gets large. - ;; Should we do this on a timer? + (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))))) diff --git a/sx-request.el b/sx-request.el index 1031ea7..bc34f9c 100644 --- a/sx-request.el +++ b/sx-request.el @@ -162,7 +162,7 @@ the main content of the response is returned." .method .error_id .error_name .error_message)) (when (< (setq sx-request-remaining-api-requests .quota_remaining) sx-request-remaining-api-requests-message-threshold) - (sx-message "%d API requests reamining" + (sx-message "%d API requests remaining" sx-request-remaining-api-requests)) (sx-encoding-clean-content-deep .items))))))) @@ -34,10 +34,10 @@ (defun sx-tab-switch (tab) "Switch to another question-list tab." (interactive - (list (funcall (if ido-mode #'ido-completing-read #'completing-read) - "Switch to tab: " sx-tab--list - (lambda (tab) (not (equal tab sx-question-list--current-tab))) - t))) + (list (sx-completing-read + "Switch to tab: " sx-tab--list + (lambda (tab) (not (equal tab sx-question-list--current-tab))) + t))) (funcall (intern (format "sx-tab-%s" (downcase tab))))) @@ -61,7 +61,16 @@ DATA can also be the link itself." (cdr (assoc 'link data))))) (when (stringp link) (replace-regexp-in-string - "^https?://\\(?:\\(?1:[^/]+\\)\\.stackexchange\\|\\(?2:[^/]+\\)\\)\\.[^.]+/.*$" + (rx string-start + "http" (optional "s") "://" + (or + (sequence + (group-n 1 (+ (not (any "/")))) + ".stackexchange") + (group-n 2 (+ (not (any "/"))))) + "." (+ (not (any "."))) + "/" (* any) + string-end) "\\1\\2" link)))) (defun sx--ensure-site (data) @@ -77,15 +86,64 @@ with a `link' property)." (cdr data))))) data)) +(defun sx--link-to-data (link) + "Convert string LINK into data that can be displayed." + (let ((result (list (cons 'site (sx--site link))))) + ;; Try to strip a question or answer ID + (when (or + ;; Answer + (and (or (string-match + ;; From 'Share' button + (rx "/a/" + ;; Question ID + (group (+ digit)) + ;; User ID + "/" (+ digit) + ;; Answer ID + (group (or (sequence "#" (* any)) "")) + string-end) link) + (string-match + ;; From URL + (rx "/questions/" (+ digit) "/" + (+ (not (any "/"))) "/" + ;; User ID + (optional (group (+ digit))) + (optional "/") + (group (or (sequence "#" (* any)) "")) + string-end) link)) + (push '(type . answer) result)) + ;; Question + (and (or (string-match + ;; From 'Share' button + (rx "/q/" + ;; Question ID + (group (+ digit)) + ;; User ID + (optional "/" (+ digit)) + ;; Answer or Comment ID + (group (or (sequence "#" (* any)) "")) + string-end) link) + (string-match + ;; From URL + (rx "/questions/" + ;; Question ID + (group (+ digit)) + "/") link)) + (push '(type . question) result))) + (push (cons 'id (string-to-number (match-string-no-properties 1 link))) + result)) + result)) + (defmacro sx-assoc-let (alist &rest body) "Identical to `let-alist', except `.site' has a special meaning. If ALIST doesn't have a `site' property, one is created using the `link' property." (declare (indent 1) (debug t)) + (require 'let-alist) `(progn - (require 'let-alist) (sx--ensure-site ,alist) - (let-alist ,alist ,@body))) + ,(macroexpand + `(let-alist ,alist ,@body)))) ;;; Browsing filter @@ -94,6 +152,7 @@ If ALIST doesn't have a `site' property, one is created using the question.comments question.answers question.last_editor + question.last_activity_date question.accepted_answer_id question.link question.upvoted @@ -114,6 +173,7 @@ If ALIST doesn't have a `site' property, one is created using the comment.comment_id answer.answer_id answer.last_editor + answer.last_activity_date answer.link answer.share_link answer.owner @@ -127,6 +187,11 @@ See `sx-question-get-questions' and `sx-question-get-question'.") ;;; Utility Functions +(defun sx-completing-read (&rest args) + "Like `completing-read', but possibly use ido. +All ARGS are passed to `completing-read' or `ido-completing-read'." + (apply (if ido-mode #'ido-completing-read #'completing-read) + args)) (defmacro sx-sorted-insert-skip-first (newelt list &optional predicate) "Inserted NEWELT into LIST sorted by PREDICATE. @@ -184,50 +249,6 @@ and sequences of strings." (funcall first-f sequence-sep) ";")))))) -(defun sx--filter-data (data desired-tree) - "Filter DATA and return the DESIRED-TREE. - -For example: - - (sx--filter-data - '((prop1 . value1) - (prop2 . value2) - (prop3 - (test1 . 1) - (test2 . 2)) - (prop4 . t)) - '(prop1 (prop3 test2))) - -would yield - - ((prop1 . value1) - (prop3 - (test2 . 2)))" - (if (vectorp data) - (apply #'vector - (mapcar (lambda (entry) - (sx--filter-data - entry desired-tree)) - data)) - (delq - nil - (mapcar (lambda (cons-cell) - ;; @TODO the resolution of `f' is O(2n) in the worst - ;; case. It may be faster to implement the same - ;; functionality as a `while' loop to stop looking the - ;; list once it has found a match. Do speed tests. - ;; See edfab4443ec3d376c31a38bef12d305838d3fa2e. - (let ((f (or (memq (car cons-cell) desired-tree) - (assoc (car cons-cell) desired-tree)))) - (when f - (if (and (sequencep (cdr cons-cell)) - (sequencep (elt (cdr cons-cell) 0))) - (cons (car cons-cell) - (sx--filter-data - (cdr cons-cell) (cdr f))) - cons-cell)))) - data)))) - (defun sx--shorten-url (url) "Shorten URL hiding anything other than the domain. Paths after the domain are replaced with \"...\". @@ -321,6 +342,7 @@ removed from the display name before it is returned." (format "[%s]" (car kar)) (cdr kar) string))) string)) + (defcustom sx-init-hook nil "Hook run when SX initializes. Run after `sx-init--internal-hook'." diff --git a/test/test-api.el b/test/test-api.el new file mode 100644 index 0000000..ca775ff --- /dev/null +++ b/test/test-api.el @@ -0,0 +1,13 @@ +(ert-deftest test-basic-request () + "Test basic request functionality" + (should (sx-request-make "sites"))) + +(ert-deftest test-question-retrieve () + "Test the ability to receive a list of questions." + (should (sx-question-get-questions 'emacs))) + +(ert-deftest test-bad-request () + "Test a method given a bad set of keywords" + (should-error + (sx-request-make "questions" '(())))) + diff --git a/test/test-macros.el b/test/test-macros.el new file mode 100644 index 0000000..2169088 --- /dev/null +++ b/test/test-macros.el @@ -0,0 +1,22 @@ +(defmacro sx-test-with-json-data (cell &rest body) + "Run BODY with sample data let-bound to CELL" + (declare (indent 1)) + `(let ((,cell '((test . nil) (test-one . 1) (test-two . 2) + (link . "http://meta.emacs.stackexchange.com/")))) + ,@body)) + +(ert-deftest macro-test--sx-assoc-let () + "Test `sx-assoc-let'" + (sx-test-with-json-data data + (should + (null (let-alist data .site)))) + + (sx-test-with-json-data data + (should + (equal (sx-assoc-let data .site) + "meta.emacs"))) + + (sx-test-with-json-data data + (should + (equal (sx-assoc-let data (cons .test-one .test-two)) + '(1 . 2))))) diff --git a/test/test-printing.el b/test/test-printing.el new file mode 100644 index 0000000..2857cb7 --- /dev/null +++ b/test/test-printing.el @@ -0,0 +1,73 @@ + +;;; Setup +(require 'cl-lib) + +(defmacro line-should-match (regexp) + "Test if the line at point matches REGEXP" + `(let ((line (buffer-substring-no-properties + (line-beginning-position) + (line-end-position)))) + (sx-test-message "Line here is: %S" line) + (should (string-match ,regexp line)))) + +(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'." + `(rx line-start + (+ whitespace) ,(number-to-string votes) + (+ whitespace) ,(number-to-string answers) + (+ whitespace) + ,title + (+ (any whitespace digit)) + (or "y" "d" "h" "m" "mo" "s") " ago" + (+ whitespace) + (eval (mapconcat #'sx-question--tag-format + (list ,@tags) " ")))) + + +;;; Tests +(ert-deftest question-list-tag () + "Test `sx-question--tag-format'." + (should + (string= + (sx-question--tag-format "tag") + "[tag]"))) + +(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*") + (goto-char (point-min)) + (should (equal (buffer-name) "*question-list*")) + (line-should-match + (question-list-regex + "Focus-hook: attenuate colours when losing focus" + 1 0 "frames" "hooks" "focus")) + (sx-question-list-next 5) + (line-should-match + (question-list-regex + "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*") + (sx-question-list-previous 4) + (line-should-match + (question-list-regex + ""Making tag completion table" Freezes/Blocks -- how to disable" + 2 1 "autocomplete" "performance" "ctags")))) + +(ert-deftest sx--user-@name () + "Test `sx--user-@name' character substitution" + (should + (string= + (sx--user-@name '((display_name . "ĥÞßđłřğĝýÿñńśşšŝżźžçćčĉùúûüŭůòóôõöøőðìíîïıèéêëęàåáâäãåąĵ★"))) + "@hTHssdlrggyynnsssszzzccccuuuuuuooooooooiiiiieeeeeaaaaaaaaj")) + (should + (string= + (sx--user-@name '((display_name . "ĤÞßĐŁŘĞĜÝŸÑŃŚŞŠŜŻŹŽÇĆČĈÙÚÛÜŬŮÒÓÔÕÖØŐÐÌÍÎÏıÈÉÊËĘÀÅÁÂÄÃÅĄĴ"))) + "@HTHssDLRGGYYNNSSSSZZZCCCCUUUUUUOOOOOOOOIIIIiEEEEEAAAAAAAAJ"))) + diff --git a/test/test-util.el b/test/test-util.el new file mode 100644 index 0000000..5db1691 --- /dev/null +++ b/test/test-util.el @@ -0,0 +1,31 @@ +(ert-deftest thing-as-string () + "Test `sx--thing-as-string'" + (should + (string= (sx--thing-as-string + '(hello world (this is a test)) + '(";" "+")) + "hello;world;this+is+a+test")) + (should + (string= (sx--thing-as-string + '(this is a test) '(";" "+")) + "this;is;a;test")) + (should + (string= (sx--thing-as-string + '(this is a test) "+") + "this+is+a+test")) + (should + (string= (sx--thing-as-string + '(this is a test)) + "this;is;a;test")) + (should + (string= (sx--thing-as-string + 'test) + "test")) + (should + (string= (sx--thing-as-string + 'test&) + "test&")) + (should + (string= (sx--thing-as-string + 'test& nil t) + "test%26"))) diff --git a/test/tests.el b/test/tests.el index 66d8d88..53e053f 100644 --- a/test/tests.el +++ b/test/tests.el @@ -1,3 +1,5 @@ + +;;; SX Settings (defun -sx--nuke () (interactive) (mapatoms @@ -5,11 +7,17 @@ (if (string-prefix-p "sx-" (symbol-name symbol)) (unintern symbol))))) -;;; Tests +(setq + sx-initialized t + sx-request-remaining-api-requests-message-threshold 50000 + debug-on-error t + user-emacs-directory "." + sx-test-base-dir (file-name-directory (or load-file-name "./"))) + + +;;; Test Data (defvar sx-test-data-dir - (expand-file-name - "data-samples/" - (file-name-directory (or load-file-name "./")))) + (expand-file-name "data-samples/" sx-test-base-dir)) (defun sx-test-sample-data (method &optional directory) (let ((file (concat (when directory (concat directory "/")) @@ -20,157 +28,34 @@ (insert-file-contents file) (read (buffer-string)))))) -(defmacro line-should-match (regexp) - "" - `(let ((line (buffer-substring-no-properties - (line-beginning-position) - (line-end-position)))) - (message "Line here is: %S" line) - (should (string-match ,regexp line)))) - (setq - sx-initialized t - sx-request-remaining-api-requests-message-threshold 50000 - debug-on-error t - user-emacs-directory "." - sx-test-data-questions (sx-test-sample-data "questions") sx-test-data-sites (sx-test-sample-data "sites")) -(setq package-user-dir - (expand-file-name (format "../../.cask/%s/elpa" emacs-version) - sx-test-data-dir)) -(package-initialize) - -(require 'cl-lib) -(require 'sx) -(require 'sx-question) -(require 'sx-question-list) -(require 'sx-tab) - -(ert-deftest test-basic-request () - "Test basic request functionality" - (should (sx-request-make "sites"))) - -(ert-deftest test-question-retrieve () - "Test the ability to receive a list of questions." - (should (sx-question-get-questions 'emacs))) - -(ert-deftest test-bad-request () - "Test a method given a bad set of keywords" - (should-error - (sx-request-make "questions" '(())))) + +;;; General Settings +(setq + package-user-dir (expand-file-name + (format "../../.cask/%s/elpa" emacs-version) + sx-test-data-dir)) -(ert-deftest test-tree-filter () - "`sx-core-filter-data'" - ;; flat - (should - (equal - '((1 . t) (2 . [1 2]) (3)) - (sx--filter-data '((0 . 3) (1 . t) (a . five) (2 . [1 2]) - ("5" . bop) (3) (p . 4)) - '(1 2 3)))) - ;; complex - (should - (equal - '((1 . [a b c]) - (2 . [((a . 1) (c . 3)) - ((a . 4) (c . 6))]) - (3 . peach)) - (sx--filter-data '((1 . [a b c]) - (2 . [((a . 1) (b . 2) (c . 3)) - ((a . 4) (b . 5) (c . 6))]) - (3 . peach) - (4 . banana)) - '(1 (2 a c) 3)))) +(package-initialize) - ;; vector - (should - (equal - [((1 . 2) (2 . 3) (3 . 4)) - ((1 . a) (2 . b) (3 . c)) - nil ((1 . alpha) (2 . beta))] - (sx--filter-data [((1 . 2) (2 . 3) (3 . 4)) - ((1 . a) (2 . b) (3 . c) (5 . seven)) - ((should-not-go)) - ((1 . alpha) (2 . beta))] - '(1 2 3))))) +(require 'sx-load) -(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*") - (goto-char (point-min)) - (should (equal (buffer-name) "*question-list*")) - (line-should-match - "^\\s-+1\\s-+0\\s-+Focus-hook: attenuate colours when losing focus [ 0-9]+\\(y\\|d\\|h\\|mo?\\|s\\) ago\\s-+\\[frames\\] \\[hooks\\] \\[focus\\]") - (sx-question-list-next 5) - (line-should-match - "^\\s-+0\\s-+1\\s-+Babel doesn't wrap results in verbatim [ 0-9]+\\(y\\|d\\|h\\|mo?\\|s\\) ago\\s-+\\[org-mode\\]") - ;; ;; 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*") - (sx-question-list-previous 4) - (line-should-match - "^\\s-+2\\s-+1\\s-+"Making tag completion table" Freezes/Blocks -- how to disable [ 0-9]+\\(y\\|d\\|h\\|mo?\\|s\\) ago\\s-+\\[autocomplete\\]"))) +(defun sx-load-test (test) + (load-file + (format "%s/test-%s.el" + sx-test-base-dir + (symbol-name test)))) -(ert-deftest macro-test--sx-assoc-let () - "Tests macro expansion for `sx-assoc-let'" - (should - (equal '(progn (require 'let-alist) - (sx--ensure-site data) - (let-alist data .test)) - (macroexpand '(sx-assoc-let data .test)))) - (should - (equal '(progn (require 'let-alist) - (sx--ensure-site data) - (let-alist data (cons .test-one .test-two))) - (macroexpand - '(sx-assoc-let data (cons .test-one .test-two)))))) +(setq sx-test-enable-messages nil) -(ert-deftest sx--user-@name () - "Tests macro expansion for `sx-assoc-let'" - (should - (string= - (sx--user-@name '((display_name . "ĥÞßđłřğĝýÿñńśşšŝżźžçćčĉùúûüŭůòóôõöøőðìíîïıèéêëęàåáâäãåąĵ★"))) - "@hTHssdlrggyynnsssszzzccccuuuuuuooooooooiiiiieeeeeaaaaaaaaj")) - (should - (string= - (sx--user-@name '((display_name . "ĤÞßĐŁŘĞĜÝŸÑŃŚŞŠŜŻŹŽÇĆČĈÙÚÛÜŬŮÒÓÔÕÖØŐÐÌÍÎÏıÈÉÊËĘÀÅÁÂÄÃÅĄĴ"))) - "@HTHssDLRGGYYNNSSSSZZZCCCCUUUUUUOOOOOOOOIIIIiEEEEEAAAAAAAAJ"))) +(defun sx-test-message (message &rest args) + (when sx-test-enable-messages + (apply #'message message args))) -(ert-deftest thing-as-string () - "Tests `sx--thing-as-string'" - (should - (string= (sx--thing-as-string - '(hello world (this is a test)) - '(";" "+")) - "hello;world;this+is+a+test")) - (should - (string= (sx--thing-as-string - '(this is a test) '(";" "+")) - "this;is;a;test")) - (should - (string= (sx--thing-as-string - '(this is a test) "+") - "this+is+a+test")) - (should - (string= (sx--thing-as-string - '(this is a test)) - "this;is;a;test")) - (should - (string= (sx--thing-as-string - 'test) - "test")) - (should - (string= (sx--thing-as-string - 'test&) - "test&")) - (should - (string= (sx--thing-as-string - 'test& nil t) - "test%26"))) +(mapc #'sx-load-test + '(api macros printing util)) |