From ef1d321a157e300d29c48e461257897fca1c9aa4 Mon Sep 17 00:00:00 2001 From: Sean Allred Date: Sat, 20 Dec 2014 02:01:52 -0500 Subject: Expand `let-alist' upon `sx-assoc-let' expansion --- sx.el | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/sx.el b/sx.el index 6f4e7c7..97a6d61 100644 --- a/sx.el +++ b/sx.el @@ -313,10 +313,11 @@ with a `link' property)." 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)))) (defcustom sx-init-hook nil "Hook run when SX initializes. -- cgit v1.2.3 From 7d2cccd82cf6c658e330767d0e20e48e42ff1ac6 Mon Sep 17 00:00:00 2001 From: Sean Allred Date: Sat, 20 Dec 2014 02:22:37 -0500 Subject: Fix `sx-assoc-let' tests `require' form is no longer needed -- macro expansion is done with the expansion of `sx-assoc-let'. --- test/tests.el | 16 +++++++++------- 1 file changed, 9 insertions(+), 7 deletions(-) diff --git a/test/tests.el b/test/tests.el index 66d8d88..cc58105 100644 --- a/test/tests.el +++ b/test/tests.el @@ -121,14 +121,16 @@ (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)))) + (equal `(progn (sx--ensure-site data) + ,(macroexpand + '(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))) + (equal `(progn (sx--ensure-site data) + ,(macroexpand + '(let-alist data + (cons .test-one .test-two)))) (macroexpand '(sx-assoc-let data (cons .test-one .test-two)))))) -- cgit v1.2.3 From ff7bf723a10352d0a69078e4d0645d078aa143df Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Tue, 16 Dec 2014 20:44:56 -0200 Subject: delay-mode-hooks on markdown-mode. Fix #159 --- sx-question-print.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/sx-question-print.el b/sx-question-print.el index 223049a..0e90c51 100644 --- a/sx-question-print.el +++ b/sx-question-print.el @@ -340,7 +340,7 @@ E.g.: "Return TEXT filled according to `markdown-mode'." (with-temp-buffer (insert text) - (markdown-mode) + (delay-mode-hooks (markdown-mode)) (font-lock-mode -1) (when sx-question-mode-bullet-appearance (font-lock-add-keywords ;; Bullet items. -- cgit v1.2.3 From e355e9571b749311e7d3fb7fbd54ac5246ec3c25 Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Tue, 16 Dec 2014 20:52:23 -0200 Subject: delay-mode-hooks on code blocks --- sx-babel.el | 24 +++++++++++++++--------- 1 file changed, 15 insertions(+), 9 deletions(-) diff --git a/sx-babel.el b/sx-babel.el index 5544642..b4ff306 100644 --- a/sx-babel.el +++ b/sx-babel.el @@ -56,11 +56,16 @@ on a match.") (insert text) (setq indent (sx-babel--unindent-buffer)) (goto-char (point-min)) - (make-text-button - (point-min) (point-max) - 'sx-button-copy (buffer-string) - :type 'sx-question-mode-code-block) - (sx-babel--determine-and-activate-major-mode) + (let ((mode (sx-babel--determine-major-mode))) + (make-text-button + (point-min) (point-max) + 'sx-button-copy (buffer-string) + ;; We store the mode here so it can be used if the user wants + ;; to edit the code block. + 'sx-mode mode + :type 'sx-question-mode-code-block) + (when mode + (delay-mode-hooks (funcall mode)))) (font-lock-fontify-region (point-min) (point-max)) (goto-char (point-min)) (let ((space (make-string indent ?\s))) @@ -72,17 +77,18 @@ on a match.") (delete-region beg end) (insert text))) -(defun sx-babel--determine-and-activate-major-mode () - "Activate the major-mode most suitable for the current buffer." +(defun sx-babel--determine-major-mode () + "Return the major-mode most suitable for the current buffer." (let ((alist sx-babel-major-mode-alist) - cell) + cell out) (while (setq cell (pop alist)) (goto-char (point-min)) (skip-chars-forward "\r\n[:blank:]") (let ((kar (car cell))) (when (if (stringp kar) (looking-at kar) (funcall kar)) (setq alist nil) - (funcall (cadr cell))))))) + (setq out (cadr cell))))) + out)) (defun sx-babel--unindent-buffer () "Remove absolute indentation in current buffer. -- cgit v1.2.3 From ff0ee3f39c8801023a838838bac36836d871f4e7 Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Tue, 16 Dec 2014 21:08:58 -0200 Subject: Activate major-mode when editing code-blocks --- sx-button.el | 13 ++++++++----- 1 file changed, 8 insertions(+), 5 deletions(-) diff --git a/sx-button.el b/sx-button.el index 283fe0d..f166164 100644 --- a/sx-button.el +++ b/sx-button.el @@ -77,20 +77,23 @@ This is usually a link's URL, or the content of a code block." (point) 'sx-button-copy-type) content))))) -(defun sx-button-edit-this (text-or-marker) - "Open a temp buffer populated with the string TEXT-OR-MARKER. +(defun sx-button-edit-this (text-or-marker &optional major-mode) + "Open a temp buffer populated with the string TEXT-OR-MARKER using MAJOR-MODE. When given a marker (or interactively), use the 'sx-button-copy -text-property under the marker. This is usually the content of a -code-block." +and the 'sx-mode text-properties under the marker. These are +usually part of a code-block." (interactive (list (point-marker))) ;; Buttons receive markers. (when (markerp text-or-marker) + (setq major-mode (get-text-property text-or-marker 'sx-mode)) (unless (setq text-or-marker (get-text-property text-or-marker 'sx-button-copy)) (sx-message "Nothing of interest here."))) (with-current-buffer (pop-to-buffer (generate-new-buffer "*sx temp buffer*")) - (insert text-or-marker))) + (insert text-or-marker) + (when major-mode + (funcall major-mode)))) (defun sx-button-follow-link (&optional pos) "Follow link at POS. If POS is nil, use `point'." -- cgit v1.2.3 From 9907fb614e0a687a5823519aaa2ae06df12d3dfe Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Tue, 16 Dec 2014 21:20:31 -0200 Subject: Make entire code-block a single button This fixes a bug we had. Hitting TAB on a codeblock would move us to the next line on the code block, instead of going to another button. Now the entire code block is a single button, so that is fixed. --- sx-babel.el | 26 +++++++++++++------------- 1 file changed, 13 insertions(+), 13 deletions(-) diff --git a/sx-babel.el b/sx-babel.el index b4ff306..24e56c2 100644 --- a/sx-babel.el +++ b/sx-babel.el @@ -51,31 +51,31 @@ on a match.") (defun sx-babel--make-pre-button (beg end) "Turn the region between BEG and END into a button." (let ((text (buffer-substring-no-properties beg end)) - indent) + indent mode copy) (with-temp-buffer (insert text) (setq indent (sx-babel--unindent-buffer)) (goto-char (point-min)) - (let ((mode (sx-babel--determine-major-mode))) - (make-text-button - (point-min) (point-max) - 'sx-button-copy (buffer-string) - ;; We store the mode here so it can be used if the user wants - ;; to edit the code block. - 'sx-mode mode - :type 'sx-question-mode-code-block) - (when mode - (delay-mode-hooks (funcall mode)))) + (setq mode (sx-babel--determine-major-mode)) + (setq copy (string-trim-right (buffer-string))) + (when mode + (delay-mode-hooks (funcall mode))) (font-lock-fontify-region (point-min) (point-max)) (goto-char (point-min)) (let ((space (make-string indent ?\s))) (while (not (eobp)) - (insert space) + (insert-and-inherit space) (forward-line 1))) (setq text (buffer-string))) (goto-char beg) (delete-region beg end) - (insert text))) + (insert-text-button + text + 'sx-button-copy copy + ;; We store the mode here so it can be used if the user wants + ;; to edit the code block. + 'sx-mode mode + :type 'sx-question-mode-code-block))) (defun sx-babel--determine-major-mode () "Return the major-mode most suitable for the current buffer." -- cgit v1.2.3 From 8dc020031b0472d8fc5b50037fcc257422f7544f Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Tue, 16 Dec 2014 21:55:17 -0200 Subject: Display comment score --- sx-question-print.el | 23 +++++++++++++---------- 1 file changed, 13 insertions(+), 10 deletions(-) diff --git a/sx-question-print.el b/sx-question-print.el index 0e90c51..e2e171b 100644 --- a/sx-question-print.el +++ b/sx-question-print.el @@ -291,17 +291,20 @@ The comment is indented, filled, and then printed according to (list 'sx--data-here comment-data) (sx-assoc-let comment-data (insert + (if (> .score 0) (number-to-string .score) "") + (if (eq .upvoted t) "^" "") + (if (or (> .score 0) .upvoted) " " "") (format - sx-question-mode-comments-format - (sx-question-mode--propertize-display-name .owner) - (substring - ;; We fill with three spaces at the start, so the comment is - ;; slightly indented. - (sx-question-mode--fill-and-fontify - (concat " " .body_markdown)) - ;; Then we remove the spaces from the first line, since we'll - ;; add the username there anyway. - 3)))))) + sx-question-mode-comments-format + (sx-question-mode--propertize-display-name .owner) + (substring + ;; We fill with three spaces at the start, so the comment is + ;; slightly indented. + (sx-question-mode--fill-and-fontify + (concat " " .body_markdown)) + ;; Then we remove the spaces from the first line, since we'll + ;; add the username there anyway. + 3)))))) (defun sx-question-mode--insert-header (&rest args) "Insert propertized ARGS. -- cgit v1.2.3 From 3de378c215fdfa82df821df1339b0f1504d4a469 Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Wed, 17 Dec 2014 12:36:11 -0200 Subject: Support editing comments. --- sx-compose.el | 18 +++++++++++++----- sx-interaction.el | 1 - 2 files changed, 13 insertions(+), 6 deletions(-) diff --git a/sx-compose.el b/sx-compose.el index 96f47f3..af9d861 100644 --- a/sx-compose.el +++ b/sx-compose.el @@ -146,19 +146,22 @@ respectively added locally to `sx-compose-before-send-hook' and (error "Invalid PARENT")) (let ((is-question (and (listp parent) - (null (cdr (assoc 'answer_id parent)))))) + (cdr (assoc 'title parent))))) (with-current-buffer (sx-compose--get-buffer-create site parent) (sx-compose-mode) (setq sx-compose--send-function (if (consp parent) (sx-assoc-let parent - (lambda () (sx-method-call (if .title 'questions 'answers) + (lambda () (sx-method-call (cond + (.title 'questions) + (.comment_id 'comments) + (t 'answers)) :auth 'warn :url-method "POST" :filter sx-browse-filter :site site :keywords (sx-compose--generate-keywords is-question) - :id (or .answer_id .question_id) + :id (or .comment_id .answer_id .question_id) :submethod 'edit))) (lambda () (sx-method-call 'questions :auth 'warn @@ -256,8 +259,13 @@ the id property." site data))) (t (get-buffer-create - (format "*sx draft edit %s %s*" - site (sx-assoc-let data (or .answer_id .question_id))))))) + (sx-assoc-let data + (format "*sx draft edit %s %s %s*" + site + (cond (.title "question") + (.comment_id "comment") + (t "answer")) + (or .comment_id .answer_id .question_id))))))) (provide 'sx-compose) ;;; sx-compose.el ends here diff --git a/sx-interaction.el b/sx-interaction.el index ea494eb..da08581 100644 --- a/sx-interaction.el +++ b/sx-interaction.el @@ -304,7 +304,6 @@ from context at point." ;; If we ever make an "Edit" button, first arg is a marker. (when (markerp data) (setq data (sx--data-here))) (sx-assoc-let data - (when .comment_id (sx-user-error "Editing comments is not supported yet")) (let ((buffer (current-buffer))) (pop-to-buffer (sx-compose-create -- cgit v1.2.3 From 5c965d196ff4dcd043577ecdacdd75b21482ea9c Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Wed, 17 Dec 2014 12:36:37 -0200 Subject: Fix buffer not updating after posting answers/edits. --- sx-interaction.el | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/sx-interaction.el b/sx-interaction.el index da08581..177a054 100644 --- a/sx-interaction.el +++ b/sx-interaction.el @@ -93,10 +93,11 @@ If it's not a question, or if it is read, return DATA." If BUFFER is not live, nothing is done." (setq buffer (or buffer (current-buffer))) (when (buffer-live-p buffer) - (cond ((derived-mode-p 'sx-question-list-mode) - (sx-question-list-refresh 'redisplay 'no-update)) - ((derived-mode-p 'sx-question-mode) - (sx-question-mode-refresh 'no-update))))) + (with-current-buffer buffer + (cond ((derived-mode-p 'sx-question-list-mode) + (sx-question-list-refresh 'redisplay 'no-update)) + ((derived-mode-p 'sx-question-mode) + (sx-question-mode-refresh 'no-update)))))) (defun sx--copy-data (from to) "Copy all fields of alist FORM onto TO. -- cgit v1.2.3 From e9f3aa5c9ff474b2700d1c982f93a1d37aa6a3ca Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Wed, 17 Dec 2014 12:36:58 -0200 Subject: Close compose window when buffer is killed. --- sx-compose.el | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/sx-compose.el b/sx-compose.el index af9d861..5201435 100644 --- a/sx-compose.el +++ b/sx-compose.el @@ -117,9 +117,12 @@ contents to the API, then calls `sx-compose-after-send-functions'." (current-buffer) result))))) (defun sx-compose-quit (buffer _) - "Kill BUFFER." + "Close BUFFER's window and kill it." (interactive (list (current-buffer) nil)) (when (buffer-live-p buffer) + (let ((w (get-buffer-window buffer))) + (when (window-live-p w) + (delete-window w))) (kill-buffer buffer))) (defun sx-compose--copy-as-kill (buffer _) -- cgit v1.2.3 From ad3849d4b4d946bc186473718ccd50953a94c143 Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Wed, 17 Dec 2014 12:53:25 -0200 Subject: Refactor comment validity checking --- sx-interaction.el | 16 ++++++++++++++-- 1 file changed, 14 insertions(+), 2 deletions(-) diff --git a/sx-interaction.el b/sx-interaction.el index 177a054..9af9ac6 100644 --- a/sx-interaction.el +++ b/sx-interaction.el @@ -234,8 +234,8 @@ TEXT is a string. Interactively, it is read from the minibufer." "Comment text: " (when .comment_id (concat (sx--user-@name .owner) " ")))) - (while (< (string-width text) 15) - (setq text (read-string "Comment text (at least 15 characters): " text)))) + (while (not (sx--comment-valid-p text 'silent)) + (setq text (read-string "Comment text (between 16 and 600 characters): " text)))) ;; If non-interactive, `text' could be anything. (unless (stringp text) (error "Comment body must be a string")) @@ -259,6 +259,18 @@ TEXT is a string. Interactively, it is read from the minibufer." ;; Display the changes in `data'. (sx--maybe-update-display))))) +(defun sx--comment-valid-p (&optional text silent) + "Non-nil if TEXT fits stack exchange comment length limits. +If TEXT is nil, use `buffer-string'. Must have more than 15 and +less than 601 characters. +If SILENT is nil, message the user about this limit." + (let ((w (string-width (or text (buffer-string))))) + (if (and (< 15 w) (< w 601)) + t + (unless silent + (message "Comments must be within 16 and 600 characters.")) + nil))) + (defun sx--get-post (type site id) "Find in the database a post identified by TYPE, SITE and ID. TYPE is `question' or `answer'. -- cgit v1.2.3 From 8142023ef51a90fdb5fe094bd9861308cb39452d Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Wed, 17 Dec 2014 12:53:35 -0200 Subject: Do comment validity checking on edits too --- sx-interaction.el | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/sx-interaction.el b/sx-interaction.el index 9af9ac6..2768c8d 100644 --- a/sx-interaction.el +++ b/sx-interaction.el @@ -320,7 +320,9 @@ from context at point." (let ((buffer (current-buffer))) (pop-to-buffer (sx-compose-create - .site data nil + .site data + ;; Before send hook + (when .comment_id (list #'sx--comment-valid-p)) ;; After send functions (list (lambda (_ res) (sx--copy-data (elt res 0) data) -- cgit v1.2.3 From 569e1397bd2e1bcad34658780ef758e979caa243 Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Thu, 18 Dec 2014 16:08:51 -0200 Subject: Hotfix Don't use string-trim. Fix #164 --- sx-question-print.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/sx-question-print.el b/sx-question-print.el index e2e171b..ad53b04 100644 --- a/sx-question-print.el +++ b/sx-question-print.el @@ -369,7 +369,7 @@ E.g.: (skip-chars-forward "\r\n[:blank:]") (forward-paragraph) (fill-region beg (point))))) - (string-trim-right (buffer-string)))) + (replace-regexp-in-string "[[:blank:]]+\\'" "" (buffer-string)))) (defun sx-question-mode--dont-fill-here () "If text shouldn't be filled here, return t and skip over it." -- cgit v1.2.3 From 44ee0f1369e00db9aadd2985e1968573ee873a22 Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Thu, 18 Dec 2014 16:25:59 -0200 Subject: Don't fill comments. Affects #141 --- sx-question-print.el | 12 ++++++++++++ 1 file changed, 12 insertions(+) diff --git a/sx-question-print.el b/sx-question-print.el index ad53b04..6fa84a9 100644 --- a/sx-question-print.el +++ b/sx-question-print.el @@ -374,6 +374,7 @@ E.g.: (defun sx-question-mode--dont-fill-here () "If text shouldn't be filled here, return t and skip over it." (or (sx-question-mode--skip-and-fontify-pre) + (sx-question-mode--skip-comments) ;; Skip headers and references (let ((pos (point))) (skip-chars-forward "\r\n[:blank:]") @@ -449,5 +450,16 @@ font-locking." (goto-char before) nil))) +(defun sx-question-mode--skip-comments () + "If there's an html comment ahead, skip it and return t." + ;; @TODO: Handle the comment. + ;; "Handling means to store any relevant metadata it might be holding." + (let ((before (point))) + (skip-chars-forward "\r\n[:blank:]") + (if (markdown-match-comments (line-end-position)) + t + (goto-char before) + nil))) + (provide 'sx-question-print) ;;; sx-question-print.el ends here -- cgit v1.2.3 From f97bc0633c6803e2f2f7a46d8c814f1bc2763b66 Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Thu, 18 Dec 2014 17:45:42 -0200 Subject: Refactor and simplify sx-question-mode--skip-FOO functions. They no longer need to worry about restoring point. Just move point to its destination and return non-nil if it worked. --- sx-question-print.el | 53 +++++++++++++++++++--------------------------------- 1 file changed, 19 insertions(+), 34 deletions(-) diff --git a/sx-question-print.el b/sx-question-print.el index 6fa84a9..5fcf015 100644 --- a/sx-question-print.el +++ b/sx-question-print.el @@ -373,19 +373,19 @@ E.g.: (defun sx-question-mode--dont-fill-here () "If text shouldn't be filled here, return t and skip over it." - (or (sx-question-mode--skip-and-fontify-pre) - (sx-question-mode--skip-comments) - ;; Skip headers and references - (let ((pos (point))) - (skip-chars-forward "\r\n[:blank:]") - (goto-char (line-beginning-position)) - (if (or (looking-at-p (format sx-question-mode--reference-regexp ".+")) - (looking-at-p "^#")) - ;; Returns non-nil - (forward-paragraph) - ;; Go back and return nil - (goto-char pos) - nil)))) + (catch 'sx-question-mode-done + (let ((before (point))) + (skip-chars-forward "\r\n[:blank:]") + (let ((first-non-blank (point))) + (dolist (it '(sx-question-mode--skip-and-fontify-pre + sx-question-mode--skip-comments)) + ;; If something worked, keep point where it is and return t. + (if (funcall it) (throw 'sx-question-mode-done t) + ;; Before calling each new function. Go back to the first + ;; non-blank char. + (goto-char first-non-blank))) + ;; If nothing matched, go back to the very beginning. + (goto-char before))))) (defun sx-question-mode--process-links-in-buffer () "Turn all markdown links in this buffer into compact format." @@ -434,32 +434,17 @@ If ID is nil, use FALLBACK-ID instead." "If there's a pre block ahead, handle it, skip it and return t. Handling means to turn it into a button and remove erroneous font-locking." - (let ((before (point)) - beg end) - (if (markdown-match-pre-blocks - (save-excursion - (skip-chars-forward "\r\n[:blank:]") - (setq beg (point)))) - (progn - (setq end (point)) - (sx-babel--make-pre-button - (save-excursion - (goto-char beg) - (line-beginning-position)) - end)) - (goto-char before) - nil))) + (let ((beg (line-beginning-position))) + ;; To identify code-blocks we need to be at start of line. + (goto-char beg) + (when (markdown-match-pre-blocks (line-end-position)) + (sx-babel--make-pre-button beg (point))))) (defun sx-question-mode--skip-comments () "If there's an html comment ahead, skip it and return t." ;; @TODO: Handle the comment. ;; "Handling means to store any relevant metadata it might be holding." - (let ((before (point))) - (skip-chars-forward "\r\n[:blank:]") - (if (markdown-match-comments (line-end-position)) - t - (goto-char before) - nil))) + (markdown-match-comments (line-end-position))) (provide 'sx-question-print) ;;; sx-question-print.el ends here -- cgit v1.2.3 From bd15a562109470f1c412f9c32ef7e9ab10c13ec2 Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Thu, 18 Dec 2014 17:49:18 -0200 Subject: Don't fill headlines --- sx-question-print.el | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/sx-question-print.el b/sx-question-print.el index 5fcf015..1b34d2e 100644 --- a/sx-question-print.el +++ b/sx-question-print.el @@ -378,6 +378,7 @@ E.g.: (skip-chars-forward "\r\n[:blank:]") (let ((first-non-blank (point))) (dolist (it '(sx-question-mode--skip-and-fontify-pre + sx-question-mode--skip-headline sx-question-mode--skip-comments)) ;; If something worked, keep point where it is and return t. (if (funcall it) (throw 'sx-question-mode-done t) @@ -446,5 +447,12 @@ font-locking." ;; "Handling means to store any relevant metadata it might be holding." (markdown-match-comments (line-end-position))) +(defun sx-question-mode--skip-headline () + "If there's a headline ahead, skip it and return non-nil." + (when (or (looking-at-p "^#+ ") + (progn (forward-line 1) (looking-at-p "===\\|---"))) + ;; Returns non-nil. + (forward-line 1))) + (provide 'sx-question-print) ;;; sx-question-print.el ends here -- cgit v1.2.3 From a412a1afc1761ca0954b558c9ef317354503032b Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Thu, 18 Dec 2014 17:49:29 -0200 Subject: Reimplement reference not-filling --- sx-question-print.el | 7 +++++++ 1 file changed, 7 insertions(+) diff --git a/sx-question-print.el b/sx-question-print.el index 1b34d2e..04c22fd 100644 --- a/sx-question-print.el +++ b/sx-question-print.el @@ -379,6 +379,7 @@ E.g.: (let ((first-non-blank (point))) (dolist (it '(sx-question-mode--skip-and-fontify-pre sx-question-mode--skip-headline + sx-question-mode--skip-references sx-question-mode--skip-comments)) ;; If something worked, keep point where it is and return t. (if (funcall it) (throw 'sx-question-mode-done t) @@ -454,5 +455,11 @@ font-locking." ;; Returns non-nil. (forward-line 1))) +(defun sx-question-mode--skip-references () + "If there's a reference ahead, skip it and return non-nil." + (while (looking-at-p (format sx-question-mode--reference-regexp ".+")) + ;; Returns non-nil + (forward-line 1))) + (provide 'sx-question-print) ;;; sx-question-print.el ends here -- cgit v1.2.3 From 4828fdf0278aefe31430b7ab92549c966491976b Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Thu, 18 Dec 2014 17:53:18 -0200 Subject: Reorganize functions. --- sx-question-print.el | 40 ++++++++++++++++++++++------------------ 1 file changed, 22 insertions(+), 18 deletions(-) diff --git a/sx-question-print.el b/sx-question-print.el index 04c22fd..ed2fb70 100644 --- a/sx-question-print.el +++ b/sx-question-print.el @@ -371,24 +371,8 @@ E.g.: (fill-region beg (point))))) (replace-regexp-in-string "[[:blank:]]+\\'" "" (buffer-string)))) -(defun sx-question-mode--dont-fill-here () - "If text shouldn't be filled here, return t and skip over it." - (catch 'sx-question-mode-done - (let ((before (point))) - (skip-chars-forward "\r\n[:blank:]") - (let ((first-non-blank (point))) - (dolist (it '(sx-question-mode--skip-and-fontify-pre - sx-question-mode--skip-headline - sx-question-mode--skip-references - sx-question-mode--skip-comments)) - ;; If something worked, keep point where it is and return t. - (if (funcall it) (throw 'sx-question-mode-done t) - ;; Before calling each new function. Go back to the first - ;; non-blank char. - (goto-char first-non-blank))) - ;; If nothing matched, go back to the very beginning. - (goto-char before))))) - + +;;; Handling links (defun sx-question-mode--process-links-in-buffer () "Turn all markdown links in this buffer into compact format." (save-excursion @@ -432,6 +416,26 @@ If ID is nil, use FALLBACK-ID instead." nil t) (match-string-no-properties 1))))) + +;;; Things we don't fill +(defun sx-question-mode--dont-fill-here () + "If text shouldn't be filled here, return t and skip over it." + (catch 'sx-question-mode-done + (let ((before (point))) + (skip-chars-forward "\r\n[:blank:]") + (let ((first-non-blank (point))) + (dolist (it '(sx-question-mode--skip-and-fontify-pre + sx-question-mode--skip-headline + sx-question-mode--skip-references + sx-question-mode--skip-comments)) + ;; If something worked, keep point where it is and return t. + (if (funcall it) (throw 'sx-question-mode-done t) + ;; Before calling each new function. Go back to the first + ;; non-blank char. + (goto-char first-non-blank))) + ;; If nothing matched, go back to the very beginning. + (goto-char before))))) + (defun sx-question-mode--skip-and-fontify-pre () "If there's a pre block ahead, handle it, skip it and return t. Handling means to turn it into a button and remove erroneous -- cgit v1.2.3 From 24a98414fcc46f912222a0a84c5ddfd37415e375 Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Thu, 18 Dec 2014 18:07:04 -0200 Subject: Fix return values --- sx-question-print.el | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/sx-question-print.el b/sx-question-print.el index ed2fb70..629fd7c 100644 --- a/sx-question-print.el +++ b/sx-question-print.el @@ -434,7 +434,9 @@ If ID is nil, use FALLBACK-ID instead." ;; non-blank char. (goto-char first-non-blank))) ;; If nothing matched, go back to the very beginning. - (goto-char before))))) + (goto-char before) + ;; And return nil + nil)))) (defun sx-question-mode--skip-and-fontify-pre () "If there's a pre block ahead, handle it, skip it and return t. @@ -444,7 +446,8 @@ font-locking." ;; To identify code-blocks we need to be at start of line. (goto-char beg) (when (markdown-match-pre-blocks (line-end-position)) - (sx-babel--make-pre-button beg (point))))) + (sx-babel--make-pre-button beg (point)) + t))) (defun sx-question-mode--skip-comments () "If there's an html comment ahead, skip it and return t." -- cgit v1.2.3 From 2d68b9d7cfb8c483880b83b3008bf2bd0cd41eb0 Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Thu, 18 Dec 2014 18:17:53 -0200 Subject: Fix score checking --- sx-question-print.el | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/sx-question-print.el b/sx-question-print.el index 629fd7c..a118a43 100644 --- a/sx-question-print.el +++ b/sx-question-print.el @@ -290,10 +290,11 @@ The comment is indented, filled, and then printed according to (sx--wrap-in-overlay (list 'sx--data-here comment-data) (sx-assoc-let comment-data - (insert - (if (> .score 0) (number-to-string .score) "") - (if (eq .upvoted t) "^" "") - (if (or (> .score 0) .upvoted) " " "") + (when (> .score 0) + (insert (number-to-string .score) + (if (eq .upvoted t) "^" "") + " ")) + (insert (format sx-question-mode-comments-format (sx-question-mode--propertize-display-name .owner) -- cgit v1.2.3 From c5bcc85d9cb79c080846cb13979938c8be7c0cba Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Thu, 18 Dec 2014 18:49:38 -0200 Subject: Test sx-assoc-let not let-alist Since let-alist is no longer defined here. It makes no sense to test its contents. --- test/tests.el | 16 +++++----------- 1 file changed, 5 insertions(+), 11 deletions(-) diff --git a/test/tests.el b/test/tests.el index 8969c37..66d8d88 100644 --- a/test/tests.el +++ b/test/tests.el @@ -123,20 +123,14 @@ (should (equal '(progn (require 'let-alist) (sx--ensure-site data) - (let ((.test (cdr (assq 'test data)))) - .test)) - (macroexpand-all - '(sx-assoc-let data - .test)))) + (let-alist data .test)) + (macroexpand '(sx-assoc-let data .test)))) (should (equal '(progn (require 'let-alist) (sx--ensure-site data) - (let ((.test-one (cdr (assq 'test-one data))) - (.test-two (cdr (assq 'test-two data)))) - (cons .test-one .test-two))) - (macroexpand-all - '(sx-assoc-let data - (cons .test-one .test-two)))))) + (let-alist data (cons .test-one .test-two))) + (macroexpand + '(sx-assoc-let data (cons .test-one .test-two)))))) (ert-deftest sx--user-@name () "Tests macro expansion for `sx-assoc-let'" -- cgit v1.2.3 From 3f472b25a166509e1724199ff7eb136374cc00e3 Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Thu, 18 Dec 2014 22:31:43 -0200 Subject: The separator above body is no longer a section I got tired of having to hit `n` twice to move past the body. --- sx-question-print.el | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/sx-question-print.el b/sx-question-print.el index a118a43..2f07132 100644 --- a/sx-question-print.el +++ b/sx-question-print.el @@ -238,8 +238,7 @@ DATA can represent a question or an answer." ;; Body (insert "\n" (propertize sx-question-mode-separator - 'face 'sx-question-mode-header - 'sx-question-mode--section 4)) + 'face 'sx-question-mode-header)) (sx--wrap-in-overlay '(face sx-question-mode-content-face) (insert "\n" -- cgit v1.2.3 From 06ec0c89a1ecf437d30c3a796f1611a8d8d3dbc0 Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Thu, 18 Dec 2014 22:37:42 -0200 Subject: Properly skip invisible sections. --- sx-question-mode.el | 6 ++---- 1 file changed, 2 insertions(+), 4 deletions(-) diff --git a/sx-question-mode.el b/sx-question-mode.el index 807eeea..cc7799d 100644 --- a/sx-question-mode.el +++ b/sx-question-mode.el @@ -120,10 +120,8 @@ Prefix argument N moves N sections down or up." ;; If all we did was move out the current one, then move again ;; and we're guaranteed to reach the next section. (sx-question-mode--goto-property-change 'section n)) - (let ((ov (car-safe (sx-question-mode--section-overlays-at (point))))) - (unless (and (overlayp ov) - (overlay-get ov 'invisible)) - (cl-decf count))))) + (unless (get-char-property (point) 'invisible) + (cl-decf count)))) (when (equal (selected-window) (get-buffer-window)) (when sx-question-mode-recenter-line (let ((ov (sx-question-mode--section-overlays-at (line-end-position)))) -- cgit v1.2.3 From e3aa448f7d456d857879e53ae7b2268d8b5d97c2 Mon Sep 17 00:00:00 2001 From: Sean Allred Date: Sat, 20 Dec 2014 02:00:24 -0500 Subject: Hotfix undefined variable --- sx.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/sx.el b/sx.el index 7d67835..cda1acd 100644 --- a/sx.el +++ b/sx.el @@ -107,7 +107,8 @@ is intentionally skipped." (defun sx-user-error (format-string &rest args) "Like `user-error', but prepend FORMAT-STRING with \"[sx]\". See `format'." - (signal 'user-error (list (apply #'format (concat "[sx] " format) args)))) + (signal 'user-error + (list (apply #'format (concat "[sx] " format-string) args)))) (defun sx-message (format-string &rest args) "Display FORMAT-STRING as a message with ARGS. -- cgit v1.2.3 From b16b2f298a47cdc36453f7977e01e6c8c712a6e1 Mon Sep 17 00:00:00 2001 From: Sean Allred Date: Sat, 20 Dec 2014 03:13:47 -0500 Subject: Hotfix require subr-x For `string-trim-right' --- sx-babel.el | 1 + 1 file changed, 1 insertion(+) diff --git a/sx-babel.el b/sx-babel.el index 24e56c2..7346f99 100644 --- a/sx-babel.el +++ b/sx-babel.el @@ -26,6 +26,7 @@ ;;; Code: +(require 'subr-x) (require 'sx-button) (defvar sx-babel-major-mode-alist -- cgit v1.2.3 From 1d0e733f64d1dc2549bd1698c1d03b5bcff2af5f Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Sat, 20 Dec 2014 15:08:43 -0200 Subject: Hotfix switch-tab --- sx-question-list.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/sx-question-list.el b/sx-question-list.el index f6a82e2..62ce032 100644 --- a/sx-question-list.el +++ b/sx-question-list.el @@ -315,7 +315,7 @@ into consideration. ("K" sx-question-list-previous-far) ("g" sx-question-list-refresh) (":" sx-question-list-switch-site) - ("t" sx-question-list-switch-tab) + ("t" sx-tab-switch) ("a" sx-ask) ("v" sx-visit-externally) ("u" sx-toggle-upvote) -- cgit v1.2.3 From 118f22e76b48201e6be44ce83f3e72afcbbcf4ad Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Sat, 20 Dec 2014 15:10:08 -0200 Subject: Hotfix subr-x didn't exist before 24.3 --- sx-babel.el | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/sx-babel.el b/sx-babel.el index 7346f99..b30a044 100644 --- a/sx-babel.el +++ b/sx-babel.el @@ -26,7 +26,6 @@ ;;; Code: -(require 'subr-x) (require 'sx-button) (defvar sx-babel-major-mode-alist @@ -58,7 +57,7 @@ on a match.") (setq indent (sx-babel--unindent-buffer)) (goto-char (point-min)) (setq mode (sx-babel--determine-major-mode)) - (setq copy (string-trim-right (buffer-string))) + (setq copy (replace-regexp-in-string "[[:space:]]+\\'" "" (buffer-string))) (when mode (delay-mode-hooks (funcall mode))) (font-lock-fontify-region (point-min) (point-max)) -- cgit v1.2.3 From 7902a1e1f1b40f04aeb728b0b39fc73bf54b160f Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Sat, 20 Dec 2014 15:29:30 -0200 Subject: Displaying questions uses pop-to-buffer instead of switch by default Fixes #153 See variable `sx-question-mode-display-buffer-function' --- sx-question-mode.el | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/sx-question-mode.el b/sx-question-mode.el index cc7799d..a60cf3a 100644 --- a/sx-question-mode.el +++ b/sx-question-mode.el @@ -30,11 +30,13 @@ ;;; Displaying a question -(defcustom sx-question-mode-display-buffer-function #'switch-to-buffer +(defcustom sx-question-mode-display-buffer-function #'pop-to-buffer "Function used to display the question buffer. Called, for instance, when hitting \\`\\[sx-question-list-display-question]' on an entry in the question list. -This is not used when navigating the question list with `\\[sx-question-list-view-next]." +This is not used when navigating the question list with `\\[sx-question-list-view-next]. + +Common values for this variable are `pop-to-buffer' and `switch-to-buffer'." :type 'function :group 'sx-question-mode) -- cgit v1.2.3 From 3c0b678c02b20526410b2d4b95d94d94ccc35168 Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Sat, 20 Dec 2014 16:19:35 -0200 Subject: Hotfix, don't barf on links we don't understand. These are usually not links. See the end of http://emacs.stackexchange.com/q/3727/50 --- sx-question-print.el | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/sx-question-print.el b/sx-question-print.el index 2f07132..fe1e2b0 100644 --- a/sx-question-print.el +++ b/sx-question-print.el @@ -384,10 +384,11 @@ E.g.: (match-string-no-properties 3) text))) (full-text (match-string-no-properties 0))) - (replace-match "") - (sx-question-mode--insert-link - (if sx-question-mode-pretty-links text full-text) - url))))) + (when (stringp url) + (replace-match "") + (sx-question-mode--insert-link + (if sx-question-mode-pretty-links text full-text) + url)))))) (defun sx-question-mode--insert-link (text url) "Return a link propertized version of string TEXT. -- cgit v1.2.3 From 834784d0ac8ac5472a811b1cc56cda9d0ac7f219 Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Sat, 20 Dec 2014 16:53:20 -0200 Subject: Hot fix #171. Check if .score is a number --- sx-question-print.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/sx-question-print.el b/sx-question-print.el index fe1e2b0..98d3308 100644 --- a/sx-question-print.el +++ b/sx-question-print.el @@ -289,11 +289,11 @@ The comment is indented, filled, and then printed according to (sx--wrap-in-overlay (list 'sx--data-here comment-data) (sx-assoc-let comment-data - (when (> .score 0) + (when (and (numberp .score) (> .score 0)) (insert (number-to-string .score) (if (eq .upvoted t) "^" "") " ")) - (insert + (insert (format sx-question-mode-comments-format (sx-question-mode--propertize-display-name .owner) -- cgit v1.2.3 From 5b255064ba6c73184cc7338914f917538f5b5bbb Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Sun, 21 Dec 2014 10:24:58 -0200 Subject: Basic inbox fetching --- sx-inbox.el | 68 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 68 insertions(+) create mode 100644 sx-inbox.el diff --git a/sx-inbox.el b/sx-inbox.el new file mode 100644 index 0000000..f58bee4 --- /dev/null +++ b/sx-inbox.el @@ -0,0 +1,68 @@ +p;;; sx-inbox.el --- Base question logic. -*- lexical-binding: t; -*- + +;; Copyright (C) 2014 Artur Malabarba + +;; Author: Artur Malabarba + +;; 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 . + +;;; Commentary: + + +;;; Code: + +(require 'sx) +(require 'sx-filter) +(require 'sx-method) + +(defvar sx-inbox-filter + '((inbox.answer_id + inbox.body + inbox.comment_id + inbox.creation_date + inbox.is_unread + inbox.item_type + inbox.link + inbox.question_id + inbox.site + inbox.title) + (site.logo_url + site.audience + site.icon_url + site.high_resolution_icon_url + site.site_state + site.launch_date + site.markdown_extensions + site.related_sites)) + "Filter used when retrieving inbox items.") + +(defun sx-inbox-get (&optional page keywords) + "Get an array of inbox items for the current user. +Return an list of items. Each item is an alist of properties +returned by the API. +See https://api.stackexchange.com/docs/types/inbox-item + +KEYWORDS are added to the method call along with PAGE. + +`sx-method-call' is used with `sx-inbox-filter'." + (sx-method-call 'inbox + :keywords keywords + :filter sx-inbox-filter)) + +(provide 'sx-inbox) +;;; sx-inbox.el ends here + +;; Local Variables: +;; indent-tabs-mode: nil +;; End: -- cgit v1.2.3 From d24a8b00341e207712ad0741b798491b378fe2c6 Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Sun, 21 Dec 2014 10:31:09 -0200 Subject: Typo --- sx-inbox.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/sx-inbox.el b/sx-inbox.el index f58bee4..5fb3652 100644 --- a/sx-inbox.el +++ b/sx-inbox.el @@ -1,4 +1,4 @@ -p;;; sx-inbox.el --- Base question logic. -*- lexical-binding: t; -*- +;;; sx-inbox.el --- Base inbox logic. -*- lexical-binding: t; -*- ;; Copyright (C) 2014 Artur Malabarba -- cgit v1.2.3 From 9de79b2fe4c077f148f1f1ff7e16c3cf961cae8a Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Sun, 21 Dec 2014 10:31:16 -0200 Subject: Generalize sx-inbox-get --- sx-inbox.el | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/sx-inbox.el b/sx-inbox.el index 5fb3652..3bc95c8 100644 --- a/sx-inbox.el +++ b/sx-inbox.el @@ -47,16 +47,19 @@ site.related_sites)) "Filter used when retrieving inbox items.") -(defun sx-inbox-get (&optional page keywords) +(defun sx-inbox-get (&optional notifications page keywords) "Get an array of inbox items for the current user. -Return an list of items. Each item is an alist of properties +If NOTIFICATIONS is non-nil, query from `notifications' method, +otherwise use `inbox' method. + +Return an array of items. Each item is an alist of properties returned by the API. See https://api.stackexchange.com/docs/types/inbox-item KEYWORDS are added to the method call along with PAGE. `sx-method-call' is used with `sx-inbox-filter'." - (sx-method-call 'inbox + (sx-method-call (if notifications 'notifications 'inbox) :keywords keywords :filter sx-inbox-filter)) -- cgit v1.2.3 From 4253db72eba6eee7c30962417c8092b1fb9f466b Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Sun, 21 Dec 2014 10:32:05 -0200 Subject: Initial mode-line --- sx-inbox.el | 17 +++++++++++++++++ 1 file changed, 17 insertions(+) diff --git a/sx-inbox.el b/sx-inbox.el index 3bc95c8..f01d90b 100644 --- a/sx-inbox.el +++ b/sx-inbox.el @@ -63,6 +63,23 @@ KEYWORDS are added to the method call along with PAGE. :keywords keywords :filter sx-inbox-filter)) + +;;; mode-line notification +(defvar sx-inbox--unread-inbox nil + "List of inbox items still unread.") + +(defvar sx-inbox--unread-notifications nil + "List of notifications items still unread.") + +(defvar sx-inbox--mode-line + '("[" + (sx-inbox--unread-inbox + ("i:" (:eval (length sx-inbox--unread-inbox)))) + (sx-inbox--unread-notifications + ("n:" (:eval (length sx-inbox--unread-notifications)))) + "]") + "") + (provide 'sx-inbox) ;;; sx-inbox.el ends here -- cgit v1.2.3 From 04ffa4b891161ce98fa203812768f06808417e0d Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Sun, 21 Dec 2014 10:34:21 -0200 Subject: Data sample --- test/data-samples/inbox-item.el | 13 +++++++++++++ 1 file changed, 13 insertions(+) create mode 100644 test/data-samples/inbox-item.el diff --git a/test/data-samples/inbox-item.el b/test/data-samples/inbox-item.el new file mode 100644 index 0000000..faeba12 --- /dev/null +++ b/test/data-samples/inbox-item.el @@ -0,0 +1,13 @@ +((title . "Can I mark inbox items as read in api v2.2?") + (link . "http://stackapps.com/posts/comments/12080?noredirect=1") + (item_type . "comment") + (question_id . 5059) + (comment_id . 12080) + (creation_date . 1419153905) + (is_unread . :json-false) + (site (site_type . "main_site") + (name . "Stack Apps") + (api_site_parameter . "stackapps") + (site_url . "http://stackapps.com") + (favicon_url . "http://cdn.sstatic.net/stackapps/img/favicon.ico") + (styling (link_color . "#0077DD") (tag_foreground_color . "#555555") (tag_background_color . "#E7ECEC")))) -- cgit v1.2.3 From 0a3a9540b3033e9e93927c92fb6df39a3785563d Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Sun, 21 Dec 2014 10:48:41 -0200 Subject: Move mode-line logic to sx-notify --- sx-inbox.el | 17 ---------------- sx-notify.el | 66 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 66 insertions(+), 17 deletions(-) create mode 100644 sx-notify.el diff --git a/sx-inbox.el b/sx-inbox.el index f01d90b..3bc95c8 100644 --- a/sx-inbox.el +++ b/sx-inbox.el @@ -63,23 +63,6 @@ KEYWORDS are added to the method call along with PAGE. :keywords keywords :filter sx-inbox-filter)) - -;;; mode-line notification -(defvar sx-inbox--unread-inbox nil - "List of inbox items still unread.") - -(defvar sx-inbox--unread-notifications nil - "List of notifications items still unread.") - -(defvar sx-inbox--mode-line - '("[" - (sx-inbox--unread-inbox - ("i:" (:eval (length sx-inbox--unread-inbox)))) - (sx-inbox--unread-notifications - ("n:" (:eval (length sx-inbox--unread-notifications)))) - "]") - "") - (provide 'sx-inbox) ;;; sx-inbox.el ends here diff --git a/sx-notify.el b/sx-notify.el new file mode 100644 index 0000000..bc88ceb --- /dev/null +++ b/sx-notify.el @@ -0,0 +1,66 @@ +;;; sx-notify.el --- Mode-line notifications. -*- lexical-binding: t; -*- + +;; Copyright (C) 2014 Artur Malabarba + +;; Author: Artur Malabarba + +;; 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 . + +;;; Commentary: + + +;;; Code: + +(require 'sx) +(require 'sx-inbox) + + +;;; mode-line notification +(defvar sx-notify--unread-inbox nil + "List of inbox items still unread.") + +(defvar sx-notify--unread-notifications nil + "List of notifications items still unread.") + +(defvar sx-notify--mode-line + '((sx-notify--unread-inbox (sx-notify--unread-notifications "[")) + (sx-notify--unread-inbox + (:propertize + (:eval (format "i:%s" (length sx-notify--unread-inbox))) + face mode-line-buffer-id + mouse-face mode-line-highlight)) + (sx-notify--unread-inbox (sx-notify--unread-notifications ",")) + (sx-notify--unread-notifications + (:propertize + (:eval (format "n:%s" (length sx-notify--unread-notifications))) + mouse-face mode-line-highlight)) + (sx-notify--unread-inbox (sx-notify--unread-notifications "]"))) + "") +(put 'sx-notify--mode-line 'risky-local-variable t) + + +;;; minor-mode definition +(define-minor-mode sx-notify-mode nil nil "sx" nil + (if sx-notify-mode + (add-to-list 'global-mode-string '(t sx-notify--mode-line) 'append) + (setq global-mode-string + (delete '(t sx-notify--mode-line) global-mode-string)))) + + +(provide 'sx-notify) +;;; sx-notify.el ends here + +;; Local Variables: +;; indent-tabs-mode: nil +;; End: -- cgit v1.2.3 From b854489549490a53713f0777ac4c22096920e19f Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Sun, 21 Dec 2014 11:35:42 -0200 Subject: Timer logic --- sx-notify.el | 46 ++++++++++++++++++++++++++++++++++++++++------ 1 file changed, 40 insertions(+), 6 deletions(-) diff --git a/sx-notify.el b/sx-notify.el index bc88ceb..05babad 100644 --- a/sx-notify.el +++ b/sx-notify.el @@ -27,20 +27,28 @@ ;;; mode-line notification -(defvar sx-notify--unread-inbox nil +(defvar sx-notify--unread-inbox nil "List of inbox items still unread.") -(defvar sx-notify--unread-notifications nil +(defvar sx-notify--unread-notifications nil "List of notifications items still unread.") +(defvar sx-notify--read-inbox nil + "List of inbox items which are read. +These are identified by their links.") + +(defvar sx-notify--read-notifications nil + "List of notification items which are read. +These are identified by their links.") + (defvar sx-notify--mode-line - '((sx-notify--unread-inbox (sx-notify--unread-notifications "[")) + '((sx-notify--unread-inbox (sx-notify--unread-notifications " [")) (sx-notify--unread-inbox (:propertize (:eval (format "i:%s" (length sx-notify--unread-inbox))) face mode-line-buffer-id mouse-face mode-line-highlight)) - (sx-notify--unread-inbox (sx-notify--unread-notifications ",")) + (sx-notify--unread-inbox (sx-notify--unread-notifications " ")) (sx-notify--unread-notifications (:propertize (:eval (format "n:%s" (length sx-notify--unread-notifications))) @@ -51,12 +59,38 @@ ;;; minor-mode definition -(define-minor-mode sx-notify-mode nil nil "sx" nil +(defcustom sx-notify-timer-delay (* 60 5) + "Idle time, in seconds, before querying for inbox items." + :type 'integer + :group 'sx-notify) + +(defvar sx-notify--timer nil + "Timer used for fetching notifications.") + +(define-minor-mode sx-notify-mode nil nil nil nil + :global t (if sx-notify-mode - (add-to-list 'global-mode-string '(t sx-notify--mode-line) 'append) + (progn + (add-to-list 'global-mode-string '(t sx-notify--mode-line) 'append) + (setq sx-notify--timer + (run-with-idle-timer sx-notify-timer-delay 'repeat + #'sx-notify--update-unread))) + (when (timerp sx-notify--timer) + (cancel-timer sx-notify--timer) + (setq sx-notify--timer nil)) (setq global-mode-string (delete '(t sx-notify--mode-line) global-mode-string)))) +(defun sx-notify--update-unread () + "Update the lists of unread notifications." + (setq sx-notify--unread-inbox + (cl-remove-if + (lambda (x) (member (cdr (assq 'link x)) sx-notify--read-inbox)) + (append (sx-inbox-get) nil))) + (setq sx-notify--unread-notifications + (cl-remove-if + (lambda (x) (member (cdr (assq 'link x)) sx-notify--read-notifications)) + (append (sx-inbox-get t) nil)))) (provide 'sx-notify) ;;; sx-notify.el ends here -- cgit v1.2.3 From 316829ed9414e96684ba2dd82100426d28d7215f Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Sun, 21 Dec 2014 19:59:50 -0200 Subject: Move unread lists to sx-inbox --- sx-inbox.el | 15 +++++++++++++++ sx-notify.el | 36 +++++++++++------------------------- 2 files changed, 26 insertions(+), 25 deletions(-) diff --git a/sx-inbox.el b/sx-inbox.el index 3bc95c8..9cdb959 100644 --- a/sx-inbox.el +++ b/sx-inbox.el @@ -63,6 +63,21 @@ KEYWORDS are added to the method call along with PAGE. :keywords keywords :filter sx-inbox-filter)) + +;;; Major-mode +(defvar sx-inbox--unread-inbox nil + "List of inbox items still unread.") + +(defvar sx-inbox--unread-notifications nil + "List of notifications items still unread.") + +(defvar sx-inbox--read-inbox nil + "List of inbox items which are read. +These are identified by their links.") + +(defvar sx-inbox--read-notifications nil + "List of notification items which are read. +These are identified by their links.") (provide 'sx-inbox) ;;; sx-inbox.el ends here diff --git a/sx-notify.el b/sx-notify.el index 05babad..c335427 100644 --- a/sx-notify.el +++ b/sx-notify.el @@ -27,33 +27,19 @@ ;;; mode-line notification -(defvar sx-notify--unread-inbox nil - "List of inbox items still unread.") - -(defvar sx-notify--unread-notifications nil - "List of notifications items still unread.") - -(defvar sx-notify--read-inbox nil - "List of inbox items which are read. -These are identified by their links.") - -(defvar sx-notify--read-notifications nil - "List of notification items which are read. -These are identified by their links.") - (defvar sx-notify--mode-line - '((sx-notify--unread-inbox (sx-notify--unread-notifications " [")) - (sx-notify--unread-inbox + '((sx-inbox--unread-inbox (sx-inbox--unread-notifications " [")) + (sx-inbox--unread-inbox (:propertize - (:eval (format "i:%s" (length sx-notify--unread-inbox))) + (:eval (format "i:%s" (length sx-inbox--unread-inbox))) face mode-line-buffer-id mouse-face mode-line-highlight)) - (sx-notify--unread-inbox (sx-notify--unread-notifications " ")) - (sx-notify--unread-notifications + (sx-inbox--unread-inbox (sx-inbox--unread-notifications " ")) + (sx-inbox--unread-notifications (:propertize - (:eval (format "n:%s" (length sx-notify--unread-notifications))) + (:eval (format "n:%s" (length sx-inbox--unread-notifications))) mouse-face mode-line-highlight)) - (sx-notify--unread-inbox (sx-notify--unread-notifications "]"))) + (sx-inbox--unread-inbox (sx-notify--unread-notifications "]"))) "") (put 'sx-notify--mode-line 'risky-local-variable t) @@ -83,13 +69,13 @@ These are identified by their links.") (defun sx-notify--update-unread () "Update the lists of unread notifications." - (setq sx-notify--unread-inbox + (setq sx-inbox--unread-inbox (cl-remove-if - (lambda (x) (member (cdr (assq 'link x)) sx-notify--read-inbox)) + (lambda (x) (member (cdr (assq 'link x)) sx-inbox--read-inbox)) (append (sx-inbox-get) nil))) - (setq sx-notify--unread-notifications + (setq sx-inbox--unread-notifications (cl-remove-if - (lambda (x) (member (cdr (assq 'link x)) sx-notify--read-notifications)) + (lambda (x) (member (cdr (assq 'link x)) sx-inbox--read-notifications)) (append (sx-inbox-get t) nil)))) (provide 'sx-notify) -- cgit v1.2.3 From 7f5c549a9d635bc31e35a9d8f117611fb4a679f8 Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Sun, 21 Dec 2014 20:00:36 -0200 Subject: Initial inbox-mode implementation --- sx-inbox.el | 73 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 73 insertions(+) diff --git a/sx-inbox.el b/sx-inbox.el index 9cdb959..0961564 100644 --- a/sx-inbox.el +++ b/sx-inbox.el @@ -78,6 +78,79 @@ These are identified by their links.") (defvar sx-inbox--read-notifications nil "List of notification items which are read. These are identified by their links.") + +(defvar sx-inbox--header-line + '(" " + (:propertize "n p j k" face mode-line-buffer-id) + ": Navigate" + " " + (:propertize "RET" face mode-line-buffer-id) + ": View" + " " + (:propertize "v" face mode-line-buffer-id) + ": Visit externally" + " " + (:propertize "q" face mode-line-buffer-id) + ": Quit") + "Header-line used on the question list.") + +(define-derived-mode sx-inbox-mode + sx-question-list-mode "Question List" + "Mode used to list inbox and notification items." + (setq sx-question-list--print-function + #'sx-inbox--print-info) + (setq sx-question-list--dataset sx-inbox--unread-inbox) + (setq tabulated-list-format + [("Type" 30 t :right-align t) + ("Date" 10 t :right-align t) + ("Title" 0 sx-inbox--date-more-recent-p)]) + (setq header-line-format sx-inbox--header-line)) + + +;;; Keybinds +(mapc + (lambda (x) (define-key sx-inbox-mode-map + (car x) (cadr x))) + '( + ("t" nil) + ("a" nil) + ("u" nil) + ("d" nil) + ("h" nil) + ("m" sx-inbox-mark-read) + ([?\r] sx-display) + )) + + +;;; print-info +(defun sx-inbox--print-info (data) + "Convert `json-read' DATA into tabulated-list format. + +This is the default printer used by `sx-inbox'. It assumes DATA +is an alist containing the elements: + `answer_id', `body', `comment_id', `creation_date', `is_unread', + `item_type', `link', `question_id', `site', `title'. + +Also see `sx-question-list-refresh'." + (list + data + (sx-assoc-let data + (vector + (list + (concat (capitalize (replace-regexp-in-string "_" " " .item_type)) + (cond + (.answer_id " on Answer at:") + (.question_id " on:")))) + (list (propertize (concat (sx-time-since .last_activity_date) + sx-question-list-ago-string) + 'face 'sx-question-list-date)) + (list + (concat + (propertize " " 'display "\n") + .title + (propertize " " 'display "\n") + .body)))))) + (provide 'sx-inbox) ;;; sx-inbox.el ends here -- cgit v1.2.3 From e313ae05f86ed93dd7731fdb496bdf8b43bbf3e5 Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Sun, 21 Dec 2014 21:34:00 -0200 Subject: Fix filter --- sx-inbox.el | 27 +++++++++++++++------------ 1 file changed, 15 insertions(+), 12 deletions(-) diff --git a/sx-inbox.el b/sx-inbox.el index 0961564..75a3d57 100644 --- a/sx-inbox.el +++ b/sx-inbox.el @@ -19,24 +19,26 @@ ;;; Commentary: - ;;; Code: (require 'sx) (require 'sx-filter) (require 'sx-method) +(require 'sx-question-list) + +;;; API (defvar sx-inbox-filter - '((inbox.answer_id - inbox.body - inbox.comment_id - inbox.creation_date - inbox.is_unread - inbox.item_type - inbox.link - inbox.question_id - inbox.site - inbox.title) + '((inbox_item.answer_id + inbox_item.body + inbox_item.comment_id + inbox_item.creation_date + inbox_item.is_unread + inbox_item.item_type + inbox_item.link + inbox_item.question_id + inbox_item.site + inbox_item.title) (site.logo_url site.audience site.icon_url @@ -44,7 +46,8 @@ site.site_state site.launch_date site.markdown_extensions - site.related_sites)) + site.related_sites + site.styling)) "Filter used when retrieving inbox items.") (defun sx-inbox-get (&optional notifications page keywords) -- cgit v1.2.3 From 5675fc89e2b06b1533cb588368c1ffa4e414d0f4 Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Sun, 21 Dec 2014 21:35:21 -0200 Subject: Fix up the major-mode --- sx-inbox.el | 51 +++++++++++++++++++++++++++------------------------ 1 file changed, 27 insertions(+), 24 deletions(-) diff --git a/sx-inbox.el b/sx-inbox.el index 75a3d57..00e5e9d 100644 --- a/sx-inbox.el +++ b/sx-inbox.el @@ -100,20 +100,18 @@ These are identified by their links.") (define-derived-mode sx-inbox-mode sx-question-list-mode "Question List" "Mode used to list inbox and notification items." - (setq sx-question-list--print-function - #'sx-inbox--print-info) - (setq sx-question-list--dataset sx-inbox--unread-inbox) + (toggle-truncate-lines 1) + (setq fill-column 40) + (setq sx-question-list--print-function #'sx-inbox--print-info) + (setq sx-question-list--dataset (sx-inbox-get)) (setq tabulated-list-format - [("Type" 30 t :right-align t) - ("Date" 10 t :right-align t) - ("Title" 0 sx-inbox--date-more-recent-p)]) - (setq header-line-format sx-inbox--header-line)) + [("Type" 30 t nil t) ("Date" 10 t :right-align t) ("Title" 0)]) + (setq header-line-format sx-inbox--header-line) + (tabulated-list-revert)) ;;; Keybinds -(mapc - (lambda (x) (define-key sx-inbox-mode-map - (car x) (cadr x))) +(mapc (lambda (x) (define-key sx-inbox-mode-map (car x) (cadr x))) '( ("t" nil) ("a" nil) @@ -132,27 +130,32 @@ These are identified by their links.") This is the default printer used by `sx-inbox'. It assumes DATA is an alist containing the elements: `answer_id', `body', `comment_id', `creation_date', `is_unread', - `item_type', `link', `question_id', `site', `title'. - -Also see `sx-question-list-refresh'." + `item_type', `link', `question_id', `site', `title'." (list data (sx-assoc-let data (vector (list (concat (capitalize (replace-regexp-in-string "_" " " .item_type)) - (cond - (.answer_id " on Answer at:") - (.question_id " on:")))) - (list (propertize (concat (sx-time-since .last_activity_date) - sx-question-list-ago-string) - 'face 'sx-question-list-date)) + (cond (.answer_id " on Answer at:") + (.question_id " on:"))) + 'face 'font-lock-keyword-face) + (list + (concat (sx-time-since .creation_date) + sx-question-list-ago-string) + 'face 'sx-question-list-date) (list - (concat - (propertize " " 'display "\n") - .title - (propertize " " 'display "\n") - .body)))))) + (propertize + " " 'display + (concat "\n " .title "\n" + (let ((col fill-column)) + (with-temp-buffer + (setq fill-column col) + (insert " " .body) + (fill-region (point-min) (point-max)) + (propertize (buffer-string) + 'face 'font-lock-function-name-face)))) + 'face 'default)))))) (provide 'sx-inbox) ;;; sx-inbox.el ends here -- cgit v1.2.3 From d51791fb6ae69e3b426f7d598920b4349858908f Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Mon, 22 Dec 2014 11:37:35 -0200 Subject: Refactor .site to .site_par It turns out some api objects do have a site property, except its value is not a string, it is another object. The actual string we've been referring to as .site is the .site.api_site_parameter To avoid conflicts, I've renamed all our uses of .site to .site_par, and sx-assoc-let now makes sure the object has a .site_par value, instead of a .site value (which it may or may not have now, and is the same object that the api refers to as site). --- sx-interaction.el | 18 +++++++++--------- sx-question-list.el | 2 +- sx-question-mode.el | 2 +- sx-question.el | 18 +++++++++--------- sx.el | 9 ++++++--- 5 files changed, 26 insertions(+), 23 deletions(-) diff --git a/sx-interaction.el b/sx-interaction.el index 2768c8d..342ae1c 100644 --- a/sx-interaction.el +++ b/sx-interaction.el @@ -142,10 +142,10 @@ Element can be a question, answer, or comment." (cl-case .type (answer (sx-display-question - (sx-question-get-from-answer .site .id) 'focus)) + (sx-question-get-from-answer .site_par .id) 'focus)) (question (sx-display-question - (sx-question-get-question .site .id) 'focus)))))) + (sx-question-get-question .site_par .id) 'focus)))))) ;;; Displaying @@ -206,7 +206,7 @@ changes." :auth 'warn :url-method "POST" :filter sx-browse-filter - :site .site)))) + :site .site_par)))) ;; The api returns the new DATA. (when (> (length result) 0) (sx--copy-data (elt result 0) data) @@ -247,14 +247,14 @@ TEXT is a string. Interactively, it is read from the minibufer." :auth 'warn :url-method "POST" :filter sx-browse-filter - :site .site + :site .site_par :keywords `((body . ,text))))) ;; The api returns the new DATA. (when (> (length result) 0) (sx--add-comment-to-object (elt result 0) (if .post_id - (sx--get-post .post_type .site .post_id) + (sx--get-post .post_type .site_par .post_id) data)) ;; Display the changes in `data'. (sx--maybe-update-display))))) @@ -287,7 +287,7 @@ ID is an integer." (car (cl-member-if (lambda (x) (sx-assoc-let x (and (equal (or .answer_id .question_id) id) - (equal .site site)))) + (equal .site_par site)))) db)))) (defun sx--add-comment-to-object (comment object) @@ -320,7 +320,7 @@ from context at point." (let ((buffer (current-buffer))) (pop-to-buffer (sx-compose-create - .site data + .site_par data ;; Before send hook (when .comment_id (list #'sx--comment-valid-p)) ;; After send functions @@ -338,7 +338,7 @@ from context at point." (defun sx--interactive-site-prompt () "Query the user for a site." (let ((default (or sx-question-list--site - (sx-assoc-let sx-question-mode--data .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) @@ -372,7 +372,7 @@ context at point. " (sx-assoc-let data (pop-to-buffer (sx-compose-create - .site .question_id nil + .site_par .question_id nil ;; After send functions (list (lambda (_ res) (sx--add-answer-to-question-object diff --git a/sx-question-list.el b/sx-question-list.el index 62ce032..4b6c4ef 100644 --- a/sx-question-list.el +++ b/sx-question-list.el @@ -127,7 +127,7 @@ elements: Also see `sx-question-list-refresh'." (sx-assoc-let question-data (let ((favorite (if (member .question_id - (assoc .site + (assoc .site_par sx-favorites--user-favorite-list)) (if (char-displayable-p ?\x2b26) "\x2b26" "*") " "))) (list diff --git a/sx-question-mode.el b/sx-question-mode.el index a60cf3a..7d61167 100644 --- a/sx-question-mode.el +++ b/sx-question-mode.el @@ -254,7 +254,7 @@ query the api." (if no-update sx-question-mode--data (sx-assoc-let sx-question-mode--data - (sx-question-get-question .site .question_id)))) + (sx-question-get-question .site_par .question_id)))) (goto-char point) (when (equal (selected-window) (get-buffer-window (current-buffer))) diff --git a/sx-question.el b/sx-question.el index 801384a..3fcc438 100644 --- a/sx-question.el +++ b/sx-question.el @@ -94,8 +94,8 @@ If no cache exists for it, initialize one with SITE." "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) - (let ((ql (cdr (assoc .site sx-question--user-read-list)))) + (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))))) @@ -107,14 +107,14 @@ 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) - (let ((site-cell (assoc .site sx-question--user-read-list)) + (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 q-cell) sx-question--user-read-list)) + (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. @@ -149,18 +149,18 @@ If no cache exists for it, initialize one with SITE." (defun sx-question--hidden-p (question) "Non-nil if QUESTION has been hidden." (sx-assoc-let question - (sx-question--ensure-hidden-list .site) - (let ((ql (cdr (assoc .site sx-question--user-hidden-list)))) + (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 sx-question--user-hidden-list))) + (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 .question_id) sx-question--user-hidden-list) + (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). diff --git a/sx.el b/sx.el index cda1acd..78995a8 100644 --- a/sx.el +++ b/sx.el @@ -303,9 +303,12 @@ DATA can also be the link itself." DATA can be a question, answer, comment, or user (or any object with a `link' property)." (when data - (unless (assq 'site data) - (setcdr data (cons (cons 'site (sx--site data)) - (cdr data)))) + (let-alist data + (unless .site_par + (setcdr data (cons (cons 'site_par + (or .site.api_site_parameter + (sx--site data))) + (cdr data))))) data)) (defmacro sx-assoc-let (alist &rest body) -- cgit v1.2.3 From 5493c6f7d1105810e5133e26c838e6d2cfe50055 Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Mon, 22 Dec 2014 11:41:29 -0200 Subject: sx-display-question should only take questions --- sx-interaction.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/sx-interaction.el b/sx-interaction.el index 342ae1c..965a996 100644 --- a/sx-interaction.el +++ b/sx-interaction.el @@ -157,7 +157,7 @@ relevant window. If WINDOW nil, the window is decided by `sx-question-mode-display-buffer-function'." - (interactive (list (sx--data-here) t)) + (interactive (list (sx--data-here 'question) t)) (when (sx-question--mark-read data) (sx--maybe-update-display)) ;; Display the question. -- cgit v1.2.3 From 293aa1850a00dfe42549b7f4b7373057aaaa21d9 Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Mon, 22 Dec 2014 11:53:38 -0200 Subject: Generalize sx-display-question to sx-display --- sx-interaction.el | 20 +++++++++++++++++++- sx-question-list.el | 2 +- 2 files changed, 20 insertions(+), 2 deletions(-) diff --git a/sx-interaction.el b/sx-interaction.el index 965a996..181632e 100644 --- a/sx-interaction.el +++ b/sx-interaction.el @@ -149,9 +149,27 @@ Element can be a question, answer, or comment." ;;; Displaying +(defun sx-display (&optional data) + "Display object given by DATA. +Interactively, display object under point. Object can be a +question, an answer, or an inbox_item. + +This is meant for interactive use. In lisp code, use +object-specific functions such as `sx-display-question' and the +likes." + (interactive (list (sx--data-here) t)) + (sx-assoc-let data + (cond + (.item_type (sx-open-link .link)) + (.answer_id + (sx-display-question + (sx-question-get-from-answer .site_par .id) 'focus)) + (.title + (sx-display-question data 'focus))))) + (defun sx-display-question (&optional data focus window) "Display question given by DATA, on WINDOW. -When DATA is nil, display question under point. When FOCUS is +Interactively, display question under point. When FOCUS is non-nil (the default when called interactively), also focus the relevant window. diff --git a/sx-question-list.el b/sx-question-list.el index 4b6c4ef..4f71251 100644 --- a/sx-question-list.el +++ b/sx-question-list.el @@ -322,7 +322,7 @@ into consideration. ("d" sx-toggle-downvote) ("h" sx-question-list-hide) ("m" sx-question-list-mark-read) - ([?\r] sx-display-question) + ([?\r] sx-display) )) (defun sx-question-list-hide (data) -- cgit v1.2.3 From 431b2bcc4b25cae49a75bfaf6515460507c31634 Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Mon, 22 Dec 2014 12:22:21 -0200 Subject: Further inbox-mode improvements --- sx-inbox.el | 20 ++++++++++++++------ 1 file changed, 14 insertions(+), 6 deletions(-) diff --git a/sx-inbox.el b/sx-inbox.el index 00e5e9d..31fab5d 100644 --- a/sx-inbox.el +++ b/sx-inbox.el @@ -28,7 +28,7 @@ ;;; API -(defvar sx-inbox-filter +(defvar sx-inbox-filter '((inbox_item.answer_id inbox_item.body inbox_item.comment_id @@ -50,6 +50,11 @@ site.styling)) "Filter used when retrieving inbox items.") +(defcustom sx-inbox-fill-column 40 + "`fill-column' used in `sx-inbox-mode'." + :type 'integer + :group 'sx) + (defun sx-inbox-get (&optional notifications page keywords) "Get an array of inbox items for the current user. If NOTIFICATIONS is non-nil, query from `notifications' method, @@ -68,6 +73,10 @@ KEYWORDS are added to the method call along with PAGE. ;;; Major-mode +(defvar sx-inbox--notification-p nil + "If non-nil, current buffer lists notifications, not inbox.") +(make-variable-buffer-local 'sx-inbox--notification-p) + (defvar sx-inbox--unread-inbox nil "List of inbox items still unread.") @@ -101,9 +110,10 @@ These are identified by their links.") sx-question-list-mode "Question List" "Mode used to list inbox and notification items." (toggle-truncate-lines 1) - (setq fill-column 40) + (setq fill-column sx-inbox-fill-column) (setq sx-question-list--print-function #'sx-inbox--print-info) - (setq sx-question-list--dataset (sx-inbox-get)) + (setq sx-question-list--next-page-function + (lambda (page) (sx-inbox-get sx-inbox--notification-p page))) (setq tabulated-list-format [("Type" 30 t nil t) ("Date" 10 t :right-align t) ("Title" 0)]) (setq header-line-format sx-inbox--header-line) @@ -115,8 +125,6 @@ These are identified by their links.") '( ("t" nil) ("a" nil) - ("u" nil) - ("d" nil) ("h" nil) ("m" sx-inbox-mark-read) ([?\r] sx-display) @@ -140,7 +148,7 @@ is an alist containing the elements: (cond (.answer_id " on Answer at:") (.question_id " on:"))) 'face 'font-lock-keyword-face) - (list + (list (concat (sx-time-since .creation_date) sx-question-list-ago-string) 'face 'sx-question-list-date) -- cgit v1.2.3 From 3b950f37f154e58c971b44e6323dcb41f6c53a51 Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Mon, 22 Dec 2014 12:22:30 -0200 Subject: add inbox and notify to sx-load --- sx-load.el | 2 ++ 1 file changed, 2 insertions(+) diff --git a/sx-load.el b/sx-load.el index d71b8ed..481dba3 100644 --- a/sx-load.el +++ b/sx-load.el @@ -31,9 +31,11 @@ sx-encoding sx-favorites sx-filter + sx-inbox sx-interaction sx-method sx-networks + sx-notify sx-question sx-question-list sx-question-mode -- cgit v1.2.3 From 1fbab001d18fc73f14e235106c910131e16433e9 Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Mon, 22 Dec 2014 13:21:20 -0200 Subject: Implement sx-inbox --- sx-inbox.el | 36 +++++++++++++++++++++++++++++++++--- 1 file changed, 33 insertions(+), 3 deletions(-) diff --git a/sx-inbox.el b/sx-inbox.el index 31fab5d..575d181 100644 --- a/sx-inbox.el +++ b/sx-inbox.el @@ -116,8 +116,7 @@ These are identified by their links.") (lambda (page) (sx-inbox-get sx-inbox--notification-p page))) (setq tabulated-list-format [("Type" 30 t nil t) ("Date" 10 t :right-align t) ("Title" 0)]) - (setq header-line-format sx-inbox--header-line) - (tabulated-list-revert)) + (setq header-line-format sx-inbox--header-line)) ;;; Keybinds @@ -144,7 +143,9 @@ is an alist containing the elements: (sx-assoc-let data (vector (list - (concat (capitalize (replace-regexp-in-string "_" " " .item_type)) + (concat (capitalize + (replace-regexp-in-string + "_" " " (or .item_type .notification_type))) (cond (.answer_id " on Answer at:") (.question_id " on:"))) 'face 'font-lock-keyword-face) @@ -165,6 +166,35 @@ is an alist containing the elements: 'face 'font-lock-function-name-face)))) 'face 'default)))))) + +;;; Entry commands +(defvar sx-inbox--buffer nil + "Buffer being used to display inbox.") + +(defun sx-inbox (&optional notifications) + "Display a buffer listing inbox items. +With prefix NOTIFICATIONS, list notifications instead of inbox." + (interactive "P") + (setq sx-inbox--buffer (get-buffer-create "*sx-inbox*")) + (let ((inhibit-read-only t)) + (with-current-buffer sx-inbox--buffer + (erase-buffer) + (sx-inbox-mode) + (setq sx-inbox--notification-p notifications) + (tabulated-list-revert))) + (let ((w (get-buffer-window sx-inbox--buffer))) + (if (window-live-p w) + (select-window w) + (pop-to-buffer sx-inbox--buffer) + (enlarge-window + (- (+ fill-column 4) (window-width)) + 'horizontal)))) + +(defun sx-inbox-notifications () + "Display a buffer listing notification items." + (interactive) + (sx-inbox t)) + (provide 'sx-inbox) ;;; sx-inbox.el ends here -- cgit v1.2.3 From 69f081af1461fb70858a29f7426a758ecc10bafe Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Mon, 22 Dec 2014 13:21:41 -0200 Subject: Viewing and visiting doesn't work on inbox. --- sx-interaction.el | 19 ++++++++++--------- 1 file changed, 10 insertions(+), 9 deletions(-) diff --git a/sx-interaction.el b/sx-interaction.el index 181632e..619f259 100644 --- a/sx-interaction.el +++ b/sx-interaction.el @@ -119,15 +119,14 @@ Interactively, this is specified with a prefix argument. If DATA is a question, also mark it as read." (interactive (list (sx--data-here) current-prefix-arg)) (sx-assoc-let data - (let ((link - (when (stringp .link) - (funcall (if copy-as-kill #'kill-new #'browse-url) - .link)))) + (if (not (stringp .link)) + (sx-message "Nothing to visit here.") + (funcall (if copy-as-kill #'kill-new #'browse-url) .link) (when (and (called-interactively-p 'any) copy-as-kill) - (message "Copied: %S" link))) - (when (and .title (not copy-as-kill)) - (sx-question--mark-read data) - (sx--maybe-update-display)))) + (message "Copied: %S" .link)) + (when (and .title (not copy-as-kill)) + (sx-question--mark-read data) + (sx--maybe-update-display))))) (defun sx-open-link (link) "Visit element given by LINK inside Emacs. @@ -157,9 +156,11 @@ question, an answer, or an inbox_item. This is meant for interactive use. In lisp code, use object-specific functions such as `sx-display-question' and the likes." - (interactive (list (sx--data-here) t)) + (interactive (list (sx--data-here))) (sx-assoc-let data (cond + (.notification_type + (sx-message "Viewing notifications is not yet implemented")) (.item_type (sx-open-link .link)) (.answer_id (sx-display-question -- cgit v1.2.3 From 756d92b9722d4ecebc4f7e223628cf008fb66188 Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Mon, 22 Dec 2014 13:56:36 -0200 Subject: Add mode-line to inbox --- sx-inbox.el | 18 ++++++++++++++++-- 1 file changed, 16 insertions(+), 2 deletions(-) diff --git a/sx-inbox.el b/sx-inbox.el index 575d181..07453d4 100644 --- a/sx-inbox.el +++ b/sx-inbox.el @@ -104,7 +104,16 @@ These are identified by their links.") " " (:propertize "q" face mode-line-buffer-id) ": Quit") - "Header-line used on the question list.") + "Header-line used on the inbox list.") + +(defvar sx-inbox--mode-line + '(" " + (:propertize + (sx-inbox--notification-p + "Notifications" + "Inbox") + face mode-line-buffer-id)) + "Mode-line used on the inbox list.") (define-derived-mode sx-inbox-mode sx-question-list-mode "Question List" @@ -116,7 +125,12 @@ These are identified by their links.") (lambda (page) (sx-inbox-get sx-inbox--notification-p page))) (setq tabulated-list-format [("Type" 30 t nil t) ("Date" 10 t :right-align t) ("Title" 0)]) - (setq header-line-format sx-inbox--header-line)) + (setq mode-line-format sx-inbox--mode-line) + (setq header-line-format sx-inbox--header-line) + ;; @TODO: This will no longer be necessary once we properly + ;; refactor sx-question-list-mode. + (remove-hook 'tabulated-list-revert-hook + #'sx-question-list--update-mode-line t)) ;;; Keybinds -- cgit v1.2.3 From aa9002f4dbf29d6c4e9acb551d4340410bc22e50 Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Mon, 22 Dec 2014 14:03:22 -0200 Subject: Link-to-data creates site_par --- sx.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/sx.el b/sx.el index 78995a8..1b15ad3 100644 --- a/sx.el +++ b/sx.el @@ -323,7 +323,7 @@ If ALIST doesn't have a `site' property, one is created using the (defun sx--link-to-data (link) "Convert string LINK into data that can be displayed." - (let ((result (list (cons 'site (sx--site link))))) + (let ((result (list (cons 'site_par (sx--site link))))) (when (or ;; Answer (and (or (string-match "/a/\\([0-9]+\\)/[0-9]+\\(#.*\\|\\)\\'" link) -- cgit v1.2.3 From 3f71435f4266ab770b296e07df650a8a3bcd3a79 Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Thu, 25 Dec 2014 12:44:04 -0200 Subject: Slight face modifications --- sx-inbox.el | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/sx-inbox.el b/sx-inbox.el index 07453d4..d0be379 100644 --- a/sx-inbox.el +++ b/sx-inbox.el @@ -170,14 +170,13 @@ is an alist containing the elements: (list (propertize " " 'display - (concat "\n " .title "\n" + (concat "\n " (propertize .title 'face 'sx-question-list-date) "\n" (let ((col fill-column)) (with-temp-buffer (setq fill-column col) (insert " " .body) (fill-region (point-min) (point-max)) - (propertize (buffer-string) - 'face 'font-lock-function-name-face)))) + (buffer-string)))) 'face 'default)))))) -- cgit v1.2.3 From 5225bd4ae6e26177a4daf62ddc5e807784e7c46e Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Thu, 25 Dec 2014 12:47:28 -0200 Subject: Fix merge --- sx.el | 9 ++++++--- 1 file changed, 6 insertions(+), 3 deletions(-) diff --git a/sx.el b/sx.el index a31c0a0..79d51f7 100644 --- a/sx.el +++ b/sx.el @@ -69,9 +69,12 @@ DATA can also be the link itself." DATA can be a question, answer, comment, or user (or any object with a `link' property)." (when data - (unless (assq 'site data) - (setcdr data (cons (cons 'site (sx--site data)) - (cdr data)))) + (let-alist data + (unless .site_par + (setcdr data (cons (cons 'site_par + (or .site.api_site_parameter + (sx--site data))) + (cdr data))))) data)) (defmacro sx-assoc-let (alist &rest body) -- cgit v1.2.3 From 93573c854da4c502ccca676c1dd70bf680ab1036 Mon Sep 17 00:00:00 2001 From: Sean Allred Date: Fri, 26 Dec 2014 16:32:03 -0500 Subject: Bump let-alist required version to 1.0.3 Syntax introduced in commits: * d51791fb6ae69e3b426f7d598920b4349858908f * 5225bd4ae6e26177a4daf62ddc5e807784e7c46e --- sx.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/sx.el b/sx.el index 79d51f7..9a5a6a0 100644 --- a/sx.el +++ b/sx.el @@ -6,7 +6,7 @@ ;; URL: https://github.com/vermiculus/sx.el/ ;; Version: 0.1 ;; Keywords: help, hypermedia, tools -;; Package-Requires: ((emacs "24.1") (cl-lib "0.5") (json "1.3") (markdown-mode "2.0") (let-alist "1.0.1")) +;; Package-Requires: ((emacs "24.1") (cl-lib "0.5") (json "1.3") (markdown-mode "2.0") (let-alist "1.0.3")) ;; 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 -- cgit v1.2.3 From 6c20202ad50aeba70290de860bd1f5feb944c955 Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Sat, 27 Dec 2014 15:31:22 -0200 Subject: Don't rely on the new feature. This is to avoid a bug in package.el which only gets fixed in Emacs 25 Unfortunately, there's no safe way to use a new feature offered by a previously defined macro, because files were not reloaded on upgrade. After a couple of weeks, once we can expect most of our users to have restarted Emacs at least once since the last upgrade, we can start relying on this new feature. --- sx.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/sx.el b/sx.el index 9a5a6a0..be37766 100644 --- a/sx.el +++ b/sx.el @@ -72,7 +72,7 @@ with a `link' property)." (let-alist data (unless .site_par (setcdr data (cons (cons 'site_par - (or .site.api_site_parameter + (or (cdr (assq 'api_site_parameter .site)) (sx--site data))) (cdr data))))) data)) -- cgit v1.2.3 From 2012346d11a04f7cd9871fced0df2417b5503336 Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Sat, 27 Dec 2014 22:54:42 -0200 Subject: Explicitly request last_activity_date --- sx.el | 2 ++ 1 file changed, 2 insertions(+) diff --git a/sx.el b/sx.el index 508de46..a63c155 100644 --- a/sx.el +++ b/sx.el @@ -148,6 +148,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 @@ -168,6 +169,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 -- cgit v1.2.3 From c37022ffbc52b900d81eee05f3c2c3d5fe6fee01 Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Sat, 27 Dec 2014 23:06:00 -0200 Subject: Initial implementation of sx-completing-read --- sx-interaction.el | 8 ++++---- sx-question-list.el | 3 +-- sx-tab.el | 8 ++++---- sx.el | 5 +++++ 4 files changed, 14 insertions(+), 10 deletions(-) diff --git a/sx-interaction.el b/sx-interaction.el index 372a5b1..9ced1ab 100644 --- a/sx-interaction.el +++ b/sx-interaction.el @@ -340,10 +340,10 @@ from context at point." (let ((default (or sx-question-list--site (sx-assoc-let sx-question-mode--data .site) 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) diff --git a/sx-question-list.el b/sx-question-list.el index 4bd6478..d84d1ea 100644 --- a/sx-question-list.el +++ b/sx-question-list.el @@ -559,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-tab.el b/sx-tab.el index 6c5e21e..32a7784 100644 --- a/sx-tab.el +++ b/sx-tab.el @@ -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))))) diff --git a/sx.el b/sx.el index a63c155..c2d1164 100644 --- a/sx.el +++ b/sx.el @@ -183,6 +183,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. -- cgit v1.2.3 From 8c2b378b439d24ec7d3f4417c602a1b22e693709 Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Sat, 27 Dec 2014 23:37:55 -0200 Subject: Implement sx--multiple-read for reading multiple strings --- sx.el | 19 +++++++++++++++++++ 1 file changed, 19 insertions(+) diff --git a/sx.el b/sx.el index c2d1164..2824b4d 100644 --- a/sx.el +++ b/sx.el @@ -189,6 +189,25 @@ All ARGS are passed to `completing-read' or `ido-completing-read'." (apply (if ido-mode #'ido-completing-read #'completing-read) args)) +(defun sx--multiple-read (prompt hist-var) + "Interactively query gthe user for a list of strings. +Call `read-string' multiple times, until the input is empty. + +PROMPT is a string displayed to the user. and should not +end with a space nor a colon. +HIST-VAR is a quoted symbol, indicating a list in which to store +input history." + (let (list input) + (while (not (string= + "" + (setq input (read-string + (concat prompt " [" + (mapconcat #'identity list ",") + "]: ") + "" hist-var)))) + (push input list)) + list)) + (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 -- cgit v1.2.3 From c92ed1bbc3df248943834b466bbdd74180649e72 Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Sun, 28 Dec 2014 00:07:10 -0200 Subject: Implement searching with sx-search Fix #16 Fix #20 --- sx-search.el | 112 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 112 insertions(+) create mode 100644 sx-search.el diff --git a/sx-search.el b/sx-search.el new file mode 100644 index 0000000..928db5d --- /dev/null +++ b/sx-search.el @@ -0,0 +1,112 @@ +;;; sx-search.el --- Searching for questions. -*- lexical-binding: t; -*- + +;; Copyright (C) 2014 Artur Malabarba + +;; Author: Artur Malabarba + +;; 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 . + +;;; Commentary: + +;; Implements sarch functionality. The basic function is +;; `sx-search-get-questions', which returns an array of questions +;; according to a search term. +;; +;; This also defines a user-level command, `sx-search', which is an +;; interactive wrapper around `sx-search-get-questions' and +;; `sx-question-list-mode'. + + +;;; Code: + +(require 'sx) +(require 'sx-question-list) + +(defvar sx-search--query-history nil + "Query history for interactive prompts.") + +(defvar sx-search--tag-history nil + "Tags history for interactive prompts.") + + +;;; Basic function +(defun sx-search-get-questions (site page query &optional tags excluded-tags keywords) + "Like `sx-question-get-questions', but restrict results by a search. + +Perform search on SITE. PAGE is an integer indicating which page +of results to return. QUERY, TAGS, and EXCLUDED-TAGS restrict the +possible returned questions as per `sx-search'. + +Either QUERY or TAGS must be non-nil, or the search will +fail. EXCLUDED-TAGS is only is used if TAGS is also provided. + +KEYWORDS is passed to `sx-method-call'." + (sx-method-call 'search + :keywords `((page . ,page) + (sort . activity) + (intitle . ,query) + (tagged . ,tags) + (nottagged . ,excluded-tags) + ,@keywords) + :site site + :auth t + :filter sx-browse-filter)) + + +;;; User command +(defun sx-search (site query &optional tags excluded-tags) + "Display search on SITE for question titles containing QUERY. +When TAGS is given, it is a lists of tags, one of which must +match. When EXCLUDED-TAGS is given, it is a list of tags, none +of which is allowed to match. + +Interactively, the user is asked for SITE and QUERY. With a +prefix argument, the user is asked for everything." + (interactive + (let ((site (sx--interactive-site-prompt)) + (query (read-string + (format "Query (%s): " + (if current-prefix-arg "optional" "mandatory")) + "" + 'sx-search--query-history)) + tags excluded-tags) + (when (string= query "") + (setq query nil)) + (when current-prefix-arg + (setq tags (sx--multiple-read + (format "Tags (%s)" + (if query "optional" "mandatory")) + 'sx-search--tag-history)) + (when (and (not query) (string= "" tags)) + (sx-user-error "Must supply either QUERY or TAGS")) + (setq excluded-tags + (sx--multiple-read + "Excluded tags (optional)" 'sx-search--tag-history))) + (list site query tags excluded-tags))) + + ;; Here starts the actual function + (sx-initialize) + (with-current-buffer (get-buffer-create "*sx-search-result*") + (sx-question-list-mode) + (setq sx-question-list--next-page-function + (lambda (page) + (sx-search-get-questions + sx-question-list--site page + query tags excluded-tags))) + (setq sx-question-list--site site) + (sx-question-list-refresh 'redisplay) + (switch-to-buffer (current-buffer)))) + +(provide 'sx-search) +;;; sx-search.el ends here -- cgit v1.2.3 From 39116611ea99b3b0ba33545d38c2983a17db487d Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Sun, 28 Dec 2014 00:11:02 -0200 Subject: Bind sx-search to s --- sx-question-list.el | 1 + sx-question-mode.el | 1 + 2 files changed, 2 insertions(+) diff --git a/sx-question-list.el b/sx-question-list.el index d84d1ea..0856e2a 100644 --- a/sx-question-list.el +++ b/sx-question-list.el @@ -317,6 +317,7 @@ into consideration. (":" sx-question-list-switch-site) ("t" sx-tab-switch) ("a" sx-ask) + ("s" sx-search) ("v" sx-visit-externally) ("u" sx-toggle-upvote) ("d" sx-toggle-downvote) diff --git a/sx-question-mode.el b/sx-question-mode.el index a60cf3a..05b8984 100644 --- a/sx-question-mode.el +++ b/sx-question-mode.el @@ -231,6 +231,7 @@ Letters do not insert themselves; instead, they are commands. (" " scroll-up-command) ("a" sx-answer) ("e" sx-edit) + ("s" sx-search) (,(kbd "S-SPC") scroll-down-command) ([backspace] scroll-down-command) ([tab] forward-button) -- cgit v1.2.3 From 35b0883d3e551c5cbc4f416082957e977d6e03eb Mon Sep 17 00:00:00 2001 From: Sean Allred Date: Tue, 30 Dec 2014 18:10:39 -0500 Subject: Reapply ef1d321a157e300d29c48e461257897fca1c9aa4 It was somehow lost in the merging. --- sx.el | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/sx.el b/sx.el index 508de46..8fe31ac 100644 --- a/sx.el +++ b/sx.el @@ -136,10 +136,11 @@ with a `link' property)." 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 -- cgit v1.2.3 From 06f7059bffa517d63c72a0815ff0779cfe5e5ce2 Mon Sep 17 00:00:00 2001 From: Sean Allred Date: Tue, 30 Dec 2014 23:07:36 -0500 Subject: Test sx-assoc-let according to functionality See http://emacs.stackexchange.com/q/5915/2264 and #151 for more information. This patch tests for functional equivalence rather than symbolic equivalence. Symbolic equivalence would be far preferable, but it does not appear to be happening anytime soon -- perhaps when things settle down a bit for the authors :) --- test/tests.el | 28 +++++++++++++++------------- 1 file changed, 15 insertions(+), 13 deletions(-) diff --git a/test/tests.el b/test/tests.el index cc58105..3c275fd 100644 --- a/test/tests.el +++ b/test/tests.el @@ -120,19 +120,21 @@ (ert-deftest macro-test--sx-assoc-let () "Tests macro expansion for `sx-assoc-let'" - (should - (equal `(progn (sx--ensure-site data) - ,(macroexpand - '(let-alist data .test))) - (macroexpand - '(sx-assoc-let data .test)))) - (should - (equal `(progn (sx--ensure-site data) - ,(macroexpand - '(let-alist data - (cons .test-one .test-two)))) - (macroexpand - '(sx-assoc-let data (cons .test-one .test-two)))))) + (let ((prototype '((test . nil) (test-one . 1) (test-two . 2) + (link . "http://meta.emacs.stackexchange.com/")))) + (let ((data (copy-tree prototype))) + (should + (null (let-alist data .site)))) + + (let ((data (copy-tree prototype))) + (should + (equal (sx-assoc-let data .site) + "meta.emacs"))) + + (let ((data (copy-tree prototype))) + (should + (equal (sx-assoc-let data (cons .test-one .test-two)) + '(1 . 2)))))) (ert-deftest sx--user-@name () "Tests macro expansion for `sx-assoc-let'" -- cgit v1.2.3 From b8eb3d978109c1d5bf18be8cc1e1678afb6c017a Mon Sep 17 00:00:00 2001 From: Sean Allred Date: Tue, 30 Dec 2014 23:10:01 -0500 Subject: Fix typo --- sx-request.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) 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))))))) -- cgit v1.2.3 From 7217c37a3619c72bce6ac5be97b969a0bb2f03cc Mon Sep 17 00:00:00 2001 From: Sean Allred Date: Thu, 1 Jan 2015 12:05:04 -0500 Subject: Split tests into separate files --- test/test-api.el | 13 ++++ test/test-macros.el | 18 +++++ test/test-printing.el | 45 +++++++++++++ test/test-util.el | 66 +++++++++++++++++++ test/tests.el | 179 ++++++++------------------------------------------ 5 files changed, 169 insertions(+), 152 deletions(-) create mode 100644 test/test-api.el create mode 100644 test/test-macros.el create mode 100644 test/test-printing.el create mode 100644 test/test-util.el 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..6a1910c --- /dev/null +++ b/test/test-macros.el @@ -0,0 +1,18 @@ +(ert-deftest macro-test--sx-assoc-let () + "Tests macro expansion for `sx-assoc-let'" + (let ((prototype '((test . nil) (test-one . 1) (test-two . 2) + (link . "http://meta.emacs.stackexchange.com/")))) + (let ((data (copy-tree prototype))) + (should + (null (let-alist data .site)))) + + (let ((data (copy-tree prototype))) + (should + (equal (sx-assoc-let data .site) + "meta.emacs"))) + + (let ((data (copy-tree prototype))) + (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..4fe31db --- /dev/null +++ b/test/test-printing.el @@ -0,0 +1,45 @@ + +;;; Setup +(require 'cl-lib) + +(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)))) + + +;;; Tests +(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\\]"))) + +(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"))) + diff --git a/test/test-util.el b/test/test-util.el new file mode 100644 index 0000000..53dc200 --- /dev/null +++ b/test/test-util.el @@ -0,0 +1,66 @@ +(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)))) + + ;; 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))))) + +(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"))) diff --git a/test/tests.el b/test/tests.el index 3c275fd..daaa8b5 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,161 +28,28 @@ (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" '(())))) - -(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)))) - - ;; 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))))) - -(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\\]"))) - -(ert-deftest macro-test--sx-assoc-let () - "Tests macro expansion for `sx-assoc-let'" - (let ((prototype '((test . nil) (test-one . 1) (test-two . 2) - (link . "http://meta.emacs.stackexchange.com/")))) - (let ((data (copy-tree prototype))) - (should - (null (let-alist data .site)))) + +;;; General Settings +(setq + package-user-dir (expand-file-name + (format "../../.cask/%s/elpa" emacs-version) + sx-test-data-dir)) - (let ((data (copy-tree prototype))) - (should - (equal (sx-assoc-let data .site) - "meta.emacs"))) +(package-initialize) - (let ((data (copy-tree prototype))) - (should - (equal (sx-assoc-let data (cons .test-one .test-two)) - '(1 . 2)))))) +(require 'sx-load) -(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-load-test (test) + (load-file + (format "%s/test-%s.el" + sx-test-base-dir + (symbol-name test)))) -(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)) -- cgit v1.2.3 From 9469287080501f3e3c7ce0002d837664a1b9b91e Mon Sep 17 00:00:00 2001 From: Sean Allred Date: Thu, 1 Jan 2015 13:15:20 -0500 Subject: Use test fixture for sample data See (info "(ert) Fixtures and Test Suites"). --- test/test-macros.el | 31 +++++++++++++++++-------------- 1 file changed, 17 insertions(+), 14 deletions(-) diff --git a/test/test-macros.el b/test/test-macros.el index 6a1910c..8bdd527 100644 --- a/test/test-macros.el +++ b/test/test-macros.el @@ -1,18 +1,21 @@ +(defmacro sx-test-with-json-data (cell &rest body) + (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 () "Tests macro expansion for `sx-assoc-let'" - (let ((prototype '((test . nil) (test-one . 1) (test-two . 2) - (link . "http://meta.emacs.stackexchange.com/")))) - (let ((data (copy-tree prototype))) - (should - (null (let-alist data .site)))) - - (let ((data (copy-tree prototype))) - (should - (equal (sx-assoc-let data .site) - "meta.emacs"))) + (sx-test-with-json-data data + (should + (null (let-alist data .site)))) - (let ((data (copy-tree prototype))) - (should - (equal (sx-assoc-let data (cons .test-one .test-two)) - '(1 . 2)))))) + (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))))) -- cgit v1.2.3 From eed71f7024169c2d400ef5d0a84595d186c81bb0 Mon Sep 17 00:00:00 2001 From: Sean Allred Date: Thu, 1 Jan 2015 13:51:22 -0500 Subject: Simplify question list display tests Use a macro (using `rx') to create the regular expression for the question list display test. --- test/test-printing.el | 24 +++++++++++++++++++++--- 1 file changed, 21 insertions(+), 3 deletions(-) diff --git a/test/test-printing.el b/test/test-printing.el index 4fe31db..0ea5b03 100644 --- a/test/test-printing.el +++ b/test/test-printing.el @@ -10,6 +10,18 @@ (message "Line here is: %S" line) (should (string-match ,regexp line)))) +(defmacro question-list-regex (title votes answers &rest tags) + `(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-display () @@ -20,17 +32,23 @@ (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\\]") + (question-list-regex + "Focus-hook: attenuate colours when losing focus" + 1 0 "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\\]") + (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 - "^\\s-+2\\s-+1\\s-+"Making tag completion table" Freezes/Blocks -- how to disable [ 0-9]+\\(y\\|d\\|h\\|mo?\\|s\\) ago\\s-+\\[autocomplete\\]"))) + (question-list-regex + ""Making tag completion table" Freezes/Blocks -- how to disable" + 2 1 "autocomplete" "performance" "ctags")))) (ert-deftest sx--user-@name () "Tests macro expansion for `sx-assoc-let'" -- cgit v1.2.3 From 6376a70f9d70f711723e144ea787cd0a79f7cd7b Mon Sep 17 00:00:00 2001 From: Sean Allred Date: Thu, 1 Jan 2015 14:09:02 -0500 Subject: Docstrings for tests --- test/test-macros.el | 11 ++++++----- test/test-printing.el | 7 +++++-- test/test-util.el | 4 ++-- 3 files changed, 13 insertions(+), 9 deletions(-) diff --git a/test/test-macros.el b/test/test-macros.el index 8bdd527..2169088 100644 --- a/test/test-macros.el +++ b/test/test-macros.el @@ -1,11 +1,12 @@ (defmacro sx-test-with-json-data (cell &rest body) - (declare (indent 1)) - `(let ((,cell '((test . nil) (test-one . 1) (test-two . 2) - (link . "http://meta.emacs.stackexchange.com/")))) - ,@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 () - "Tests macro expansion for `sx-assoc-let'" + "Test `sx-assoc-let'" (sx-test-with-json-data data (should (null (let-alist data .site)))) diff --git a/test/test-printing.el b/test/test-printing.el index 0ea5b03..2260a00 100644 --- a/test/test-printing.el +++ b/test/test-printing.el @@ -3,7 +3,7 @@ (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)))) @@ -11,6 +11,9 @@ (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) @@ -51,7 +54,7 @@ 2 1 "autocomplete" "performance" "ctags")))) (ert-deftest sx--user-@name () - "Tests macro expansion for `sx-assoc-let'" + "Test macro expansion for `sx-assoc-let'" (should (string= (sx--user-@name '((display_name . "ĥÞßđłřğĝýÿñńśşšŝżźžçćčĉùúûüŭůòóôõöøőðìíîïıèéêëęàåáâäãåąĵ★"))) diff --git a/test/test-util.el b/test/test-util.el index 53dc200..49df274 100644 --- a/test/test-util.el +++ b/test/test-util.el @@ -1,5 +1,5 @@ (ert-deftest test-tree-filter () - "`sx-core-filter-data'" + "Test `sx-core-filter-data'" ;; flat (should (equal @@ -34,7 +34,7 @@ '(1 2 3))))) (ert-deftest thing-as-string () - "Tests `sx--thing-as-string'" + "Test `sx--thing-as-string'" (should (string= (sx--thing-as-string '(hello world (this is a test)) -- cgit v1.2.3 From 1518cee93ef2d33af9ddf214ae1c181d02c7b94f Mon Sep 17 00:00:00 2001 From: Sean Allred Date: Thu, 1 Jan 2015 14:14:05 -0500 Subject: Add toggle for detailed test messages --- test/test-printing.el | 9 ++++++++- test/tests.el | 6 ++++++ 2 files changed, 14 insertions(+), 1 deletion(-) diff --git a/test/test-printing.el b/test/test-printing.el index 2260a00..6225bf6 100644 --- a/test/test-printing.el +++ b/test/test-printing.el @@ -7,7 +7,7 @@ `(let ((line (buffer-substring-no-properties (line-beginning-position) (line-end-position)))) - (message "Line here is: %S" line) + (sx-test-message "Line here is: %S" line) (should (string-match ,regexp line)))) (defmacro question-list-regex (title votes answers &rest tags) @@ -27,6 +27,13 @@ after being run through `sx-question--tag-format'." ;;; 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))) diff --git a/test/tests.el b/test/tests.el index daaa8b5..d709600 100644 --- a/test/tests.el +++ b/test/tests.el @@ -51,5 +51,11 @@ sx-test-base-dir (symbol-name test)))) +(setq sx-test-enable-messages nil) + +(defun sx-test-message (message &rest args) + (when sx-test-enable-messages + (apply #'message (cons message args)))) + (mapc #'sx-load-test '(api macros printing util)) -- cgit v1.2.3 From 7d73bc8b9da4a093b0a3b477da81252d5b805ca5 Mon Sep 17 00:00:00 2001 From: Sean Allred Date: Thu, 1 Jan 2015 14:19:58 -0500 Subject: Prune sx--filter-data --- sx.el | 44 -------------------------------------------- test/test-util.el | 35 ----------------------------------- 2 files changed, 79 deletions(-) diff --git a/sx.el b/sx.el index 8fe31ac..73d1a40 100644 --- a/sx.el +++ b/sx.el @@ -239,50 +239,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 \"...\". diff --git a/test/test-util.el b/test/test-util.el index 49df274..5db1691 100644 --- a/test/test-util.el +++ b/test/test-util.el @@ -1,38 +1,3 @@ -(ert-deftest test-tree-filter () - "Test `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)))) - - ;; 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))))) - (ert-deftest thing-as-string () "Test `sx--thing-as-string'" (should -- cgit v1.2.3 From b4ac5e67f55147db98e17f9e2df8d7e044b6bcdf Mon Sep 17 00:00:00 2001 From: Sean Allred Date: Thu, 1 Jan 2015 17:07:38 -0500 Subject: Remove redundant consing --- test/tests.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/test/tests.el b/test/tests.el index d709600..53e053f 100644 --- a/test/tests.el +++ b/test/tests.el @@ -55,7 +55,7 @@ (defun sx-test-message (message &rest args) (when sx-test-enable-messages - (apply #'message (cons message args)))) + (apply #'message message args))) (mapc #'sx-load-test '(api macros printing util)) -- cgit v1.2.3 From bf4f193a76100917764f249023f4844a2ca15b2c Mon Sep 17 00:00:00 2001 From: Sean Allred Date: Thu, 1 Jan 2015 19:01:36 -0500 Subject: Fix docstring --- test/test-printing.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/test/test-printing.el b/test/test-printing.el index 6225bf6..2857cb7 100644 --- a/test/test-printing.el +++ b/test/test-printing.el @@ -61,7 +61,7 @@ after being run through `sx-question--tag-format'." 2 1 "autocomplete" "performance" "ctags")))) (ert-deftest sx--user-@name () - "Test macro expansion for `sx-assoc-let'" + "Test `sx--user-@name' character substitution" (should (string= (sx--user-@name '((display_name . "ĥÞßđłřğĝýÿñńśşšŝżźžçćčĉùúûüŭůòóôõöøőðìíîïıèéêëęàåáâäãåąĵ★"))) -- cgit v1.2.3 From cad44329de7679158dee78e25aeb068c0724770b Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Thu, 1 Jan 2015 22:26:22 -0200 Subject: Add TODO reminder --- sx.el | 2 ++ 1 file changed, 2 insertions(+) diff --git a/sx.el b/sx.el index 151255e..e2ea914 100644 --- a/sx.el +++ b/sx.el @@ -80,6 +80,8 @@ with a `link' property)." (when data (let-alist data (unless .site_par + ;; @TODO: Change this to .site.api_site_parameter sometime + ;; after February. (setcdr data (cons (cons 'site_par (or (cdr (assq 'api_site_parameter .site)) (sx--site data))) -- cgit v1.2.3 From 5ac68096b4a1d97667f181daad4d0c43ead910d4 Mon Sep 17 00:00:00 2001 From: Sean Allred Date: Thu, 1 Jan 2015 23:03:07 -0500 Subject: Add sx-search to sx-load --- sx-load.el | 1 + 1 file changed, 1 insertion(+) diff --git a/sx-load.el b/sx-load.el index d71b8ed..465d504 100644 --- a/sx-load.el +++ b/sx-load.el @@ -39,6 +39,7 @@ sx-question-mode sx-question-print sx-request + sx-search sx-site sx-tab )) -- cgit v1.2.3 From 8b5e430d385db04b21b917bb62935e8266819e38 Mon Sep 17 00:00:00 2001 From: Sean Allred Date: Thu, 1 Jan 2015 23:13:17 -0500 Subject: Add tests for search functionality --- test/test-search.el | 53 +++++++++++++++++++++++++++++++++++++++++++++++++++++ test/tests.el | 2 +- 2 files changed, 54 insertions(+), 1 deletion(-) create mode 100644 test/test-search.el diff --git a/test/test-search.el b/test/test-search.el new file mode 100644 index 0000000..72dbcdc --- /dev/null +++ b/test/test-search.el @@ -0,0 +1,53 @@ +(defmacro test-with-bogus-string (cell &rest body) + "Let-bind a bogus string to CELL and execute BODY." + (declare (indent 1)) + `(let ((,cell "E7631BCF-A94B-4507-8F0C-02CFB3207F55")) + ,@body)) + + +(ert-deftest test-search-basic () + "Test basic search functionality" + (should + (sx-search-get-questions + "emacs" 1 "emacs"))) + +(ert-deftest test-search-empty () + "Test bogus search returns empty vector" + (test-with-bogus-string query + (should + (equal + [] + (sx-search-get-questions "emacs" 1 query))))) + +(ert-deftest test-search-invalid () + "Test invalid search" + (should-error + ;; @todo: test the interactive call + (sx-search + "emacs" nil nil ["emacs"]))) + +(ert-deftest test-search-full-page () + "Test retrieval of the full search page" + (should + (= 30 (length (sx-search-get-questions + "stackoverflow" 1 "jquery"))))) + +(ert-deftest test-search-exclude-tags () + "Test excluding tags from a search" + (should + (cl-every + (lambda (p) + (sx-assoc-let p + (not (member "org-export" .tags)))) + (sx-search-get-questions + "emacs" 1 nil "org-mode" "org-export"))) + (should + (cl-every + (lambda (p) + (sx-assoc-let p + (not (or (member "org-export" .tags) + (member "org-agenda" .tags))))) + (sx-search-get-questions + "emacs" 1 nil "org-mode" + ["org-export" "org-agenda"])))) + diff --git a/test/tests.el b/test/tests.el index 53e053f..d06c0ff 100644 --- a/test/tests.el +++ b/test/tests.el @@ -58,4 +58,4 @@ (apply #'message message args))) (mapc #'sx-load-test - '(api macros printing util)) + '(api macros printing util search)) -- cgit v1.2.3 From 80541f53ab81695f5878055ac4404ee212766b11 Mon Sep 17 00:00:00 2001 From: Sean Allred Date: Thu, 1 Jan 2015 23:20:34 -0500 Subject: Checkdoc --- sx.el | 18 +++++++++--------- 1 file changed, 9 insertions(+), 9 deletions(-) diff --git a/sx.el b/sx.el index b31b22f..e6215b4 100644 --- a/sx.el +++ b/sx.el @@ -74,7 +74,7 @@ DATA can also be the link itself." "\\1\\2" link)))) (defun sx--ensure-site (data) - "Add a `site' property to DATA if it doesn't have one. Return DATA. + "Add a `site' property to DATA if it doesn't have one. Return DATA. DATA can be a question, answer, comment, or user (or any object with a `link' property)." (when data @@ -132,8 +132,9 @@ with a `link' property)." 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 + "Use ALIST with `let-alist' to execute BODY. +`.site' has a special meaning, thanks to `sx--ensure-site'. If +ALIST doesn't have a `site' property, one is created using the `link' property." (declare (indent 1) (debug t)) (require 'let-alist) @@ -191,13 +192,12 @@ All ARGS are passed to `completing-read' or `ido-completing-read'." args)) (defun sx--multiple-read (prompt hist-var) - "Interactively query gthe user for a list of strings. + "Interactively query the user for a list of strings. Call `read-string' multiple times, until the input is empty. -PROMPT is a string displayed to the user. and should not -end with a space nor a colon. -HIST-VAR is a quoted symbol, indicating a list in which to store -input history." +PROMPT is a string displayed to the user and should not end with +a space nor a colon. HIST-VAR is a quoted symbol, indicating a +list in which to store input history." (let (list input) (while (not (string= "" @@ -336,7 +336,7 @@ Return the result of BODY." ("ĥ" . "h") ("ĵ" . "j") ("^[:ascii:]" . "")) - "List of replacements to use for non-ascii characters + "List of replacements to use for non-ascii characters. Used to convert user names into @mentions.") (defun sx--user-@name (user) -- cgit v1.2.3 From b87903a14b5b6da5b847ed64de34df00971cbb4a Mon Sep 17 00:00:00 2001 From: Sean Allred Date: Fri, 2 Jan 2015 09:00:27 -0500 Subject: Introduce convencience function for site prompting Arose from comment discussion at [1]. This function allows for simplified syntax when the use case wants to retrieve a site token in an interactive context. See docstring for details. [1]: https://github.com/vermiculus/sx.el/pull/183/files#r22403919 --- sx-interaction.el | 12 ++++++++++++ sx-search.el | 2 +- 2 files changed, 13 insertions(+), 1 deletion(-) diff --git a/sx-interaction.el b/sx-interaction.el index 9ced1ab..d814485 100644 --- a/sx-interaction.el +++ b/sx-interaction.el @@ -345,6 +345,18 @@ from context at point." (sx-site-get-api-tokens) nil t nil nil default))) +(defun sx--maybe-site-prompt (arg) + "Get a site token conditionally in an interactive context. +If PREFIX-ARG is non-nil, use `sx--interactive-site-prompt'. +Otherwise, use `sx-question-list--site' if non-nil. If nil, +use `sx--interactive-site-prompt' anyway." + ;; This could eventually be generalized into (sx--maybe-prompt + ;; prefix-arg value-if-non-nil #'prompt-function). + (if arg + (sx--interactive-site-prompt) + (or sx-question-list--site + (sx--interactive-site-prompt)))) + ;;;###autoload (defun sx-ask (site) "Start composing a question for SITE. diff --git a/sx-search.el b/sx-search.el index 928db5d..2633da9 100644 --- a/sx-search.el +++ b/sx-search.el @@ -74,7 +74,7 @@ of which is allowed to match. Interactively, the user is asked for SITE and QUERY. With a prefix argument, the user is asked for everything." (interactive - (let ((site (sx--interactive-site-prompt)) + (let ((site (sx--maybe-site-prompt current-prefix-arg)) (query (read-string (format "Query (%s): " (if current-prefix-arg "optional" "mandatory")) -- cgit v1.2.3 From 57a784d6810ab19771db46d9339b73ab27240b87 Mon Sep 17 00:00:00 2001 From: Sean Allred Date: Fri, 2 Jan 2015 10:54:26 -0500 Subject: Fix bad docstring Branch: search --- sx-interaction.el | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/sx-interaction.el b/sx-interaction.el index d814485..be9d664 100644 --- a/sx-interaction.el +++ b/sx-interaction.el @@ -347,9 +347,9 @@ from context at point." (defun sx--maybe-site-prompt (arg) "Get a site token conditionally in an interactive context. -If PREFIX-ARG is non-nil, use `sx--interactive-site-prompt'. -Otherwise, use `sx-question-list--site' if non-nil. If nil, -use `sx--interactive-site-prompt' anyway." +If ARG is non-nil, use `sx--interactive-site-prompt'. +Otherwise, use `sx-question-list--site' if non-nil. +If nil, use `sx--interactive-site-prompt' anyway." ;; This could eventually be generalized into (sx--maybe-prompt ;; prefix-arg value-if-non-nil #'prompt-function). (if arg -- cgit v1.2.3 From a11be51a7aa5ea26e3d55383d328a0624b924125 Mon Sep 17 00:00:00 2001 From: Sean Allred Date: Fri, 2 Jan 2015 12:02:27 -0500 Subject: Use .site_par in tests In accordance with d51791fb6ae69e3b426f7d598920b4349858908f --- test/test-macros.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/test/test-macros.el b/test/test-macros.el index 2169088..b6bf20b 100644 --- a/test/test-macros.el +++ b/test/test-macros.el @@ -9,11 +9,11 @@ "Test `sx-assoc-let'" (sx-test-with-json-data data (should - (null (let-alist data .site)))) + (null (let-alist data .site_par)))) (sx-test-with-json-data data (should - (equal (sx-assoc-let data .site) + (equal (sx-assoc-let data .site_par) "meta.emacs"))) (sx-test-with-json-data data -- cgit v1.2.3 From 0325369632523a81e4246533e4067ebd57f7a0e7 Mon Sep 17 00:00:00 2001 From: Sean Allred Date: Fri, 2 Jan 2015 12:09:06 -0500 Subject: Fix docstring Branch: search --- sx.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/sx.el b/sx.el index 2605f27..62484b7 100644 --- a/sx.el +++ b/sx.el @@ -138,8 +138,8 @@ with a `link' property)." (defmacro sx-assoc-let (alist &rest body) "Use ALIST with `let-alist' to execute BODY. -`.site' has a special meaning, thanks to `sx--ensure-site'. If -ALIST doesn't have a `site' property, one is created using the +`.site_par' has a special meaning, thanks to `sx--ensure-site'. +If ALIST doesn't have a `site' property, one is created using the `link' property." (declare (indent 1) (debug t)) (require 'let-alist) -- cgit v1.2.3