From 952692774707d7730eb1501d6e62cedf42572d77 Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Wed, 3 Dec 2014 20:53:02 +0000 Subject: Highlight names with .-_ --- 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 eb79a7a..87255d7 100644 --- a/sx-question-print.el +++ b/sx-question-print.el @@ -352,7 +352,7 @@ E.g.: (font-lock-add-keywords ;; Highlight usernames. nil `((,(rx (or blank line-start) - (group-n 1 (and "@" (1+ (or (syntax word) (syntax symbol))))) + (group-n 1 (and "@" (1+ (or (syntax word) (syntax symbol) (any ".-_"))))) symbol-end) 1 font-lock-builtin-face))) ;; Everything. -- cgit v1.2.3 From 36e2c98f7c4b325ec5a4108b907f14ca77685fea Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Wed, 3 Dec 2014 23:51:15 +0000 Subject: Take any non-space --- 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 87255d7..11a3e11 100644 --- a/sx-question-print.el +++ b/sx-question-print.el @@ -352,7 +352,7 @@ E.g.: (font-lock-add-keywords ;; Highlight usernames. nil `((,(rx (or blank line-start) - (group-n 1 (and "@" (1+ (or (syntax word) (syntax symbol) (any ".-_"))))) + (group-n 1 (and "@" (1+ (not space)))) symbol-end) 1 font-lock-builtin-face))) ;; Everything. -- cgit v1.2.3 From 847e0a0b1c177d311f54905115bc77aa73c0adf0 Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Thu, 4 Dec 2014 13:39:17 +0000 Subject: Understand non-ascii when handling @name --- sx.el | 38 ++++++++++++++++++++++++++++++++++++-- 1 file changed, 36 insertions(+), 2 deletions(-) diff --git a/sx.el b/sx.el index 431643c..1c0ae9f 100644 --- a/sx.el +++ b/sx.el @@ -251,14 +251,48 @@ Return the result of BODY." (push ov sx--overlays)) result)) +(defvar sx--ascii-replacement-list + '(("[:space:]" . "") + ("àåáâäãåą" . "a") + ("èéêëę" . "e") + ("ìíîïı" . "i") + ("òóôõöøőð" . "o") + ("ùúûüŭů" . "u") + ("çćčĉ" . "c") + ("żźž" . "z") + ("śşšŝ" . "s") + ("ñń" . "n") + ("ýÿ" . "y") + ("ğĝ" . "g") + ("ř" . "r") + ("ł" . "l") + ("đ" . "d") + ("ß" . "ss") + ("Þ" . "th") + ("ĥ" . "h") + ("ĵ" . "j") + ("^[:ascii:]" . "")) + "List of replacements to use for non-ascii characters +Used to convert user names into @mentions.") + (defun sx--user-@name (user) "Get the `display_name' of USER prepended with @. In order to correctly @mention the user, all whitespace is removed from the display name before it is returned." (sx-assoc-let user (when (stringp .display_name) - (concat "@" (replace-regexp-in-string - "[[:space:]]" "" .display_name))))) + (concat "@" (sx--recursive-replace + sx--ascii-replacement-list .display_name))))) + +(defun sx--recursive-replace (alist string) + "Replace each car of ALIST with its cdr in STRING." + (if alist + (sx--recursive-replace + (cdr alist) + (let ((kar (car alist))) + (replace-regexp-in-string + (format "[%s]" (car kar)) (cdr kar) string))) + string)) ;;; Assoc-let -- cgit v1.2.3 From 2651764450b76bd6573cfea2b98f54beeae4f0f1 Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Thu, 4 Dec 2014 13:39:37 +0000 Subject: Define test for sx--user-@name Source of the replacements: http://stackapps.com/a/5022/3776 --- test/tests.el | 11 +++++++++++ 1 file changed, 11 insertions(+) diff --git a/test/tests.el b/test/tests.el index 75238fe..56a5501 100644 --- a/test/tests.el +++ b/test/tests.el @@ -133,3 +133,14 @@ (macroexpand '(sx-assoc-let data (cons .test-one .test-two)))))) + +(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"))) -- cgit v1.2.3 From a9dc66a6fc3a9d6e8cbf2a15601aea3510052679 Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Fri, 5 Dec 2014 18:01:14 +0000 Subject: Cleanup whitespace --- sx-compose.el | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/sx-compose.el b/sx-compose.el index d7d3ff3..4560c15 100644 --- a/sx-compose.el +++ b/sx-compose.el @@ -43,7 +43,7 @@ ;;; Faces and Variables -(defvar sx-compose-before-send-hook nil +(defvar sx-compose-before-send-hook nil "Hook run before POSTing to the API. Functions are called without arguments and should return non-nil. @@ -54,7 +54,7 @@ notifying the user. Current buffer is the compose-mode buffer whose content is about to be POSTed.") -(defvar sx-compose-after-send-functions nil +(defvar sx-compose-after-send-functions nil "Hook run after POSTing to the API. Functions on this hook should take two arguments, the `sx-compose-mode' buffer (which not be live) and the data @@ -129,9 +129,9 @@ contents to the API, then calls `sx-compose-after-send-functions'." ;;; Functions to help preparing buffers (defun sx-compose-create (site parent &optional before-functions after-functions) "Create an `sx-compose-mode' buffer. -SITE is the site where it will be posted. +SITE is the site where it will be posted. -If composing questions, PARENT is nil. +If composing questions, PARENT is nil. If composing answers, it is the `question_id'. If editing answers or questions, it should be the alist data related to that object. @@ -194,7 +194,7 @@ other keywords are read from the header " `(,@(when is-question (let ((inhibit-point-motion-hooks t) (inhibit-read-only t) - (header-end + (header-end (next-single-property-change (point-min) 'sx-compose-separator)) keywords) -- cgit v1.2.3 From 307895c5533636c9e1380dd55b38309f8dba702f Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Fri, 5 Dec 2014 18:01:35 +0000 Subject: Fix bug when editing questions --- sx-compose.el | 40 ++++++++++++++++++++++++++++------------ 1 file changed, 28 insertions(+), 12 deletions(-) diff --git a/sx-compose.el b/sx-compose.el index 4560c15..d8f3b23 100644 --- a/sx-compose.el +++ b/sx-compose.el @@ -70,12 +70,15 @@ Is invoked between `sx-compose-before-send-hook' and (defvar sx-compose--question-headers (concat #("Title: " 0 7 (intangible t read-only t rear-nonsticky t)) + "%s" #("\n" 0 1 (read-only t)) #("Tags : " 0 7 (read-only t intangible t rear-nonsticky t)) + "%s" #("\n" 0 1 (read-only t rear-nonsticky t)) - #("________________________________________\n\n" - 0 42 (read-only t rear-nonsticky t intangible t - sx-compose-separator t))) + #("________________________________________\n" + 0 41 (read-only t rear-nonsticky t intangible t + sx-compose-separator t)) + "\n") "Headers inserted when composing a new question. Used by `sx-compose-create'.") @@ -172,19 +175,32 @@ respectively added locally to `sx-compose-before-send-hook' and (add-hook 'sx-compose-after-send-functions it nil t)) ;; If the buffer is empty, the draft didn't exist. So prepare the ;; question. - (when (and is-question (string= (buffer-string) "")) - (let ((inhibit-point-motion-hooks)) - (insert sx-compose--question-headers) - (goto-char (point-min)) - (goto-char (line-end-position)))) - (when (consp parent) - (when (or (string= (buffer-string) "") - (y-or-n-p "Draft buffer exists. Reset it? ")) + (when (or (string= (buffer-string) "") + (y-or-n-p "Draft buffer exists. Reset it? ")) + (let ((inhibit-point-motion-hooks t) + (inhibit-read-only t)) (erase-buffer) - (insert (cdr (assoc 'body_markdown parent))))) + (when (consp parent) + (insert (cdr (assoc 'body_markdown parent)))) + (when is-question + (sx-compose--print-question-headers + (when (consp parent) parent)) + (unless (consp parent) + (goto-char (point-min)) + (goto-char (line-end-position)))))) ;; Return the buffer (current-buffer)))) +(defun sx-compose--print-question-headers (question) + "Print question headers for the compose buffer. +If QUESTION is non-nil, fill the headers with the data from +QUESTION." + (sx-assoc-let question + (goto-char (point-min)) + (insert + (format sx-compose--question-headers + (or .title "") (mapconcat #'identity .tags " "))))) + (defun sx-compose--generate-keywords (is-question) "Reading current buffer, generate a keywords alist. Keywords meant to be used in `sx-method-call'. -- cgit v1.2.3 From d06afce72182573c7ec1834c866fc39213c151cc Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Sat, 6 Dec 2014 18:04:56 +0000 Subject: Improve some header comments. --- sx-filter.el | 2 +- sx-method.el | 2 +- sx-question-mode.el | 2 +- sx-question-print.el | 2 +- sx-question.el | 2 +- sx-request.el | 2 +- 6 files changed, 6 insertions(+), 6 deletions(-) diff --git a/sx-filter.el b/sx-filter.el index 38084b9..8c00c12 100644 --- a/sx-filter.el +++ b/sx-filter.el @@ -1,4 +1,4 @@ -;;; sx-filter.el --- filters -*- lexical-binding: t; -*- +;;; sx-filter.el --- Handles retrieval of filters. -*- lexical-binding: t; -*- ;; Copyright (C) 2014 Sean Allred diff --git a/sx-method.el b/sx-method.el index 83455b8..5646772 100644 --- a/sx-method.el +++ b/sx-method.el @@ -1,4 +1,4 @@ -;;; sx-method.el --- method calls +;;; sx-method.el --- Main interface for API method calls. -*- lexical-binding: t; -*- ;; Copyright (C) 2014 Sean Allred diff --git a/sx-question-mode.el b/sx-question-mode.el index bccb658..ccd9433 100644 --- a/sx-question-mode.el +++ b/sx-question-mode.el @@ -1,4 +1,4 @@ -;;; sx-question-mode.el --- Creating the buffer that displays questions +;;; sx-question-mode.el --- Major-mode for displaying a question. -*- lexical-binding: t; -*- ;; Copyright (C) 2014 Artur Malabarba diff --git a/sx-question-print.el b/sx-question-print.el index eb79a7a..2a0a035 100644 --- a/sx-question-print.el +++ b/sx-question-print.el @@ -1,4 +1,4 @@ -;;; sx-question-print.el --- Populating the question-mode buffer with content. +;;; sx-question-print.el --- Populating the question-mode buffer with content. -*- lexical-binding: t; -*- ;; Copyright (C) 2014 Artur Malabarba diff --git a/sx-question.el b/sx-question.el index c4b2445..fea8978 100644 --- a/sx-question.el +++ b/sx-question.el @@ -1,4 +1,4 @@ -;;; sx-question.el --- question logic +;;; sx-question.el --- Base question logic. -*- lexical-binding: t; -*- ;; Copyright (C) 2014 Sean Allred diff --git a/sx-request.el b/sx-request.el index 0994fbd..a17a982 100644 --- a/sx-request.el +++ b/sx-request.el @@ -1,4 +1,4 @@ -;;; sx-request.el --- requests and url manipulation -*- lexical-binding: t; -*- +;;; sx-request.el --- Requests and url manipulation. -*- lexical-binding: t; -*- ;; Copyright (C) 2014 Sean Allred -- cgit v1.2.3 From 499e2551cba2481463eb84f4deee6897c02609af Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Sat, 6 Dec 2014 18:05:23 +0000 Subject: Bring sx.org up to date --- sx.org | 9 ++++++++- 1 file changed, 8 insertions(+), 1 deletion(-) diff --git a/sx.org b/sx.org index f866aa5..58acbbb 100644 --- a/sx.org +++ b/sx.org @@ -67,7 +67,8 @@ a cache file. ** Browsing Questions To browse a list of questions retrieved from the site, use ~sx-tab-frontpage~. This queries for a site, pulls the first page of -questions for that site, and displays them in a list. +questions for that site, and displays them in a list. Alternatively, +use any of the other ~sx-tab-~ commands. - Refresh the page with =g= or by scrolling past the top. - Use =n=, =p=, =N=, =P= to navigate without viewing the question. @@ -86,6 +87,12 @@ Scrolling past the bottom of the list fetches more questions. # used only by contributors. - ~sx-init-hook~ :: Run when ~sx-initialize~ is called. +- ~sx-compose-before-send-hook~ :: Run before POSTing to the API from + a buffer in ~sx-compose-mode~. If any of the functions in this + hook, return nil, the transaction is cancelled. +- ~sx-compose-after-send-functions~ :: Run after POSTing to the API + from a buffer in ~sx-compose-mode~, if the transaction was + successful. * Contributing This document is maintained in Org format. Updates to the source code -- cgit v1.2.3 From c6cb8dc93ce2913d24772f642007e02f21a00b80 Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Sat, 6 Dec 2014 18:05:43 +0000 Subject: Expand the Contributing section. --- sx.org | 60 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++--- 1 file changed, 57 insertions(+), 3 deletions(-) diff --git a/sx.org b/sx.org index 58acbbb..78bc5da 100644 --- a/sx.org +++ b/sx.org @@ -95,6 +95,19 @@ Scrolling past the bottom of the list fetches more questions. successful. * Contributing +Contributions, be them to the code or to this document, are very much +welcome. Both of these can be found at [[github.com/vermiculus/sx.el][the GitHub repository]]. The +easiest way to contribute is to clone it, make your changes, and +submit a pull request. If you prefer, you can also email a patch of +your changes to one of the authors or maintainers listed in the header +comments. But please, when you do, heed the following conventions. + +1. Contributions to the code which change or add user-facing + functionality should be accompanied by updates to this document. +2. Both in code and in this document, sentences should end in double + space. + +** Contributing to this Document This document is maintained in Org format. Updates to the source code should be accompanied by updates to this document when user-facing functionality is changed. @@ -102,7 +115,7 @@ functionality is changed. Note that some distinctions are made which may not be apparent when viewing the document with Info. -** Markup Conventions +*** Markup Conventions Markup is used consistently as follows: - packages :: =package.el= @@ -115,7 +128,7 @@ To make the Info export readable, lists and source code blocks are separated from body text with a blank line (as to start a new paragraph). -** Document Attributes +*** Document Attributes Attributes should be given in uppercase: #+BEGIN_SRC org @@ -124,11 +137,52 @@ Attributes should be given in uppercase: ,#+END_SRC #+END_SRC -** Source Code Blocks +*** Source Code Blocks The language for Emacs Lisp source code blocks should be given as =elisp= and its content should be indented by two spaces. See ~org-edit-src-content-indentation~. +** Contributing to the Code +Contributing to the code should be fairly straightforward. Each file +has a descriptive header explaining its purpose. Still, to help you +find your way around, we describe below the current project +structure. This list is very loosely ordered form low to high-level. + +- ~sx.el~ - Utility functions used throughout the package. Essentially + every file indirectly requires this one. If you're adding a function + that's used by different parts of the package, add it to this file. +- ~sx-time.el~ - Similar to ~sx.el~, but only contains a few + time-related functions. +- ~sx-filter.el~ - Handles retrieval of filters. +- ~sx-cache.el~ - Saves and restores persistent data between sessions. +- ~sx-button.el~ - Defines all button types used throughout the + package. Currently used only by ~sx-question-print.el~. + +- ~sx-request.el~ - Requests and url manipulation. Backend used by + ~sx-method.el~. It shouldn't be necessary to use the functions in + this file outside ~sx-method.el~. +- ~sx-method.el~ - Main interface for API method calls. + +- ~sx-favorites.el~ - Starred questions. +- ~sx-networks.el~ - User network information. +- ~sx-site.el~ - Browsing sites. +- ~sx-auth.el~ - Handles user authentication. + +- ~sx-question.el~ - Base question logic. Holds several functions for + retrieving questions and for processing retrieved questions. Doesn't + do any sort of user interface, that is left for + ~sx-question-list.el~ and ~sx-question-mode.el~. +- ~sx-question-list.el~ - Major-mode for navigating questions list. +- ~sx-question-mode.el~ - User interface for displaying a + question. Creates the buffer and defines the major-mode. +- ~sx-question-print.el~ - Populating the question buffer with + content. Used by ~sx-question-mode.el~ to actually print the content + of a question. + +- ~sx-compose.el~ - Major-mode for composing questions and answers. +- ~sx-interaction.el~ - Voting, commenting, and otherwise interacting with questions. +- ~sx-tab.el~ - Functions for viewing different tabs. + * COMMENT Local Variables # LocalWords: StackExchange SX inbox sx API url json inline Org # LocalWords: Markup keybinding keybindings customizability webpage -- cgit v1.2.3 From 512cfda1f0ba120f6fcfe62496936bba1ca42ebc Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Sun, 7 Dec 2014 01:30:40 +0000 Subject: Create sx-load file whose sole purpose is to load everything. --- README.org | 3 +-- sx-load.el | 51 +++++++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 52 insertions(+), 2 deletions(-) create mode 100644 sx-load.el diff --git a/README.org b/README.org index 460ba34..db47904 100644 --- a/README.org +++ b/README.org @@ -36,8 +36,7 @@ As always, =C-h m= is the definitive resource for the functions of this mode. To install the development version, follow the usual steps: - Clone this repository - Add this directory to your ~load-path~ -- Issue ~(require 'sx)~ -- Issue ~(require 'sx-tab)~ +- Issue ~(require 'sx-load)~ This should give you access to the ~sx-tab-~ functions (the main entry points at this time). diff --git a/sx-load.el b/sx-load.el new file mode 100644 index 0000000..e29d439 --- /dev/null +++ b/sx-load.el @@ -0,0 +1,51 @@ +;;; sx-load.el --- Load all files of the sx package. + +;; 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: +(mapc #'require + '(sx + sx-time + sx-auth + sx-button + sx-cache + sx-compose + sx-encoding + sx-favorites + sx-filter + sx-interaction + sx-method + sx-networks + sx.org + sx-question + sx-question-list + sx-question-mode + sx-question-print + sx-request + sx-site + sx-tab + )) + +(provide 'sx-load) +;;; sx-load.el ends here + +;; Local Variables: +;; indent-tabs-mode: nil +;; End: -- cgit v1.2.3 From 98a004b8f5a0f160c62563dc034372535f99a58e Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Mon, 8 Dec 2014 12:40:04 +0000 Subject: Update sx.org --- sx.org | 10 ++++++++++ 1 file changed, 10 insertions(+) diff --git a/sx.org b/sx.org index 78bc5da..e9c1211 100644 --- a/sx.org +++ b/sx.org @@ -55,6 +55,14 @@ Emacs conventions. Of course, the core convention of Emacs is arbitrary customizability -- [[#hooks][hack away]]! * Basic Usage + +** Activation + +If you install ~SX~ with ~package-install~, you should have every +needed command properly autoloaded. If you install it manually, +require the ~sx-load~ file to make sure everything is correctly +loaded. + ** Authenticating Use ~sx-auth-authenticate~. Calling this function will open up a webpage on StackExchange that will prompt you to authorize this @@ -183,6 +191,8 @@ structure. This list is very loosely ordered form low to high-level. - ~sx-interaction.el~ - Voting, commenting, and otherwise interacting with questions. - ~sx-tab.el~ - Functions for viewing different tabs. +- ~sx-load.el~ - Load all files of the sx package. Designed as an easy way in for users who install the package manually (since they don't have autoloads). + * COMMENT Local Variables # LocalWords: StackExchange SX inbox sx API url json inline Org # LocalWords: Markup keybinding keybindings customizability webpage -- cgit v1.2.3 From 3da6e5174cbb3a2d551a9862dd79655908e2e0fc Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Sun, 7 Dec 2014 01:15:37 +0000 Subject: Create sx-babel Has functions and a variable for font-locking pre blocks. --- sx-babel.el | 114 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 114 insertions(+) create mode 100644 sx-babel.el diff --git a/sx-babel.el b/sx-babel.el new file mode 100644 index 0000000..7da24a5 --- /dev/null +++ b/sx-babel.el @@ -0,0 +1,114 @@ +;;; sx-babel.el --- Font-locking pre blocks according to language. -*- 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: + +;; This file contains functions and a variable for font-locking the +;; content of markdown pre blocks according to their language. The +;; main configuration point, for both the user and the developer is +;; the varuable `sx-babel-major-mode-alist', which see. + + +;;; Code: +(require 'sx-button) + +(defvar sx-babel-major-mode-alist + `((,(rx (or "*" "#+")) org-mode) + (,(rx (or "[" "(" ";" "#(")) emacs-lisp-mode)) + "List of cons cells determining which major-mode to use when. +Each car is a rule and each cdr is a major-mode. The first rule +which is satisfied activates the major-mode. + +Point is moved to the first non-blank character before testing +the rule, which can either be a string or a function. If it is a +string, is tested as a regexp starting from point. If it is a +function, is called with no arguments and should return non-nil +on a match.") +(put 'sx-babel-major-mode-alist 'risky-local-variable-p t) + + +;;; Font-locking the text +(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) + (with-temp-buffer + (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) + (font-lock-fontify-region (point-min) (point-max)) + (goto-char (point-min)) + (let ((space (make-string indent " "))) + (while (not (eobp)) + (insert space) + (forward-line 1))) + (setq text (buffer-string))) + (goto-char beg) + (delete-region beg end) + (insert text))) + +(defun sx-babel--determine-and-activate-major-mode () + "Activate the major-mode most suitable for the current buffer." + (let ((alist sx-babel-major-mode-alist) + cell) + (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 (cdr cell))))))) + +(defun sx-babel--unindent-buffer () + "Remove absolute indentation in current buffer. +Finds the least indented line, and removes that amount of +indentation from all lines. Primarily designed to extract the +content of markdown code blocks. + +Returns the amount of indentation removed." + (save-excursion + (goto-char (point-min)) + (let (result) + ;; Get indentation of each non-blank line + (while (null (eobp)) + (skip-chars-forward "[:blank:]") + (unless (looking-at "$") + (push (current-column) result)) + (forward-line 1)) + (when result + (setq result (apply #'min result)) + ;; Build a regexp with the smallest indentation + (let ((rx (format "^ \\{0,%s\\}" result))) + (goto-char (point-min)) + ;; Use this regexp to remove that much indentation + ;; throughout the buffer. + (while (and (null (eobp)) + (search-forward-regexp rx nil 'noerror)) + (replace-match "") + (forward-line 1)))) + (or result 0)))) + +(provide 'sx-babel) +;;; sx-babel.el ends here + -- cgit v1.2.3 From 4898b1669b54a8afca3303e70f01a9825cbe01d1 Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Sun, 7 Dec 2014 01:18:04 +0000 Subject: Patch sx and sx-question-print to use sx-babel. --- sx-question-print.el | 24 +++++++----------------- sx.el | 28 ---------------------------- 2 files changed, 7 insertions(+), 45 deletions(-) diff --git a/sx-question-print.el b/sx-question-print.el index 2a0a035..fe64392 100644 --- a/sx-question-print.el +++ b/sx-question-print.el @@ -431,29 +431,19 @@ 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 (beg end text) + (let (beg end) (when (markdown-match-pre-blocks (save-excursion (skip-chars-forward "\r\n[:blank:]") (setq beg (point)))) (setq end (point)) - (setq text - (sx--unindent-text - (buffer-substring - (save-excursion - (goto-char beg) - (line-beginning-position)) - end))) - (put-text-property beg end 'display nil) - (make-text-button - beg end - 'face 'markdown-pre-face - 'sx-button-copy text - :type 'sx-question-mode-code-block)))) + (sx-babel--make-pre-button + (buffer-substring + (save-excursion + (goto-char beg) + (line-beginning-position)) + end))))) (provide 'sx-question-print) ;;; sx-question-print.el ends here -;; Local Variables: -;; lexical-binding: t -;; End: diff --git a/sx.el b/sx.el index 8e3e5d3..d5d9b75 100644 --- a/sx.el +++ b/sx.el @@ -201,34 +201,6 @@ Anything before the (sub)domain is removed." (rx string-start (or (and (0+ word) (optional ":") "//"))) "" url))) -(defun sx--unindent-text (text) - "Remove indentation from TEXT. -Primarily designed to extract the content of markdown code -blocks." - (with-temp-buffer - (insert text) - (goto-char (point-min)) - (let (result) - ;; Get indentation of each non-blank line - (while (null (eobp)) - (skip-chars-forward "[:blank:]") - (unless (looking-at "$") - (push (current-column) result)) - (forward-line 1)) - (when result - ;; Build a regexp with the smallest indentation - (let ((rx (format "^ \\{0,%s\\}" - (apply #'min result)))) - (goto-char (point-min)) - ;; Use this regexp to remove that much indentation - ;; throughout the buffer. - (while (and (null (eobp)) - (search-forward-regexp rx nil 'noerror)) - (replace-match "") - (forward-line 1))))) - ;; Return the buffer - (buffer-string))) - ;;; Printing request data (defvar sx--overlays nil -- cgit v1.2.3 From 42157310ba599a05dce1664080213e31ab00a2d4 Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Mon, 8 Dec 2014 13:10:27 +0000 Subject: Don't require sx Requiring sx is not needed because the macro is autoloaded. --- sx-question-print.el | 4 +--- 1 file changed, 1 insertion(+), 3 deletions(-) diff --git a/sx-question-print.el b/sx-question-print.el index fe64392..6b65d70 100644 --- a/sx-question-print.el +++ b/sx-question-print.el @@ -23,11 +23,9 @@ ;;; Code: (require 'markdown-mode) (require 'sx-button) -(eval-when-compile - (require 'rx)) - (require 'sx) (require 'sx-question) +(require 'sx-babel) (defgroup sx-question-mode nil "Customization group for sx-question-mode." -- cgit v1.2.3 From 635bbc2a3e410f5b97a3f20e5b790712cc873cc2 Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Tue, 9 Dec 2014 14:13:31 +0000 Subject: Fix some implementation bugs --- sx-babel.el | 10 +++++++--- sx-question-print.el | 9 ++++----- 2 files changed, 11 insertions(+), 8 deletions(-) diff --git a/sx-babel.el b/sx-babel.el index 7da24a5..5544642 100644 --- a/sx-babel.el +++ b/sx-babel.el @@ -30,7 +30,11 @@ (defvar sx-babel-major-mode-alist `((,(rx (or "*" "#+")) org-mode) - (,(rx (or "[" "(" ";" "#(")) emacs-lisp-mode)) + (,(rx (or "[" "(" ";" "#(")) emacs-lisp-mode) + ;; @TODO: Make shell-mode work here. Currently errors because it + ;; needs a process. `sh-mode' isn't as nice. + (,(rx (or "$ " "# ")) sh-mode) + ) "List of cons cells determining which major-mode to use when. Each car is a rule and each cdr is a major-mode. The first rule which is satisfied activates the major-mode. @@ -59,7 +63,7 @@ on a match.") (sx-babel--determine-and-activate-major-mode) (font-lock-fontify-region (point-min) (point-max)) (goto-char (point-min)) - (let ((space (make-string indent " "))) + (let ((space (make-string indent ?\s))) (while (not (eobp)) (insert space) (forward-line 1))) @@ -78,7 +82,7 @@ on a match.") (let ((kar (car cell))) (when (if (stringp kar) (looking-at kar) (funcall kar)) (setq alist nil) - (funcall (cdr cell))))))) + (funcall (cadr cell))))))) (defun sx-babel--unindent-buffer () "Remove absolute indentation in current buffer. diff --git a/sx-question-print.el b/sx-question-print.el index 6b65d70..653ebab 100644 --- a/sx-question-print.el +++ b/sx-question-print.el @@ -436,11 +436,10 @@ font-locking." (setq beg (point)))) (setq end (point)) (sx-babel--make-pre-button - (buffer-substring - (save-excursion - (goto-char beg) - (line-beginning-position)) - end))))) + (save-excursion + (goto-char beg) + (line-beginning-position)) + end)))) (provide 'sx-question-print) ;;; sx-question-print.el ends here -- cgit v1.2.3 From c8c59b246ef179fbd1829124e07efc2ea144f6db Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Tue, 9 Dec 2014 14:16:34 +0000 Subject: Update sx.org --- sx.org | 2 ++ 1 file changed, 2 insertions(+) diff --git a/sx.org b/sx.org index e9c1211..7ccb51b 100644 --- a/sx.org +++ b/sx.org @@ -186,6 +186,8 @@ structure. This list is very loosely ordered form low to high-level. - ~sx-question-print.el~ - Populating the question buffer with content. Used by ~sx-question-mode.el~ to actually print the content of a question. +- ~sx-babel.el~ - Font-locking code blocks printed by + ~sx-question-print.el~ according to the language. - ~sx-compose.el~ - Major-mode for composing questions and answers. - ~sx-interaction.el~ - Voting, commenting, and otherwise interacting with questions. -- cgit v1.2.3 From 194a28541d8d2193872a4d83cef50567488a6338 Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Tue, 9 Dec 2014 15:05:04 +0000 Subject: Require sx-babel on sx-load --- sx-load.el | 1 + 1 file changed, 1 insertion(+) diff --git a/sx-load.el b/sx-load.el index e29d439..b348ea1 100644 --- a/sx-load.el +++ b/sx-load.el @@ -25,6 +25,7 @@ sx-time sx-auth sx-button + sx-babel sx-cache sx-compose sx-encoding -- cgit v1.2.3 From 3d6089a6f96b832cb88ccb7bea9be5e1a566d15d Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Tue, 9 Dec 2014 15:42:35 +0000 Subject: Define up and down keys on the list. --- sx-question-list.el | 9 +++++++-- 1 file changed, 7 insertions(+), 2 deletions(-) diff --git a/sx-question-list.el b/sx-question-list.el index c5c32d9..788fc2f 100644 --- a/sx-question-list.el +++ b/sx-question-list.el @@ -286,7 +286,11 @@ into consideration. (mapc (lambda (x) (define-key sx-question-list-mode-map (car x) (cadr x))) - '(("n" sx-question-list-next) + '( + ;; S-down and S-up would collide with `windmove'. + ([down] sx-question-list-view-next) + ([up] sx-question-list-view-previous) + ("n" sx-question-list-next) ("p" sx-question-list-previous) ("j" sx-question-list-view-next) ("k" sx-question-list-view-previous) @@ -303,7 +307,8 @@ into consideration. ("d" sx-toggle-downvote) ("h" sx-question-list-hide) ("m" sx-question-list-mark-read) - ([?\r] sx-display-question))) + ([?\r] sx-display-question) + )) (defun sx-question-list-hide (data) "Hide question under point. -- cgit v1.2.3 From b21052b4bd537f1e61fe8efb3badee1043a0af54 Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Tue, 9 Dec 2014 15:45:32 +0000 Subject: Define up and down keys in question-mode. --- sx-question-mode.el | 5 ++++- 1 file changed, 4 insertions(+), 1 deletion(-) diff --git a/sx-question-mode.el b/sx-question-mode.el index ccd9433..19d7d16 100644 --- a/sx-question-mode.el +++ b/sx-question-mode.el @@ -193,7 +193,10 @@ Letters do not insert themselves; instead, they are commands. (mapc (lambda (x) (define-key sx-question-mode-map (car x) (cadr x))) - `(("n" sx-question-mode-next-section) + `( + ([down] sx-question-mode-next-section) + ([up] sx-question-mode-previous-section) + ("n" sx-question-mode-next-section) ("p" sx-question-mode-previous-section) ("g" sx-question-mode-refresh) ("c" sx-comment) -- cgit v1.2.3 From af26d7303a98cf9b16baf29b86493e73559a5c20 Mon Sep 17 00:00:00 2001 From: Sean Allred Date: Tue, 9 Dec 2014 11:26:22 -0500 Subject: Don't require sx.org Branch: hotfix-sx.org --- sx-load.el | 1 - 1 file changed, 1 deletion(-) diff --git a/sx-load.el b/sx-load.el index e29d439..659f54b 100644 --- a/sx-load.el +++ b/sx-load.el @@ -33,7 +33,6 @@ sx-interaction sx-method sx-networks - sx.org sx-question sx-question-list sx-question-mode -- cgit v1.2.3 From 1de3732868add4ae4a6f698c445bdb9e2ca638bf Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Thu, 11 Dec 2014 10:54:43 +0000 Subject: Define sx-assoc-let in terms of let-alist --- sx.el | 54 ++++++++++++++---------------------------------------- 1 file changed, 14 insertions(+), 40 deletions(-) diff --git a/sx.el b/sx.el index 0bacad2..deaac98 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")) +;; Package-Requires: ((emacs "24.1") (cl-lib "0.5") (json "1.3") (markdown-mode "2.0") (let-alist "1.0")) ;; 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 @@ -308,7 +308,7 @@ removed from the display name before it is returned." string)) -;;; Assoc-let +;;; Site (defun sx--site (data) "Get the site in which DATA belongs. DATA can be a question, answer, comment, or user (or any object @@ -321,47 +321,21 @@ DATA can also be the link itself." "^https?://\\(?:\\(?1:[^/]+\\)\\.stackexchange\\|\\(?2:[^/]+\\)\\)\\.[^.]+/.*$" "\\1\\2" link)))) -(defun sx--deep-dot-search (data) - "Find symbols somewhere inside DATA which start with a `.'. -Returns a list where each element is a cons cell. The car is the -symbol, the cdr is the symbol without the `.'." - (cond - ((symbolp data) - (let ((name (symbol-name data))) - (when (string-match "\\`\\." name) - ;; Return the cons cell inside a list, so it can be appended - ;; with other results in the clause below. - (list (cons data (intern (replace-match "" nil nil name))))))) - ((not (listp data)) nil) - (t (apply - #'append - (remove nil (mapcar #'sx--deep-dot-search data)))))) +(defun sx--ensure-site (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)." + (unless (assq 'site data) + (setcdr data (cons (cons 'site (sx--site data)) + (cdr data)))) + data) (defmacro sx-assoc-let (alist &rest body) - "Use dotted symbols let-bound to their values in ALIST and execute BODY. -Dotted symbol is any symbol starting with a `.'. Only those -present in BODY are letbound, which leads to optimal performance. -The .site symbol is special, it is derived from the .link symbol -using `sx--site'. - -For instance, the following code - - (sx-assoc-let alist - (list .title .body)) - -is equivalent to - - (let ((.title (cdr (assoc 'title alist))) - (.body (cdr (assoc 'body alist)))) - (list .title .body))" + "Identical to `let-alist', except `.site' has a special meaning. +If ALIST doesn't have a `site' property, one is created using the +`link' property." (declare (indent 1) (debug t)) - (let* ((symbol-alist (sx--deep-dot-search body)) - (has-site (assoc '.site symbol-alist))) - `(let ,(append - (when has-site `((.site (sx--site (cdr (assoc 'link ,alist)))))) - (mapcar (lambda (x) `(,(car x) (cdr (assoc ',(cdr x) ,alist)))) - (remove '(.site . site) (delete-dups symbol-alist)))) - ,@body))) + `(let-alist (sx--ensure-site ,alist) ,@body)) (defcustom sx-init-hook nil "Hook run when SX initializes. -- cgit v1.2.3 From 07d50dde367ebb810a01d54b41bf69406618d1f2 Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Thu, 11 Dec 2014 10:55:54 +0000 Subject: Some more whitespace --- sx.el | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/sx.el b/sx.el index deaac98..4c1581e 100644 --- a/sx.el +++ b/sx.el @@ -197,7 +197,7 @@ Anything before the (sub)domain is removed." (eval-when-compile (concat "\\1" (if (char-displayable-p ?…) "…" "..."))) ;; Remove anything before subdomain. - (replace-regexp-in-string + (replace-regexp-in-string (rx string-start (or (and (0+ word) (optional ":") "//"))) "" url))) @@ -235,7 +235,7 @@ blocks." "Overlays created by sx on this buffer.") (make-variable-buffer-local 'sx--overlays) -(defvar sx--overlay-printing-depth 0 +(defvar sx--overlay-printing-depth 0 "Track how many overlays we're printing on top of each other. Used for assigning higher priority to inner overlays.") (make-variable-buffer-local 'sx--overlay-printing-depth) @@ -264,7 +264,7 @@ Return the result of BODY." (push ov sx--overlays)) result)) -(defvar sx--ascii-replacement-list +(defvar sx--ascii-replacement-list '(("[:space:]" . "") ("àåáâäãåą" . "a") ("èéêëę" . "e") -- cgit v1.2.3 From 4a9736e5104e1eafbf197a441eb6b9178641711e Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Thu, 11 Dec 2014 10:56:26 +0000 Subject: Add dependency to cask --- Cask | 1 + 1 file changed, 1 insertion(+) diff --git a/Cask b/Cask index f0c70fb..f1bcb07 100644 --- a/Cask +++ b/Cask @@ -9,6 +9,7 @@ (depends-on "url") (depends-on "cl-lib") (depends-on "markdown-mode") +(depends-on "let-alist") (development (depends-on "ert")) -- cgit v1.2.3 From 36ae5019aa6d1cae3cab9e3330591e227b427814 Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Thu, 11 Dec 2014 11:18:32 +0000 Subject: Fix assoc-let test --- sx.el | 3 ++- test/tests.el | 16 +++++++++------- 2 files changed, 11 insertions(+), 8 deletions(-) diff --git a/sx.el b/sx.el index 4c1581e..bb7eddc 100644 --- a/sx.el +++ b/sx.el @@ -335,7 +335,8 @@ with a `link' property)." If ALIST doesn't have a `site' property, one is created using the `link' property." (declare (indent 1) (debug t)) - `(let-alist (sx--ensure-site ,alist) ,@body)) + `(progn (sx--ensure-site ,alist) + (let-alist ,alist ,@body))) (defcustom sx-init-hook nil "Hook run when SX initializes. diff --git a/test/tests.el b/test/tests.el index b997c6e..8d1ba44 100644 --- a/test/tests.el +++ b/test/tests.el @@ -121,16 +121,18 @@ (ert-deftest macro-test--sx-assoc-let () "Tests macro expansion for `sx-assoc-let'" (should - (equal '(let ((.test (cdr (assoc 'test data)))) - .test) - (macroexpand + (equal '(progn (sx--ensure-site data) + (let ((.test (cdr (assq 'test data)))) + .test)) + (macroexpand-all '(sx-assoc-let data .test)))) (should - (equal '(let ((.test-one (cdr (assoc 'test-one data))) - (.test-two (cdr (assoc 'test-two data)))) - (cons .test-one .test-two)) - (macroexpand + (equal '(progn (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)))))) -- cgit v1.2.3 From 7dc4e4f83599ba9ee3ca1af9efd8e8ce9112316c Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Thu, 11 Dec 2014 11:36:02 +0000 Subject: Fix unrelated test --- test/tests.el | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/test/tests.el b/test/tests.el index 8d1ba44..5d60848 100644 --- a/test/tests.el +++ b/test/tests.el @@ -106,17 +106,17 @@ (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]+[ydhms] ago\\s-+\\[frames\\] \\[hooks\\] \\[focus\\]") + "^\\s-+1\\s-+0\\s-+Focus-hook: attenuate colours when losing focus [ 0-9]+[ydhms]o? 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]+[ydhms] ago\\s-+\\[org-mode\\]") + "^\\s-+0\\s-+1\\s-+Babel doesn't wrap results in verbatim [ 0-9]+[ydhms]o? 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]+[ydhms] ago\\s-+\\[autocomplete\\]"))) + "^\\s-+2\\s-+1\\s-+"Making tag completion table" Freezes/Blocks -- how to disable [ 0-9]+[ydhms]o? ago\\s-+\\[autocomplete\\]"))) (ert-deftest macro-test--sx-assoc-let () "Tests macro expansion for `sx-assoc-let'" -- cgit v1.2.3 From 79c03c20d14ddfe546c9f612bd9c8b1b1cb00b2c Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Fri, 12 Dec 2014 15:12:54 +0000 Subject: Autoload sx-authenticate This also removes the sx-authenticate alias and renames sx-auth-authenticate to sx-authenticate. I did this because I felt it wasn't helpful to have both. Whenever I hit `M-x sx-au ` the only completions offered were two identical, but differently named, commands. That's useless at best, confusing at worst. --- sx-auth.el | 5 ++--- sx-method.el | 2 +- 2 files changed, 3 insertions(+), 4 deletions(-) diff --git a/sx-auth.el b/sx-auth.el index b6c0411..fca5392 100644 --- a/sx-auth.el +++ b/sx-auth.el @@ -80,7 +80,8 @@ will be (METHOD . t)") Keywords are of form (OBJECT TYPES) where TYPES is (FILTER FILTER FILTER).") -(defun sx-auth-authenticate () +;;;###autoload +(defun sx-authenticate () "Authenticate this application. Authentication is required to read your personal data (such as notifications) and to write with the API (asking and answering @@ -126,8 +127,6 @@ parsed and displayed prominently on the page)." (error "You must enter this code to use this client fully")) (sx-cache-set 'auth `((access_token . ,sx-auth-access-token))))) -(defalias 'sx-authenticate #'sx-auth-authenticate) - (defun sx-auth--method-p (method &optional submethod) "Check if METHOD is one that may require authentication. If it has `auth-required' SUBMETHODs, or no submethod, return t." diff --git a/sx-method.el b/sx-method.el index 5646772..4575b0f 100644 --- a/sx-method.el +++ b/sx-method.el @@ -91,7 +91,7 @@ Return the entire response as a complex alist." ;; 1. Need auth and warn user (interactive use) ((and method-auth (equal 'warn auth)) (user-error - "This request requires authentication. Please run `M-x sx-auth-authenticate' and try again.")) + "This request requires authentication. Please run `M-x sx-authenticate' and try again.")) ;; 2. Need auth to populate UI, cannot provide subset ((and method-auth auth) (setq call 'sx-request-fallback)) -- cgit v1.2.3 From 97d953b092198b7d43e5930fd80a28936ddfda04 Mon Sep 17 00:00:00 2001 From: Steve Purcell Date: Fri, 12 Dec 2014 18:45:19 +0000 Subject: Use package-file directive in Cask No need to repeat the metadata which in sx.el: cask knows how to read it. --- Cask | 8 +------- 1 file changed, 1 insertion(+), 7 deletions(-) diff --git a/Cask b/Cask index f0c70fb..a055f12 100644 --- a/Cask +++ b/Cask @@ -1,14 +1,8 @@ -(package "stack-mode" "0" "Stack Exchange for Emacs") - (source gnu) (source melpa-stable) +(package-file "sx.el") (files "sx*.el") -(depends-on "json" "1.4") -(depends-on "url") -(depends-on "cl-lib") -(depends-on "markdown-mode") - (development (depends-on "ert")) -- cgit v1.2.3 From 351e13583de4dd1060c2877611faa27c83e3b297 Mon Sep 17 00:00:00 2001 From: Steve Purcell Date: Fri, 12 Dec 2014 18:46:26 +0000 Subject: Update package description line --- sx.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/sx.el b/sx.el index 53c636a..b5c5c66 100644 --- a/sx.el +++ b/sx.el @@ -1,4 +1,4 @@ -;;; sx.el --- core functions of the sx package. +;;; sx.el --- StackExchange client ;; Copyright (C) 2014 Sean Allred -- cgit v1.2.3 From 8418e3bf8038a0ca866c81ce712a47bdcb4800cb Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Fri, 12 Dec 2014 21:49:54 +0000 Subject: Stricter regexp --- test/tests.el | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/test/tests.el b/test/tests.el index 5d60848..eca6ce4 100644 --- a/test/tests.el +++ b/test/tests.el @@ -106,17 +106,17 @@ (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]+[ydhms]o? ago\\s-+\\[frames\\] \\[hooks\\] \\[focus\\]") + "^\\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]+[ydhms]o? ago\\s-+\\[org-mode\\]") + "^\\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]+[ydhms]o? ago\\s-+\\[autocomplete\\]"))) + "^\\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'" -- cgit v1.2.3 From 302b5a0cf2222973b901c7856da3920705ebe24e Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Sat, 13 Dec 2014 00:18:12 +0000 Subject: HOTFIX: Mark question as read when displaying it. This is a pretty big bug because it was leading SX to think the question wasn't read, even though it was open. This, in turn, prevented the user from being able to do anything (vote, comment) on the question, since we prevent interaction with unread questions. --- sx-question-mode.el | 4 +++- 1 file changed, 3 insertions(+), 1 deletion(-) diff --git a/sx-question-mode.el b/sx-question-mode.el index 19d7d16..5735f47 100644 --- a/sx-question-mode.el +++ b/sx-question-mode.el @@ -62,7 +62,9 @@ Returns the question buffer." (sx-question-mode--erase-and-print-question data))) (defun sx-question-mode--erase-and-print-question (data) - "Erase contents of buffer and print question given by DATA." + "Erase contents of buffer and print question given by DATA. +Also marks the question as read with `sx-question--mark-read'." + (sx-question--mark-read data) (let ((inhibit-read-only t)) (erase-buffer) (sx-question-mode) -- cgit v1.2.3 From 0b766bb6f949ac583c7cbff90fc172c36795b231 Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Sat, 13 Dec 2014 00:25:25 +0000 Subject: Fix test again --- test/tests.el | 8 ++++---- 1 file changed, 4 insertions(+), 4 deletions(-) diff --git a/test/tests.el b/test/tests.el index eca6ce4..15c8e8b 100644 --- a/test/tests.el +++ b/test/tests.el @@ -9,7 +9,7 @@ (defvar sx-test-data-dir (expand-file-name "data-samples/" - (or (file-name-directory load-file-name) "./"))) + (file-name-directory (or load-file-name "./")))) (defun sx-test-sample-data (method &optional directory) (let ((file (concat (when directory (concat directory "/")) @@ -106,17 +106,17 @@ (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\\]") + "^\\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\\]") + "^\\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\\]"))) + "^\\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'" -- cgit v1.2.3 From 144db4c35bf902a045b221dae39d5437f7d9fb52 Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Sat, 13 Dec 2014 22:02:22 +0000 Subject: sx--ensure-site accepts nil. Fix #150 --- sx.el | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) diff --git a/sx.el b/sx.el index 7dde8a7..fd39419 100644 --- a/sx.el +++ b/sx.el @@ -297,10 +297,11 @@ DATA can also be the link itself." "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)." - (unless (assq 'site data) - (setcdr data (cons (cons 'site (sx--site data)) - (cdr data)))) - data) + (when data + (unless (assq 'site data) + (setcdr data (cons (cons 'site (sx--site data)) + (cdr data)))) + data)) (defmacro sx-assoc-let (alist &rest body) "Identical to `let-alist', except `.site' has a special meaning. -- cgit v1.2.3 From f924a9c58ce30dc62fc61382b1933d8ef51189b5 Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Sun, 14 Dec 2014 12:59:17 +0000 Subject: Fix dependency order. sx-tab now requires sx-interaction --- sx-interaction.el | 18 ++++++++++++++++-- sx-tab.el | 19 ++----------------- 2 files changed, 18 insertions(+), 19 deletions(-) diff --git a/sx-interaction.el b/sx-interaction.el index 9b63e0a..0411410 100644 --- a/sx-interaction.el +++ b/sx-interaction.el @@ -44,7 +44,6 @@ (require 'sx-question-mode) (require 'sx-question-list) (require 'sx-compose) -(require 'sx-tab) ;;; Using data in buffer @@ -299,6 +298,21 @@ from context at point." ;;; Asking +(defcustom sx-default-site "emacs" + "Name of the site to use by default when listing questions." + :type 'string + :group 'sx) + +(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-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))) + (defun sx-ask (site) "Start composing a question for SITE. SITE is a string, indicating where the question will be posted." @@ -308,7 +322,7 @@ SITE is a string, indicating where the question will be posted." (sx-compose-create site nil nil ;; After send functions - (list (lambda (_ res) (sx--maybe-update-display buffer))))))) + (list (lambda (_b _res) (sx--maybe-update-display buffer))))))) ;;; Answering diff --git a/sx-tab.el b/sx-tab.el index f36d10f..f3ac381 100644 --- a/sx-tab.el +++ b/sx-tab.el @@ -26,11 +26,7 @@ (require 'sx) (require 'sx-question-list) - -(defcustom sx-tab-default-site "emacs" - "Name of the site to use by default when listing questions." - :type 'string - :group 'sx) +(require 'sx-interaction) (defvar sx-tab--list nil "List of the names of all defined tabs.") @@ -44,17 +40,6 @@ t))) (funcall (intern (format "sx-tab-%s" (downcase tab))))) -(defun sx-tab--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-tab-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))) - ;;; The main macro (defmacro sx-tab--define (tab pager &optional printer refresher @@ -91,7 +76,7 @@ If SITE is nil, use `sx-tab-default-site'." tab) (interactive (list current-prefix-arg - (sx-tab--interactive-site-prompt))) + (sx--interactive-site-prompt))) (sx-initialize) (unless site (setq site sx-tab-default-site)) ;; Create the buffer -- cgit v1.2.3 From a33de03f6c9f0419d7640bce0ab203fd43607bb4 Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Sun, 14 Dec 2014 13:39:42 +0000 Subject: Use the header-line as a UI guide. --- sx-question-list.el | 14 +++++++++++++- 1 file changed, 13 insertions(+), 1 deletion(-) diff --git a/sx-question-list.el b/sx-question-list.el index 788fc2f..0dfebc4 100644 --- a/sx-question-list.el +++ b/sx-question-list.el @@ -196,6 +196,18 @@ and thus not displayed in the list of questions. This is ignored if `sx-question-list--refresh-function' is set.") (make-variable-buffer-local 'sx-question-list--dataset) +(defvar sx-question-list--header-line + '(" " + (:propertize "n p j k" face mode-line-buffer-id) + ": Navigate" + " " + (:propertize "RET" face mode-line-buffer-id) + ": View question" + " " + (:propertize "v" face mode-line-buffer-id) + ": Visit externally") + "Header-line used on the question list.") + ;;; Mode Definition (define-derived-mode sx-question-list-mode @@ -266,7 +278,7 @@ into consideration. #'sx-question-list-refresh nil t) (add-hook 'tabulated-list-revert-hook #'sx-question-list--update-mode-line nil t) - (tabulated-list-init-header)) + (setq header-line-format sx-question-list--header-line)) (defcustom sx-question-list-date-sort-method 'last_activity_date "Parameter which controls date sorting." -- cgit v1.2.3 From bc2c6b72e62cbcc1540ce4154760250273e05d04 Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Sun, 14 Dec 2014 13:39:46 +0000 Subject: Fix up and down keys --- sx-question-list.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/sx-question-list.el b/sx-question-list.el index 0dfebc4..69fb435 100644 --- a/sx-question-list.el +++ b/sx-question-list.el @@ -300,8 +300,8 @@ into consideration. (car x) (cadr x))) '( ;; S-down and S-up would collide with `windmove'. - ([down] sx-question-list-view-next) - ([up] sx-question-list-view-previous) + ([down] sx-question-list-next) + ([up] sx-question-list-previous) ("n" sx-question-list-next) ("p" sx-question-list-previous) ("j" sx-question-list-view-next) -- cgit v1.2.3 From 8adc0ac710469949ac28aa664eef965ef179c290 Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Sun, 14 Dec 2014 13:42:29 +0000 Subject: Use the header-line as a UI guide on the question buffer. --- sx-question-mode.el | 19 +++++++++++++++++++ 1 file changed, 19 insertions(+) diff --git a/sx-question-mode.el b/sx-question-mode.el index 5735f47..c45ef9f 100644 --- a/sx-question-mode.el +++ b/sx-question-mode.el @@ -175,12 +175,31 @@ property." ;;; Major-mode +(defvar sx-question-mode--header-line + '(" " + (:propertize "n p TAB" face mode-line-buffer-id) + ": Navigate" + " " + (:propertize "u d" face mode-line-buffer-id) + ": Up/Down Vote" + " " + (:propertize "c" face mode-line-buffer-id) + ": Comment" + " " + (:propertize "a" face mode-line-buffer-id) + ": Answer" + " " + (:propertize "e" face mode-line-buffer-id) + ": Edit") + "Header-line used on the question list.") + (define-derived-mode sx-question-mode special-mode "Question" "Major mode to display and navigate a question and its answers. Letters do not insert themselves; instead, they are commands. \\ \\{sx-question-mode}" + (setq header-line-format sx-question-mode--header-line) ;; Determine how to close this window. (unless (window-parameter nil 'quit-restore) (set-window-parameter -- cgit v1.2.3 From 4bcdd311b590156998ebf51a14fce31b6d0569ec Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Sun, 14 Dec 2014 11:49:56 -0200 Subject: Also mention q --- sx-question-list.el | 5 ++++- sx-question-mode.el | 5 ++++- 2 files changed, 8 insertions(+), 2 deletions(-) diff --git a/sx-question-list.el b/sx-question-list.el index 69fb435..f23310c 100644 --- a/sx-question-list.el +++ b/sx-question-list.el @@ -205,7 +205,10 @@ This is ignored if `sx-question-list--refresh-function' is set.") ": View question" " " (:propertize "v" face mode-line-buffer-id) - ": Visit externally") + ": Visit externally" + " " + (:propertize "q" face mode-line-buffer-id) + ": Quit") "Header-line used on the question list.") diff --git a/sx-question-mode.el b/sx-question-mode.el index c45ef9f..68618bb 100644 --- a/sx-question-mode.el +++ b/sx-question-mode.el @@ -190,7 +190,10 @@ property." ": Answer" " " (:propertize "e" face mode-line-buffer-id) - ": Edit") + ": Edit" + " " + (:propertize "q" face mode-line-buffer-id) + ": Quit") "Header-line used on the question list.") (define-derived-mode sx-question-mode special-mode "Question" -- cgit v1.2.3 From a0d2e0d1572f09890e1c91a8230867fb019b3f10 Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Sun, 14 Dec 2014 15:07:10 -0200 Subject: Fix lexical bindings. --- sx-question-mode.el | 4 ---- sx-question.el | 1 - sx.el | 4 +--- 3 files changed, 1 insertion(+), 8 deletions(-) diff --git a/sx-question-mode.el b/sx-question-mode.el index 68618bb..b376616 100644 --- a/sx-question-mode.el +++ b/sx-question-mode.el @@ -268,7 +268,3 @@ query the api." (provide 'sx-question-mode) ;;; sx-question-mode.el ends here - -;; Local Variables: -;; lexical-binding: t -;; End: diff --git a/sx-question.el b/sx-question.el index fea8978..0f6d17f 100644 --- a/sx-question.el +++ b/sx-question.el @@ -175,5 +175,4 @@ If no cache exists for it, initialize one with SITE." ;; Local Variables: ;; indent-tabs-mode: nil -;; lexical-binding: t ;; End: diff --git a/sx.el b/sx.el index fd39419..c1f91d1 100644 --- a/sx.el +++ b/sx.el @@ -1,4 +1,4 @@ -;;; sx.el --- StackExchange client +;;; sx.el --- StackExchange client. Ask and answer questions on Stack Overflow, Super User, and the likes. -*- lexical-binding: t; -*- ;; Copyright (C) 2014 Sean Allred @@ -36,7 +36,6 @@ :tag "SX" :group 'applications) - ;;; User commands (defun sx-version () @@ -360,5 +359,4 @@ If FORCE is non-nil, run them even if they've already been run." ;; Local Variables: ;; indent-tabs-mode: nil -;; lexical-binding: t ;; End: -- cgit v1.2.3 From 26d2da1e992130897c24898142e36798b0f2d981 Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Sun, 14 Dec 2014 15:27:02 -0200 Subject: Doc fix --- sx.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/sx.el b/sx.el index c1f91d1..f707731 100644 --- a/sx.el +++ b/sx.el @@ -31,7 +31,7 @@ (defconst sx-version "0.1" "Version of the `sx' package.") (defgroup sx nil - "Customization group for sx-question-mode." + "Customization group for the `sx' package." :prefix "sx-" :tag "SX" :group 'applications) -- cgit v1.2.3 From 46210719ee1b322a64ce8abe79d32c26ed2b9137 Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Sun, 14 Dec 2014 22:14:47 -0200 Subject: Fix leftover references to wrong variable name. --- sx-tab.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/sx-tab.el b/sx-tab.el index f3ac381..6c5e21e 100644 --- a/sx-tab.el +++ b/sx-tab.el @@ -72,13 +72,13 @@ variables, but before refreshing the display." ,(format "Display a list of %s questions for SITE. NO-UPDATE (the prefix arg) is passed to `sx-question-list-refresh'. -If SITE is nil, use `sx-tab-default-site'." +If SITE is nil, use `sx-default-site'." tab) (interactive (list current-prefix-arg (sx--interactive-site-prompt))) (sx-initialize) - (unless site (setq site sx-tab-default-site)) + (unless site (setq site sx-default-site)) ;; Create the buffer (unless (buffer-live-p ,buffer-variable) (setq ,buffer-variable -- cgit v1.2.3 From 65a66c266a10bda3843fbf02eb13789e0f1dc9c7 Mon Sep 17 00:00:00 2001 From: Sean Allred Date: Mon, 15 Dec 2014 11:35:40 -0500 Subject: Hotfix undefined function Related in conversation: #151 Branch: master --- sx-interaction.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/sx-interaction.el b/sx-interaction.el index 0411410..38520a7 100644 --- a/sx-interaction.el +++ b/sx-interaction.el @@ -316,7 +316,7 @@ from context at point." (defun sx-ask (site) "Start composing a question for SITE. SITE is a string, indicating where the question will be posted." - (interactive (list (sx-tab--interactive-site-prompt))) + (interactive (list (sx--interactive-site-prompt))) (let ((buffer (current-buffer))) (pop-to-buffer (sx-compose-create -- cgit v1.2.3 From 203402f10a7bce27b30d19aa71b96dad9a0e6b3c Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Mon, 15 Dec 2014 18:01:53 -0200 Subject: Hotfix: Bump let-alist dependency. Might affect #151 --- sx.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/sx.el b/sx.el index f707731..096e20b 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")) +;; Package-Requires: ((emacs "24.1") (cl-lib "0.5") (json "1.3") (markdown-mode "2.0") (let-alist "1.0.1")) ;; 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 6987b0424a209227956d2be8aaa84c1303fd25fd Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Mon, 15 Dec 2014 18:16:03 -0200 Subject: time-to-seconds is obsolete. --- sx-time.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/sx-time.el b/sx-time.el index e65bb50..3de124d 100644 --- a/sx-time.el +++ b/sx-time.el @@ -42,7 +42,7 @@ (defun sx-time-since (time) "Convert the time interval since TIME (in seconds) to a short string." - (let ((delay (- (time-to-seconds) time))) + (let ((delay (- (float-time) time))) (concat (if (> 0 delay) "-" "") (if (= 0 delay) "0s" -- cgit v1.2.3 From e33d4bca3d610a77ef33f3c5dcaab7f7b4119900 Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Mon, 15 Dec 2014 18:18:02 -0200 Subject: Unused variable --- sx-question.el | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/sx-question.el b/sx-question.el index 0f6d17f..9fb31fc 100644 --- a/sx-question.el +++ b/sx-question.el @@ -142,8 +142,7 @@ If no cache exists for it, initialize one with SITE." (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)) - cell) + (let ((site-cell (assoc .site sx-question--user-hidden-list))) ;; If question already hidden, do nothing. (unless (memq .question_id site-cell) ;; First question from this site. -- cgit v1.2.3 From ceaee4e85d44caad2db8adacdff2e2772bf254c0 Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Mon, 15 Dec 2014 18:18:08 -0200 Subject: _ indicates a variable is ignored. --- sx-request.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/sx-request.el b/sx-request.el index a17a982..2d894f0 100644 --- a/sx-request.el +++ b/sx-request.el @@ -156,7 +156,7 @@ the main content of the response is returned." sx-request-remaining-api-requests)) (sx-encoding-clean-content-deep .items))))))) -(defun sx-request-fallback (method &optional args request-method) +(defun sx-request-fallback (_method &optional _args _request-method) "Fallback method when authentication is not available. This is for UI generation when the associated API call would require authentication. -- cgit v1.2.3 From 6956c17e1e7ef2899026ad365a0acdd4ce63cb80 Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Mon, 15 Dec 2014 18:27:33 -0200 Subject: user-error is "not known to be defined" in emacs 24.2 --- sx-button.el | 2 +- sx-interaction.el | 4 ++-- sx-method.el | 2 +- sx-question-list.el | 4 ++-- sx.el | 5 +++++ 5 files changed, 11 insertions(+), 6 deletions(-) diff --git a/sx-button.el b/sx-button.el index dbadc2e..1727a3d 100644 --- a/sx-button.el +++ b/sx-button.el @@ -96,7 +96,7 @@ code-block." (interactive) (browse-url (or (get-text-property (or pos (point)) 'sx-button-url) - (user-error "No url under point: %s" (or pos (point)))))) + (sx-user-error "No url under point: %s" (or pos (point)))))) ;;; Help-echo definitions diff --git a/sx-interaction.el b/sx-interaction.el index 38520a7..7d32094 100644 --- a/sx-interaction.el +++ b/sx-interaction.el @@ -85,7 +85,7 @@ If it's not a question, or if it is read, return DATA." ;; If we found a question, we may need to check if it's read. (if (and (assoc 'title data) (null (sx-question--read-p data))) - (user-error "Question not yet read. View it before acting on it") + (sx-user-error "Question not yet read. View it before acting on it") data)) (defun sx--maybe-update-display (&optional buffer) @@ -286,7 +286,7 @@ 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 (user-error "Editing comments is not supported yet")) + (when .comment_id (sx-user-error "Editing comments is not supported yet")) (let ((buffer (current-buffer))) (pop-to-buffer (sx-compose-create diff --git a/sx-method.el b/sx-method.el index 4575b0f..1078014 100644 --- a/sx-method.el +++ b/sx-method.el @@ -90,7 +90,7 @@ Return the entire response as a complex alist." (cond ;; 1. Need auth and warn user (interactive use) ((and method-auth (equal 'warn auth)) - (user-error + (sx-user-error "This request requires authentication. Please run `M-x sx-authenticate' and try again.")) ;; 2. Need auth to populate UI, cannot provide subset ((and method-auth auth) diff --git a/sx-question-list.el b/sx-question-list.el index f23310c..e94c689 100644 --- a/sx-question-list.el +++ b/sx-question-list.el @@ -331,7 +331,7 @@ Non-interactively, DATA is a question alist." (interactive (list (if (derived-mode-p 'sx-question-list-mode) (tabulated-list-get-id) - (user-error "Not in `sx-question-list-mode'")))) + (sx-user-error "Not in `sx-question-list-mode'")))) (sx-question--mark-hidden data) (when (called-interactively-p 'any) (sx-question-list-refresh 'redisplay 'noupdate))) @@ -342,7 +342,7 @@ Non-interactively, DATA is a question alist." (interactive (list (if (derived-mode-p 'sx-question-list-mode) (tabulated-list-get-id) - (user-error "Not in `sx-question-list-mode'")))) + (sx-user-error "Not in `sx-question-list-mode'")))) (sx-question--mark-read data) (sx-question-list-next 1) (when (called-interactively-p 'any) diff --git a/sx.el b/sx.el index 096e20b..c8d4e5b 100644 --- a/sx.el +++ b/sx.el @@ -104,6 +104,11 @@ is intentionally skipped." (setq tail (cdr tail))) (setcdr tail (cons x (cdr tail))))) +(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)))) + (defun sx-message (format-string &rest args) "Display FORMAT-STRING as a message with ARGS. See `format'." -- cgit v1.2.3 From 8bccdce22f50dad70232a4e902e5770576e8e830 Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Mon, 15 Dec 2014 18:37:09 -0200 Subject: sx-display-question is not known to be defined. It was the wrong function to use anyway. --- sx-question-list.el | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/sx-question-list.el b/sx-question-list.el index e94c689..94b5be4 100644 --- a/sx-question-list.el +++ b/sx-question-list.el @@ -447,9 +447,8 @@ Displayed in `sx-question-mode--window', replacing any question that may currently be there." (interactive "p") (sx-question-list-next n) - (sx-display-question - (tabulated-list-get-id) - nil + (sx-question-mode--display + (tabulated-list-get-id) (sx-question-list--create-question-window))) (defun sx-question-list--create-question-window () -- cgit v1.2.3 From aebe7265612230aafa9ce41ebb36436f1e2c9406 Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Mon, 15 Dec 2014 18:38:32 -0200 Subject: split-string used to take only 3 args --- sx-compose.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/sx-compose.el b/sx-compose.el index d8f3b23..96f47f3 100644 --- a/sx-compose.el +++ b/sx-compose.el @@ -225,8 +225,8 @@ other keywords are read from the header " (unless (search-forward-regexp "^Tags : *\\([^[:space:]].*\\) *$" header-end 'noerror) (error "No Tags header found")) - (push (cons 'tags (split-string (match-string 1) "[[:space:],;]" - 'omit-nulls "[[:space:]]")) + (push (cons 'tags (split-string (match-string 1) + "[[:space:],;]" 'omit-nulls)) keywords) ;; And erase the header so it doesn't get sent. (delete-region -- cgit v1.2.3 From 0a2f984d0771b9a921696af1fe3bad10cdbb7b54 Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Mon, 15 Dec 2014 18:39:38 -0200 Subject: `sx-custom-button' fails to specify containing group --- sx-button.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/sx-button.el b/sx-button.el index 1727a3d..283fe0d 100644 --- a/sx-button.el +++ b/sx-button.el @@ -51,7 +51,8 @@ '((((type x w32 ns) (class color)) ; Like default mode line :box (:line-width 2 :style released-button) :background "lightgrey" :foreground "black")) - "Face used on buttons such as \"Write an Answer\".") + "Face used on buttons such as \"Write an Answer\"." + :group 'sx) ;;; Command definitions -- cgit v1.2.3 From 856ddbd4f80bb4bd1768cd98555efee2184ae6ee Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Mon, 15 Dec 2014 22:13:42 -0200 Subject: Hotfix require let-alist explicitly. Might affect #151 --- sx.el | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/sx.el b/sx.el index c8d4e5b..4ad0fd5 100644 --- a/sx.el +++ b/sx.el @@ -312,8 +312,10 @@ with a `link' property)." If ALIST doesn't have a `site' property, one is created using the `link' property." (declare (indent 1) (debug t)) - `(progn (sx--ensure-site ,alist) - (let-alist ,alist ,@body))) + `(progn + (require 'let-alist) + (sx--ensure-site ,alist) + (let-alist ,alist ,@body))) (defcustom sx-init-hook nil "Hook run when SX initializes. -- cgit v1.2.3 From 6e25c3b2e7da42c8e01daf62d79e4b66d618acf6 Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Mon, 15 Dec 2014 22:47:35 -0200 Subject: Hotfix tests --- test/tests.el | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/test/tests.el b/test/tests.el index 15c8e8b..8969c37 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 (sx--ensure-site data) + (equal '(progn (require 'let-alist) + (sx--ensure-site data) (let ((.test (cdr (assq 'test data)))) .test)) (macroexpand-all '(sx-assoc-let data .test)))) (should - (equal '(progn (sx--ensure-site data) + (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))) -- cgit v1.2.3 From 6d8a8d5dc07fb8a58344775632716dbe781479a3 Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Tue, 16 Dec 2014 12:00:32 -0200 Subject: Hotfix wrong variable --- sx-interaction.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/sx-interaction.el b/sx-interaction.el index 7d32094..e7a4d94 100644 --- a/sx-interaction.el +++ b/sx-interaction.el @@ -60,7 +60,7 @@ If no object of the requested type could be returned, an error is thrown unless NOERROR is non-nil." (or (let ((data (get-char-property (point) 'sx--data-here))) (if (null type) data - (sx-assoc-let type + (sx-assoc-let data ;; Is data of the right type? (cl-case type (question (when .title data)) -- cgit v1.2.3 From a39fa2255a253194b2a080a7aa545a0fb52db7ec 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 dc853ba..2bfa60d 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 2171ad472e1c5180bb9ac021197db04d94f3c078 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 28bb9c2d582f301bb328c2ca84ad97dcbed87abb 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 c3d6d1f689598940f29f19c328e10d7c5fff0ade 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 4983653696a89a6f7030f761307771035b92d168 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 dc853ba..6131684 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 6b370f8dfc9ffbef757230732f5d158707d7f6e0 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 e7a4d94..1e14062 100644 --- a/sx-interaction.el +++ b/sx-interaction.el @@ -286,7 +286,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 d202e1ebeddf98d3109c8f7352fceb8dd5c07eb7 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 1e14062..92f0a63 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 6e38818cf6d3c79eaf0d105e8628f066bb536579 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 cd28aeb50a49a625047f9a3d7eb20694955f87aa 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 92f0a63..8aa82a2 100644 --- a/sx-interaction.el +++ b/sx-interaction.el @@ -216,8 +216,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")) @@ -241,6 +241,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 34753b9cb10beaa529f9f56cbc5bea3d11960ea3 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 8aa82a2..c6f2639 100644 --- a/sx-interaction.el +++ b/sx-interaction.el @@ -302,7 +302,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 a5cb69f2937500e5c035ff6588c1f25a5a611833 Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Wed, 17 Dec 2014 13:23:58 -0200 Subject: Hotfix filling code blocks. Fix #163 When filling a paragraph, narrow to region after point, so we don't affect anything behind point (the code block). --- sx-question-print.el | 34 +++++++++++++++++++--------------- 1 file changed, 19 insertions(+), 15 deletions(-) diff --git a/sx-question-print.el b/sx-question-print.el index dc853ba..223049a 100644 --- a/sx-question-print.el +++ b/sx-question-print.el @@ -362,10 +362,11 @@ E.g.: (while (null (eobp)) ;; Don't fill pre blocks. (unless (sx-question-mode--dont-fill-here) - (skip-chars-forward "\r\n[:blank:]") - (fill-paragraph) - (forward-paragraph))) - (buffer-string))) + (let ((beg (point))) + (skip-chars-forward "\r\n[:blank:]") + (forward-paragraph) + (fill-region beg (point))))) + (string-trim-right (buffer-string)))) (defun sx-question-mode--dont-fill-here () "If text shouldn't be filled here, return t and skip over it." @@ -429,18 +430,21 @@ 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 (beg end) - (when (markdown-match-pre-blocks + (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 - (skip-chars-forward "\r\n[:blank:]") - (setq beg (point)))) - (setq end (point)) - (sx-babel--make-pre-button - (save-excursion - (goto-char beg) - (line-beginning-position)) - end)))) + (goto-char beg) + (line-beginning-position)) + end)) + (goto-char before) + nil))) (provide 'sx-question-print) ;;; sx-question-print.el ends here - -- cgit v1.2.3 From 925b4ef8b503b22481e624905fa6e3af8d6d4077 Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Wed, 17 Dec 2014 15:35:26 -0200 Subject: Implent getting question given answer id --- sx-question.el | 14 ++++++++++++++ 1 file changed, 14 insertions(+) diff --git a/sx-question.el b/sx-question.el index 9fb31fc..801384a 100644 --- a/sx-question.el +++ b/sx-question.el @@ -54,6 +54,20 @@ If QUESTION-ID doesn't exist on SITE, raise an error." (error "Couldn't find question %S in %S" question-id site)))) +(defun sx-question-get-from-answer (site answer-id) + "Get question from SITE to which ANSWER-ID belongs. +If ANSWER-ID doesn't exist on SITE, raise an error." + (let ((res (sx-method-call 'answers + :id answer-id + :site site + :submethod 'questions + :auth t + :filter sx-browse-filter))) + (if (vectorp res) + (elt res 0) + (error "Couldn't find answer %S in %S" + answer-id site)))) + ;;; Question Properties -- cgit v1.2.3 From e39a909dc722dfdb48ecc4533cf061dbb209abf1 Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Wed, 17 Dec 2014 15:35:54 -0200 Subject: Implement identifying type, id, and site of a link. --- sx-interaction.el | 1 + sx.el | 16 ++++++++++++++++ 2 files changed, 17 insertions(+) diff --git a/sx-interaction.el b/sx-interaction.el index e7a4d94..2c392e1 100644 --- a/sx-interaction.el +++ b/sx-interaction.el @@ -128,6 +128,7 @@ If DATA is a question, also mark it as read." (sx-question--mark-read data) (sx--maybe-update-display)))) + ;;; Displaying (defun sx-display-question (&optional data focus window) diff --git a/sx.el b/sx.el index 4ad0fd5..7d67835 100644 --- a/sx.el +++ b/sx.el @@ -317,6 +317,22 @@ If ALIST doesn't have a `site' property, one is created using the (sx--ensure-site ,alist) (let-alist ,alist ,@body))) +(defun sx--link-to-data (link) + "Convert string LINK into data that can be displayed." + (let ((result (list (cons 'site (sx--site link))))) + (when (or + ;; Answer + (and (or (string-match "/a/\\([0-9]+\\)/[0-9]+\\(#.*\\|\\)\\'" link) + (string-match "/questions/[0-9]+/[^/]+/\\([0-9]\\)/?\\(#.*\\|\\)\\'" link)) + (push (cons 'type 'answer) result)) + ;; Question + (and (or (string-match "/q/\\([0-9]+\\)/[0-9]+\\(#.*\\|\\)\\'" link) + (string-match "/questions/\\([0-9]+\\)/" link)) + (push (cons 'type 'question) result))) + (push (cons 'id (string-to-number (match-string-no-properties 1 link))) + result)) + result)) + (defcustom sx-init-hook nil "Hook run when SX initializes. Run after `sx-init--internal-hook'." -- cgit v1.2.3 From 641beffbc3ce72b4e1b9b6bbb79880ba795fdf72 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 223049a..3d698cc 100644 --- a/sx-question-print.el +++ b/sx-question-print.el @@ -366,7 +366,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 9ba5f7751c088a3bbad7d98a5cf3cf23a08f1bf8 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 3d698cc..a1b7589 100644 --- a/sx-question-print.el +++ b/sx-question-print.el @@ -371,6 +371,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:]") @@ -446,5 +447,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 df276818b6275f795f4504b5df36505a7f79c8ee 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 a1b7589..46e18ca 100644 --- a/sx-question-print.el +++ b/sx-question-print.el @@ -370,19 +370,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." @@ -431,32 +431,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 b3008bf4e11bb4a5bc67a82f7bebd3f38520d0af 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 46e18ca..6c98c36 100644 --- a/sx-question-print.el +++ b/sx-question-print.el @@ -375,6 +375,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) @@ -443,5 +444,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 2a77336ccbe19acdfd176b7198736a78be887e04 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 6c98c36..97124e9 100644 --- a/sx-question-print.el +++ b/sx-question-print.el @@ -376,6 +376,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) @@ -451,5 +452,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 806910361bb26b76a585c23c1bd695e38da2dc9a 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 97124e9..996b057 100644 --- a/sx-question-print.el +++ b/sx-question-print.el @@ -368,24 +368,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 @@ -429,6 +413,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 5eb81aebc2b5131fff7c4a4d33c163cec2cf3844 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 996b057..c6176fc 100644 --- a/sx-question-print.el +++ b/sx-question-print.el @@ -431,7 +431,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. @@ -441,7 +443,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 3be41a8af1f98abfc8b2a43ce09c08586bee1075 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 6131684..d0802d6 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 af62c86d0c2032949644941eaf524ead4ffa0adf 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 767570b1d5d6511726609265ee61c26aa9fe0332 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 9f37b10..f11449b 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 486b950836a99b8eff847cecadd861426467284b 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 b376616..8fe6dfb 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 f80f38e87c86070433a9a8c2a6fbf75b490b6875 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 4ad0fd5..6f4e7c7 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 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 d7ebf1515548e3bb01612fabba5de5d68a783f23 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 b15813ac1a681ef075c207f1a90f3cb167653d83 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 94b5be4..6537d2b 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) ("u" sx-toggle-upvote) -- cgit v1.2.3 From 30eeaaad19858edb4543d60772b93adb7e7736be 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 139c4d81545cd8428de7864294c754fbe8f3267e 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 8fe6dfb..8d06078 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 5ee595c3740c2b24274c9405e4bed4a5ae81953f Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Sat, 20 Dec 2014 15:39:58 -0200 Subject: Indentation was off by one --- sx-request.el | 68 +++++++++++++++++++++++++++++------------------------------ 1 file changed, 34 insertions(+), 34 deletions(-) diff --git a/sx-request.el b/sx-request.el index 2d894f0..389a471 100644 --- a/sx-request.el +++ b/sx-request.el @@ -121,40 +121,40 @@ the main content of the response is returned." (url-request-extra-headers '(("Content-Type" . "application/x-www-form-urlencoded"))) (response-buffer (url-retrieve-synchronously request-url))) - (if (not response-buffer) - (error "Something went wrong in `url-retrieve-synchronously'") - (with-current-buffer response-buffer - (let* ((data (progn - ;; @TODO use url-http-end-of-headers - (goto-char (point-min)) - (if (not (search-forward "\n\n" nil t)) - (error "Headers missing; response corrupt") - (delete-region (point-min) (point)) - (buffer-string)))) - (response-zipped-p (sx-encoding-gzipped-p data)) - (data (if (not response-zipped-p) data - (shell-command-on-region - (point-min) (point-max) - sx-request-unzip-program - nil t) - (buffer-string))) - ;; @TODO should use `condition-case' here -- set - ;; RESPONSE to 'corrupt or something - (response (with-demoted-errors "`json' error: %S" - (json-read-from-string data)))) - (when (and (not response) (string-equal data "{}")) - (sx-message "Unable to parse response: %S" response) - (error "Response could not be read by `json-read-from-string'")) - ;; If we get here, the response is a valid data structure - (sx-assoc-let response - (when .error_id - (error "Request failed: (%s) [%i %s] %S" - .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-request-remaining-api-requests)) - (sx-encoding-clean-content-deep .items))))))) + (if (not response-buffer) + (error "Something went wrong in `url-retrieve-synchronously'") + (with-current-buffer response-buffer + (let* ((data (progn + ;; @TODO use url-http-end-of-headers + (goto-char (point-min)) + (if (not (search-forward "\n\n" nil t)) + (error "Headers missing; response corrupt") + (delete-region (point-min) (point)) + (buffer-string)))) + (response-zipped-p (sx-encoding-gzipped-p data)) + (data (if (not response-zipped-p) data + (shell-command-on-region + (point-min) (point-max) + sx-request-unzip-program + nil t) + (buffer-string))) + ;; @TODO should use `condition-case' here -- set + ;; RESPONSE to 'corrupt or something + (response (with-demoted-errors "`json' error: %S" + (json-read-from-string data)))) + (when (and (not response) (string-equal data "{}")) + (sx-message "Unable to parse response: %S" response) + (error "Response could not be read by `json-read-from-string'")) + ;; If we get here, the response is a valid data structure + (sx-assoc-let response + (when .error_id + (error "Request failed: (%s) [%i %s] %S" + .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-request-remaining-api-requests)) + (sx-encoding-clean-content-deep .items))))))) (defun sx-request-fallback (_method &optional _args _request-method) "Fallback method when authentication is not available. -- cgit v1.2.3 From 0c380f42cf56e64d3b4446b6168fa8028760d8c5 Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Sat, 20 Dec 2014 15:47:56 -0200 Subject: Prefer zlib-decompress-region when available. Fix #157 --- sx-request.el | 15 ++++++++++----- 1 file changed, 10 insertions(+), 5 deletions(-) diff --git a/sx-request.el b/sx-request.el index 389a471..9f2ecdb 100644 --- a/sx-request.el +++ b/sx-request.el @@ -70,7 +70,11 @@ (defcustom sx-request-unzip-program "gunzip" "Program used to unzip the response if it is compressed. -This program must accept compressed data on standard input." +This program must accept compressed data on standard input. + +This is only used (and necessary) if the function +`zlib-decompress-region' is not defined, which is the case for +Emacs versions < 24.4." :group 'sx :type 'string) @@ -133,10 +137,11 @@ the main content of the response is returned." (buffer-string)))) (response-zipped-p (sx-encoding-gzipped-p data)) (data (if (not response-zipped-p) data - (shell-command-on-region - (point-min) (point-max) - sx-request-unzip-program - nil t) + (if (fboundp 'zlib-decompress-region) + (zlib-decompress-region (point-min) (point-max)) + (shell-command-on-region + (point-min) (point-max) + sx-request-unzip-program nil t)) (buffer-string))) ;; @TODO should use `condition-case' here -- set ;; RESPONSE to 'corrupt or something -- cgit v1.2.3 From a56f77ba8d990e0bf0333b5b93b9cdd1bf55b33f Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Sat, 20 Dec 2014 16:10:01 -0200 Subject: Handle utf-8 encoding the right way. --- sx-question-print.el | 3 --- sx-request.el | 19 ++++++++++++------- 2 files changed, 12 insertions(+), 10 deletions(-) diff --git a/sx-question-print.el b/sx-question-print.el index 2f07132..b58a84a 100644 --- a/sx-question-print.el +++ b/sx-question-print.el @@ -182,9 +182,6 @@ QUESTION must be a data structure returned by `json-read'." (mapc #'sx-question-mode--print-section .answers)) (insert "\n\n ") (insert-text-button "Write an Answer" :type 'sx-button-answer) - ;; Display weird chars correctly - (set-buffer-multibyte nil) - (set-buffer-multibyte t) ;; Go up (goto-char (point-min)) (sx-question-mode-next-section)) diff --git a/sx-request.el b/sx-request.el index 9f2ecdb..1031ea7 100644 --- a/sx-request.el +++ b/sx-request.el @@ -136,13 +136,18 @@ the main content of the response is returned." (delete-region (point-min) (point)) (buffer-string)))) (response-zipped-p (sx-encoding-gzipped-p data)) - (data (if (not response-zipped-p) data - (if (fboundp 'zlib-decompress-region) - (zlib-decompress-region (point-min) (point-max)) - (shell-command-on-region - (point-min) (point-max) - sx-request-unzip-program nil t)) - (buffer-string))) + (data + ;; Turn string of bytes into string of characters. See + ;; http://emacs.stackexchange.com/q/4100/50 + (decode-coding-string + (if (not response-zipped-p) data + (if (fboundp 'zlib-decompress-region) + (zlib-decompress-region (point-min) (point-max)) + (shell-command-on-region + (point-min) (point-max) + sx-request-unzip-program nil t)) + (buffer-string)) + 'utf-8 'nocopy)) ;; @TODO should use `condition-case' here -- set ;; RESPONSE to 'corrupt or something (response (with-demoted-errors "`json' error: %S" -- cgit v1.2.3 From 29946095d687a44224e30b21198b2c872233e8d3 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 e0f4f8e85e818f718dd8b04deed1b5d4c50541df 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 8d1c9e8a29e890d1d37c5caa649a0861b1621bfa Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Wed, 17 Dec 2014 15:44:45 -0200 Subject: sx-open-link: command to visit links inside SX --- sx-interaction.el | 13 +++++++++++++ 1 file changed, 13 insertions(+) diff --git a/sx-interaction.el b/sx-interaction.el index 2c392e1..38efe5d 100644 --- a/sx-interaction.el +++ b/sx-interaction.el @@ -128,6 +128,19 @@ If DATA is a question, also mark it as read." (sx-question--mark-read data) (sx--maybe-update-display)))) +(defun sx-open-link (link) + "Visit element given by LINK inside Emacs. +Element can be a question, answer, or comment." + (interactive "sLink: ") + (let ((data (sx--link-to-data link))) + (sx-assoc-let data + (cl-case .type + (answer + (sx-display-question + (sx-question-get-from-answer .site .id) 'focus)) + (question + (sx-display-question + (sx-question-get-question .site .id) 'focus)))))) ;;; Displaying -- cgit v1.2.3 From abaad8b3c57355be672e13a2f5cdff3d651e91d0 Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Sat, 20 Dec 2014 16:59:09 -0200 Subject: Refactor sx-visit to sx-visit-externally --- sx-interaction.el | 2 +- sx-question-list.el | 2 +- sx-question-mode.el | 2 +- 3 files changed, 3 insertions(+), 3 deletions(-) diff --git a/sx-interaction.el b/sx-interaction.el index 38efe5d..ed8891b 100644 --- a/sx-interaction.el +++ b/sx-interaction.el @@ -106,7 +106,7 @@ Only fields contained in TO are copied." ;;; Visiting -(defun sx-visit (data &optional copy-as-kill) +(defun sx-visit-externally (data &optional copy-as-kill) "Visit DATA in a web browser. DATA can be a question, answer, or comment. Interactively, it is derived from point position. diff --git a/sx-question-list.el b/sx-question-list.el index 94b5be4..f6a82e2 100644 --- a/sx-question-list.el +++ b/sx-question-list.el @@ -317,7 +317,7 @@ into consideration. (":" sx-question-list-switch-site) ("t" sx-question-list-switch-tab) ("a" sx-ask) - ("v" sx-visit) + ("v" sx-visit-externally) ("u" sx-toggle-upvote) ("d" sx-toggle-downvote) ("h" sx-question-list-hide) diff --git a/sx-question-mode.el b/sx-question-mode.el index b376616..807eeea 100644 --- a/sx-question-mode.el +++ b/sx-question-mode.el @@ -224,7 +224,7 @@ Letters do not insert themselves; instead, they are commands. ("p" sx-question-mode-previous-section) ("g" sx-question-mode-refresh) ("c" sx-comment) - ("v" sx-visit) + ("v" sx-visit-externally) ("u" sx-toggle-upvote) ("d" sx-toggle-downvote) ("q" quit-window) -- cgit v1.2.3 From 72cdd44dbfe6266f33471012091b58f85d5b7d88 Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Sat, 20 Dec 2014 17:03:59 -0200 Subject: sx-open-link takes link from clipboard by default --- sx-interaction.el | 6 +++++- 1 file changed, 5 insertions(+), 1 deletion(-) diff --git a/sx-interaction.el b/sx-interaction.el index ed8891b..2b41b35 100644 --- a/sx-interaction.el +++ b/sx-interaction.el @@ -131,7 +131,11 @@ If DATA is a question, also mark it as read." (defun sx-open-link (link) "Visit element given by LINK inside Emacs. Element can be a question, answer, or comment." - (interactive "sLink: ") + (interactive + (let ((def (with-temp-buffer + (save-excursion (yank)) + (thing-at-point 'url)))) + (list (read-string (concat "Link (" def "): ") nil nil def)))) (let ((data (sx--link-to-data link))) (sx-assoc-let data (cl-case .type -- cgit v1.2.3 From fb52d842299e1826915bcae5c6fbb6e0e1f617ec Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Sat, 20 Dec 2014 17:04:20 -0200 Subject: whitespace --- sx-interaction.el | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/sx-interaction.el b/sx-interaction.el index 2b41b35..ea494eb 100644 --- a/sx-interaction.el +++ b/sx-interaction.el @@ -152,7 +152,7 @@ Element can be a question, answer, or comment." "Display question given by DATA, on WINDOW. When DATA is nil, display question under point. When FOCUS is non-nil (the default when called interactively), also focus the -relevant window. +relevant window. If WINDOW nil, the window is decided by `sx-question-mode-display-buffer-function'." @@ -260,13 +260,13 @@ TEXT is a string. Interactively, it is read from the minibufer." (defun sx--get-post (type site id) "Find in the database a post identified by TYPE, SITE and ID. -TYPE is `question' or `answer'. +TYPE is `question' or `answer'. SITE is a string. ID is an integer." (let ((db (cons sx-question-mode--data sx-question-list--dataset))) (setq db - (cond + (cond ((string= type "question") db) ((string= type "answer") (apply #'cl-map 'list #'identity -- cgit v1.2.3 From 845cd697b1326f8c270dd2c76a6c120d3196428b Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Sun, 21 Dec 2014 21:42:01 -0200 Subject: Add screenshot --- README.org | 8 +++++--- list-and-question.png | Bin 0 -> 450796 bytes 2 files changed, 5 insertions(+), 3 deletions(-) create mode 100644 list-and-question.png diff --git a/README.org b/README.org index db47904..b9888a7 100644 --- a/README.org +++ b/README.org @@ -4,9 +4,11 @@ [[https://gitter.im/vermiculus/sx.el?utm_source=badge&utm_medium=badge&utm_campaign=pr-badge&utm_content=badge][https://badges.gitter.im/Join Chat.svg]] [[https://www.waffle.io/vermiculus/sx.el][https://badge.waffle.io/vermiculus/sx.el.svg]] -SX will be a full featured Stack Exchange mode for GNU Emacs 24+. Using the -official API, we aim to create a more versatile experience for the Stack -Exchange network within Emacs itself. +SX is a full featured Stack Exchange mode for GNU Emacs 24+. Using the official +API, it provides a versatile experience for the Stack Exchange network within +Emacs itself. + +[[file:list-and-question.png]] * Features ** Viewing Questions diff --git a/list-and-question.png b/list-and-question.png new file mode 100644 index 0000000..9e89fec Binary files /dev/null and b/list-and-question.png differ -- cgit v1.2.3 From 6eb53ee0f12dd9f7d444e6749f6cc55c6db62078 Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Tue, 23 Dec 2014 23:54:14 -0200 Subject: Define assoc let first --- sx.el | 68 +++++++++++++++++++++++++++++++++---------------------------------- 1 file changed, 34 insertions(+), 34 deletions(-) diff --git a/sx.el b/sx.el index 6f4e7c7..a31c0a0 100644 --- a/sx.el +++ b/sx.el @@ -50,6 +50,40 @@ (interactive) (browse-url "https://github.com/vermiculus/sx.el/issues/new")) + +;;; Site +(defun sx--site (data) + "Get the site in which DATA belongs. +DATA can be a question, answer, comment, or user (or any object +with a `link' property). +DATA can also be the link itself." + (let ((link (if (stringp data) data + (cdr (assoc 'link data))))) + (when (stringp link) + (replace-regexp-in-string + "^https?://\\(?:\\(?1:[^/]+\\)\\.stackexchange\\|\\(?2:[^/]+\\)\\)\\.[^.]+/.*$" + "\\1\\2" link)))) + +(defun sx--ensure-site (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 + (unless (assq 'site data) + (setcdr data (cons (cons 'site (sx--site data)) + (cdr data)))) + data)) + +(defmacro sx-assoc-let (alist &rest body) + "Identical to `let-alist', except `.site' has a special meaning. +If ALIST doesn't have a `site' property, one is created using the +`link' property." + (declare (indent 1) (debug t)) + `(progn + (require 'let-alist) + (sx--ensure-site ,alist) + (let-alist ,alist ,@body))) + ;;; Browsing filter (defvar sx-browse-filter @@ -284,40 +318,6 @@ removed from the display name before it is returned." (format "[%s]" (car kar)) (cdr kar) string))) string)) - -;;; Site -(defun sx--site (data) - "Get the site in which DATA belongs. -DATA can be a question, answer, comment, or user (or any object -with a `link' property). -DATA can also be the link itself." - (let ((link (if (stringp data) data - (cdr (assoc 'link data))))) - (when (stringp link) - (replace-regexp-in-string - "^https?://\\(?:\\(?1:[^/]+\\)\\.stackexchange\\|\\(?2:[^/]+\\)\\)\\.[^.]+/.*$" - "\\1\\2" link)))) - -(defun sx--ensure-site (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 - (unless (assq 'site data) - (setcdr data (cons (cons 'site (sx--site data)) - (cdr data)))) - data)) - -(defmacro sx-assoc-let (alist &rest body) - "Identical to `let-alist', except `.site' has a special meaning. -If ALIST doesn't have a `site' property, one is created using the -`link' property." - (declare (indent 1) (debug t)) - `(progn - (require 'let-alist) - (sx--ensure-site ,alist) - (let-alist ,alist ,@body))) - (defcustom sx-init-hook nil "Hook run when SX initializes. Run after `sx-init--internal-hook'." -- cgit v1.2.3 From 31a3e357261641228186692ab3a9ac0a053d197b Mon Sep 17 00:00:00 2001 From: Sean Allred Date: Fri, 26 Dec 2014 16:40:30 -0500 Subject: Simpler syntax for quoted cons cells --- sx.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/sx.el b/sx.el index 7d67835..8913024 100644 --- a/sx.el +++ b/sx.el @@ -324,11 +324,11 @@ If ALIST doesn't have a `site' property, one is created using the ;; Answer (and (or (string-match "/a/\\([0-9]+\\)/[0-9]+\\(#.*\\|\\)\\'" link) (string-match "/questions/[0-9]+/[^/]+/\\([0-9]\\)/?\\(#.*\\|\\)\\'" link)) - (push (cons 'type 'answer) result)) + (push '(type . answer) result)) ;; Question (and (or (string-match "/q/\\([0-9]+\\)/[0-9]+\\(#.*\\|\\)\\'" link) (string-match "/questions/\\([0-9]+\\)/" link)) - (push (cons 'type 'question) result))) + (push '(type . question) result))) (push (cons 'id (string-to-number (match-string-no-properties 1 link))) result)) result)) -- cgit v1.2.3 From 0e54ca6ad3e4cf11b5512fadef39066e955e6281 Mon Sep 17 00:00:00 2001 From: Sean Allred Date: Fri, 26 Dec 2014 16:55:32 -0500 Subject: Use `rx' macro for some regular expressions --- sx.el | 25 +++++++++++++++++++++---- 1 file changed, 21 insertions(+), 4 deletions(-) diff --git a/sx.el b/sx.el index 8913024..091526f 100644 --- a/sx.el +++ b/sx.el @@ -322,12 +322,29 @@ If ALIST doesn't have a `site' property, one is created using the (let ((result (list (cons 'site (sx--site link))))) (when (or ;; Answer - (and (or (string-match "/a/\\([0-9]+\\)/[0-9]+\\(#.*\\|\\)\\'" link) - (string-match "/questions/[0-9]+/[^/]+/\\([0-9]\\)/?\\(#.*\\|\\)\\'" link)) + (and (or (string-match + (rx "/a/" (group (1+ digit)) "/" + (1+ digit) + (group (or (sequence "#" (0+ any)) "")) + string-end) link) + (string-match + (rx "/questions/" (1+ digit) "/" + (1+ (not (any "/"))) "/" + (group digit) + (optional "/") + (group (or (sequence "#" (0+ any)) "")) + string-end) link)) (push '(type . answer) result)) ;; Question - (and (or (string-match "/q/\\([0-9]+\\)/[0-9]+\\(#.*\\|\\)\\'" link) - (string-match "/questions/\\([0-9]+\\)/" link)) + (and (or (string-match + (rx "/q/" + (group (1+ digit)) "/" + (1+ digit) + (group (or (sequence "#" (0+ any)) "")) + string-end) link) + (string-match + (rx "/questions/" + (group (1+ digit)) "/") link)) (push '(type . question) result))) (push (cons 'id (string-to-number (match-string-no-properties 1 link))) result)) -- cgit v1.2.3 From 60e483c5f6bfa5ea897f3bc6f85f402b09f63d9e Mon Sep 17 00:00:00 2001 From: Sean Allred Date: Fri, 26 Dec 2014 17:21:26 -0500 Subject: Groups on their own lines Ideally, these groups would have explanations of what they capture. For now, the official stance is 'eh'. --- sx.el | 8 ++++++-- 1 file changed, 6 insertions(+), 2 deletions(-) diff --git a/sx.el b/sx.el index 091526f..7f6b901 100644 --- a/sx.el +++ b/sx.el @@ -323,7 +323,10 @@ If ALIST doesn't have a `site' property, one is created using the (when (or ;; Answer (and (or (string-match - (rx "/a/" (group (1+ digit)) "/" + (rx "/a/" + ;; Answer ID + (group (1+ digit)) + "/" (1+ digit) (group (or (sequence "#" (0+ any)) "")) string-end) link) @@ -344,7 +347,8 @@ If ALIST doesn't have a `site' property, one is created using the string-end) link) (string-match (rx "/questions/" - (group (1+ digit)) "/") link)) + (group (1+ digit)) + "/") link)) (push '(type . question) result))) (push (cons 'id (string-to-number (match-string-no-properties 1 link))) result)) -- cgit v1.2.3 From d732176007abdcc3395f7188dc918981d9ff2801 Mon Sep 17 00:00:00 2001 From: Sean Allred Date: Fri, 26 Dec 2014 17:22:03 -0500 Subject: `rx'-ify regular expression --- sx.el | 10 +++++++++- 1 file changed, 9 insertions(+), 1 deletion(-) diff --git a/sx.el b/sx.el index 7f6b901..19c5f12 100644 --- a/sx.el +++ b/sx.el @@ -294,7 +294,15 @@ DATA can also be the link itself." (cdr (assoc 'link data))))) (when (stringp link) (replace-regexp-in-string - "^https?://\\(?:\\(?1:[^/]+\\)\\.stackexchange\\|\\(?2:[^/]+\\)\\)\\.[^.]+/.*$" + (rx line-start "http" (optional "s") "://" + (or + (sequence + (group-n 1 (+ (not (any "/")))) + ".stackexchange") + (group-n 2 (+ (not (any "/"))))) + "." (+ (not (any "."))) + "/" (* any) + line-end) "\\1\\2" link)))) (defun sx--ensure-site (data) -- cgit v1.2.3 From 970acd6f7e5920ed6492a4a74e65eae9e29838b6 Mon Sep 17 00:00:00 2001 From: Sean Allred Date: Fri, 26 Dec 2014 17:34:37 -0500 Subject: Add some explanatory comments --- sx.el | 21 ++++++++++++++++----- 1 file changed, 16 insertions(+), 5 deletions(-) diff --git a/sx.el b/sx.el index 19c5f12..c460f62 100644 --- a/sx.el +++ b/sx.el @@ -328,19 +328,24 @@ 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))))) + ;; Try to strip a question or answer ID (when (or ;; Answer (and (or (string-match + ;; From 'Share' button (rx "/a/" - ;; Answer ID + ;; Question ID (group (1+ digit)) - "/" - (1+ digit) + ;; User ID + "/" (1+ digit) + ;; Answer ID (group (or (sequence "#" (0+ any)) "")) string-end) link) (string-match + ;; From URL (rx "/questions/" (1+ digit) "/" (1+ (not (any "/"))) "/" + ;; User ID (group digit) (optional "/") (group (or (sequence "#" (0+ any)) "")) @@ -348,13 +353,19 @@ If ALIST doesn't have a `site' property, one is created using the (push '(type . answer) result)) ;; Question (and (or (string-match + ;; From 'Share' button (rx "/q/" - (group (1+ digit)) "/" - (1+ digit) + ;; Question ID + (group (1+ digit)) + ;; User ID + "/" (1+ digit) + ;; Answer or Comment ID (group (or (sequence "#" (0+ any)) "")) string-end) link) (string-match + ;; From URL (rx "/questions/" + ;; Question ID (group (1+ digit)) "/") link)) (push '(type . question) result))) -- cgit v1.2.3 From b87861b6187ef4395e77e34882401f7fb28dfa26 Mon Sep 17 00:00:00 2001 From: Sean Allred Date: Fri, 26 Dec 2014 17:35:25 -0500 Subject: Make user IDs optional when parsing from link --- sx.el | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/sx.el b/sx.el index c460f62..4ef6caf 100644 --- a/sx.el +++ b/sx.el @@ -346,7 +346,7 @@ If ALIST doesn't have a `site' property, one is created using the (rx "/questions/" (1+ digit) "/" (1+ (not (any "/"))) "/" ;; User ID - (group digit) + (optional (group digit)) (optional "/") (group (or (sequence "#" (0+ any)) "")) string-end) link)) @@ -358,7 +358,7 @@ If ALIST doesn't have a `site' property, one is created using the ;; Question ID (group (1+ digit)) ;; User ID - "/" (1+ digit) + (optional "/" (1+ digit)) ;; Answer or Comment ID (group (or (sequence "#" (0+ any)) "")) string-end) link) -- cgit v1.2.3 From a935ee7e5aa887f345b50aa4e922732e31157628 Mon Sep 17 00:00:00 2001 From: Sean Allred Date: Fri, 26 Dec 2014 17:35:51 -0500 Subject: User IDs are very often more than one digit --- sx.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/sx.el b/sx.el index 4ef6caf..d1c7633 100644 --- a/sx.el +++ b/sx.el @@ -346,7 +346,7 @@ If ALIST doesn't have a `site' property, one is created using the (rx "/questions/" (1+ digit) "/" (1+ (not (any "/"))) "/" ;; User ID - (optional (group digit)) + (optional (group (+ digit))) (optional "/") (group (or (sequence "#" (0+ any)) "")) string-end) link)) -- cgit v1.2.3 From 0354bf2c974b13967558187936918db4af125571 Mon Sep 17 00:00:00 2001 From: Sean Allred Date: Fri, 26 Dec 2014 17:37:17 -0500 Subject: Modify rx forms to be `rx-greedy-flag'-independent See `rx' documentation for details. --- sx.el | 20 ++++++++++---------- 1 file changed, 10 insertions(+), 10 deletions(-) diff --git a/sx.el b/sx.el index d1c7633..c9b5d76 100644 --- a/sx.el +++ b/sx.el @@ -335,20 +335,20 @@ If ALIST doesn't have a `site' property, one is created using the ;; From 'Share' button (rx "/a/" ;; Question ID - (group (1+ digit)) + (group (+ digit)) ;; User ID - "/" (1+ digit) + "/" (+ digit) ;; Answer ID - (group (or (sequence "#" (0+ any)) "")) + (group (or (sequence "#" (* any)) "")) string-end) link) (string-match ;; From URL - (rx "/questions/" (1+ digit) "/" - (1+ (not (any "/"))) "/" + (rx "/questions/" (+ digit) "/" + (+ (not (any "/"))) "/" ;; User ID (optional (group (+ digit))) (optional "/") - (group (or (sequence "#" (0+ any)) "")) + (group (or (sequence "#" (* any)) "")) string-end) link)) (push '(type . answer) result)) ;; Question @@ -356,17 +356,17 @@ If ALIST doesn't have a `site' property, one is created using the ;; From 'Share' button (rx "/q/" ;; Question ID - (group (1+ digit)) + (group (+ digit)) ;; User ID - (optional "/" (1+ digit)) + (optional "/" (+ digit)) ;; Answer or Comment ID - (group (or (sequence "#" (0+ any)) "")) + (group (or (sequence "#" (* any)) "")) string-end) link) (string-match ;; From URL (rx "/questions/" ;; Question ID - (group (1+ digit)) + (group (+ digit)) "/") link)) (push '(type . question) result))) (push (cons 'id (string-to-number (match-string-no-properties 1 link))) -- cgit v1.2.3 From 57976619d5bf17b6b822a4e0159dee4aab673b33 Mon Sep 17 00:00:00 2001 From: Sean Allred Date: Sat, 27 Dec 2014 00:01:34 -0500 Subject: Use string-start/-end instead of line-start/-end --- sx.el | 5 +++-- 1 file changed, 3 insertions(+), 2 deletions(-) diff --git a/sx.el b/sx.el index c9fbf75..508de46 100644 --- a/sx.el +++ b/sx.el @@ -61,7 +61,8 @@ DATA can also be the link itself." (cdr (assoc 'link data))))) (when (stringp link) (replace-regexp-in-string - (rx line-start "http" (optional "s") "://" + (rx string-start + "http" (optional "s") "://" (or (sequence (group-n 1 (+ (not (any "/")))) @@ -69,7 +70,7 @@ DATA can also be the link itself." (group-n 2 (+ (not (any "/"))))) "." (+ (not (any "."))) "/" (* any) - line-end) + string-end) "\\1\\2" link)))) (defun sx--ensure-site (data) -- cgit v1.2.3 From 2fd7f5e04662b435b66009064257355b742b187d Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Sat, 27 Dec 2014 11:58:36 -0200 Subject: Hotfix Empty question buffer. --- sx-compose.el | 3 ++- 1 file changed, 2 insertions(+), 1 deletion(-) diff --git a/sx-compose.el b/sx-compose.el index 5201435..ab4a58d 100644 --- a/sx-compose.el +++ b/sx-compose.el @@ -149,7 +149,8 @@ respectively added locally to `sx-compose-before-send-hook' and (error "Invalid PARENT")) (let ((is-question (and (listp parent) - (cdr (assoc 'title parent))))) + (or (null parent) + (cdr (assoc 'title parent)))))) (with-current-buffer (sx-compose--get-buffer-create site parent) (sx-compose-mode) (setq sx-compose--send-function -- cgit v1.2.3 From 60bed65f15505261dd297fcf4ad2c71a7c76dbeb Mon Sep 17 00:00:00 2001 From: Sean Allred Date: Sat, 27 Dec 2014 09:56:03 -0500 Subject: Add autoload cookie to `sx-ask' --- sx-interaction.el | 1 + 1 file changed, 1 insertion(+) diff --git a/sx-interaction.el b/sx-interaction.el index c6f2639..baf8c13 100644 --- a/sx-interaction.el +++ b/sx-interaction.el @@ -327,6 +327,7 @@ from context at point." (sx-site-get-api-tokens) nil t nil nil default))) +;;;###autoload (defun sx-ask (site) "Start composing a question for SITE. SITE is a string, indicating where the question will be posted." -- cgit v1.2.3 From 531d3d911990a5f9eed6646af24b2f55ae128aa3 Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Sat, 27 Dec 2014 16:11:57 -0200 Subject: Hotfix Mark hidden sends point to (bob) --- sx-question-list.el | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/sx-question-list.el b/sx-question-list.el index 62ce032..4bd6478 100644 --- a/sx-question-list.el +++ b/sx-question-list.el @@ -333,6 +333,11 @@ Non-interactively, DATA is a question alist." (tabulated-list-get-id) (sx-user-error "Not in `sx-question-list-mode'")))) (sx-question--mark-hidden data) + ;; The current entry will not be present after the list is + ;; redisplayed. To avoid `tabulated-list-mode' getting lost (and + ;; sending us to the top) we move to the next entry before + ;; redisplaying. + (forward-line 1) (when (called-interactively-p 'any) (sx-question-list-refresh 'redisplay 'noupdate))) -- cgit v1.2.3 From 1ab0df0975e67a626c95d89120ae0c0e2fdcf9ff Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Sat, 27 Dec 2014 19:33:26 -0200 Subject: Fix `sx-question--mark-hidden', which was just plain wrong. --- sx-question.el | 15 +++++++-------- 1 file changed, 7 insertions(+), 8 deletions(-) diff --git a/sx-question.el b/sx-question.el index 801384a..03ebb4b 100644 --- a/sx-question.el +++ b/sx-question.el @@ -159,14 +159,13 @@ If no cache exists for it, initialize one with SITE." (let ((site-cell (assoc .site 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) - ;; Question wasn't present. - ;; Add it in, but make sure it's sorted (just in case we need - ;; it later). - (sx-sorted-insert-skip-first .question_id site-cell >) - ;; This causes a small lag on `j' and `k' as the list gets large. - ;; Should we do this on a timer? + (if (null site-cell) + ;; First question from this site. + (push (list .site .question_id) sx-question--user-hidden-list) + ;; Not first question and question wasn't present. + ;; Add it in, but make sure it's sorted (just in case we + ;; decide to rely on it later). + (sx-sorted-insert-skip-first .question_id site-cell >)) ;; Save the results. (sx-cache-set 'hidden-questions sx-question--user-hidden-list))))) -- 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 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 5babd59dfd51b5dd33cfd411fc2c2754adf63381 Mon Sep 17 00:00:00 2001 From: Sean Allred Date: Fri, 2 Jan 2015 00:15:09 -0500 Subject: Add process-function to sx-request-make --- sx-request.el | 16 ++++++++++++---- 1 file changed, 12 insertions(+), 4 deletions(-) diff --git a/sx-request.el b/sx-request.el index bc34f9c..f1d20af 100644 --- a/sx-request.el +++ b/sx-request.el @@ -95,13 +95,13 @@ number of requests left every time it finishes a call." ;;; Making Requests -(defun sx-request-make (method &optional args request-method) +(defun sx-request-make (method &optional args request-method process-function) "Make a request to the API, executing METHOD with ARGS. You should almost certainly be using `sx-method-call' instead of this function. REQUEST-METHOD is one of `GET' (default) or `POST'. -Returns cleaned response content. -See (`sx-encoding-clean-content-deep'). +Returns the entire response as processed by PROCESS-FUNCTION. +This defaults to `sx-request-response-get-items'. The full set of arguments is built with `sx-request--build-keyword-arguments', prepending @@ -164,7 +164,8 @@ the main content of the response is returned." sx-request-remaining-api-requests-message-threshold) (sx-message "%d API requests remaining" sx-request-remaining-api-requests)) - (sx-encoding-clean-content-deep .items))))))) + (funcall (or process-function #'sx-request-response-get-items) + response))))))) (defun sx-request-fallback (_method &optional _args _request-method) "Fallback method when authentication is not available. @@ -205,6 +206,13 @@ false, use the symbol `false'. Each element is processed with alist)) "&"))) + +;;; Response Processors +(defun sx-request-response-get-items (response) + "Returns the items from RESPONSE." + (sx-assoc-let response + (sx-encoding-clean-content-deep .items))) + (provide 'sx-request) ;;; sx-request.el ends here -- cgit v1.2.3 From 27eb38cfc4bba9013e8454bbe81ce497bf224474 Mon Sep 17 00:00:00 2001 From: Sean Allred Date: Fri, 2 Jan 2015 00:59:59 -0500 Subject: Introduce `sx-request-all-items' This function repeatedly makes API requests until a condition is satisfied (such as 'no more items'). First and foremost, this will allow us to retrieve all tags for a site. --- sx-request.el | 32 ++++++++++++++++++++++++++++++++ test/test-api.el | 5 +++++ 2 files changed, 37 insertions(+) diff --git a/sx-request.el b/sx-request.el index f1d20af..387bde5 100644 --- a/sx-request.el +++ b/sx-request.el @@ -94,6 +94,35 @@ number of requests left every time it finishes a call." ;;; Making Requests +(defun sx-request-all-items (method &optional args request-method + stop-when process-function) + "Call METHOD with ARGS until there are no more items. +STOP-WHEN is a function that takes the entire response and +returns non-nil if the process should stop. + +All other arguments are identical to `sx-request-make', but +PROCESS-FUNCTION is given the default value of `identity' (rather +than `sx-request-response-get-items') to allow STOP-WHEN to +access the response wrapper." + ;; @TODO: Refactor. This is the product of a late-night jam + ;; session... it is not intended to be model code. + (let* ((return-value []) + (current-page 1) + (stop-when (or stop-when #'sx-request-all-stop-when-no-more)) + (process-function (or process-function #'identity)) + (response + (sx-request-make method `((page . ,current-page) ,@args) + request-method process-function))) + (while (not (funcall stop-when response)) + (setq return-value + (vconcat return-value + (cdr (assoc 'items response)))) + (setq current-page (1+ current-page) + response + (sx-request-make method `((page . ,current-page) ,@args) + request-method process-function))) + (vconcat return-value + (cdr (assoc 'items response))))) (defun sx-request-make (method &optional args request-method process-function) "Make a request to the API, executing METHOD with ARGS. @@ -213,6 +242,9 @@ false, use the symbol `false'. Each element is processed with (sx-assoc-let response (sx-encoding-clean-content-deep .items))) +(defun sx-request-all-stop-when-no-more (response) + (or (not response) + (equal :json-false (cdr (assoc 'has_more response))))) (provide 'sx-request) ;;; sx-request.el ends here diff --git a/test/test-api.el b/test/test-api.el index ca775ff..b99ec7a 100644 --- a/test/test-api.el +++ b/test/test-api.el @@ -11,3 +11,8 @@ (should-error (sx-request-make "questions" '(())))) +(ert-deftest test-request-all () + "Test request all items" + (should + (< 250 + (length (sx-request-all-items "sites"))))) -- cgit v1.2.3 From f3bc9b692da7305acec568122992ee62dca45496 Mon Sep 17 00:00:00 2001 From: Sean Allred Date: Fri, 2 Jan 2015 01:06:04 -0500 Subject: Consolidate state changes --- sx-request.el | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/sx-request.el b/sx-request.el index 387bde5..f9b93ea 100644 --- a/sx-request.el +++ b/sx-request.el @@ -114,11 +114,11 @@ access the response wrapper." (sx-request-make method `((page . ,current-page) ,@args) request-method process-function))) (while (not (funcall stop-when response)) - (setq return-value + (setq current-page (1+ current-page) + return-value (vconcat return-value (cdr (assoc 'items response)))) - (setq current-page (1+ current-page) - response + (setq response (sx-request-make method `((page . ,current-page) ,@args) request-method process-function))) (vconcat return-value -- cgit v1.2.3 From caad878334e548de2e5157f692746c21dee3ff0d Mon Sep 17 00:00:00 2001 From: Sean Allred Date: Fri, 2 Jan 2015 01:06:23 -0500 Subject: Introduce anti-throttling delay --- sx-request.el | 7 +++++-- 1 file changed, 5 insertions(+), 2 deletions(-) diff --git a/sx-request.el b/sx-request.el index f9b93ea..ba5f6f7 100644 --- a/sx-request.el +++ b/sx-request.el @@ -95,10 +95,12 @@ number of requests left every time it finishes a call." ;;; Making Requests (defun sx-request-all-items (method &optional args request-method - stop-when process-function) + process-function stop-when delay) "Call METHOD with ARGS until there are no more items. STOP-WHEN is a function that takes the entire response and -returns non-nil if the process should stop. +returns non-nil if the process should stop. DELAY is the number +of seconds (possibly a float value) to wait after each request is +made (to avoid throttling). The default value is 0.25. All other arguments are identical to `sx-request-make', but PROCESS-FUNCTION is given the default value of `identity' (rather @@ -118,6 +120,7 @@ access the response wrapper." return-value (vconcat return-value (cdr (assoc 'items response)))) + (sleep-for (or delay 0.25)) (setq response (sx-request-make method `((page . ,current-page) ,@args) request-method process-function))) -- cgit v1.2.3 From 466fab1790145808e00a1b16d180c0b8cfd8ee99 Mon Sep 17 00:00:00 2001 From: Sean Allred Date: Fri, 2 Jan 2015 01:28:52 -0500 Subject: Declare indentation patterns for request functions --- sx-request.el | 2 ++ 1 file changed, 2 insertions(+) diff --git a/sx-request.el b/sx-request.el index ba5f6f7..8f5056f 100644 --- a/sx-request.el +++ b/sx-request.el @@ -108,6 +108,7 @@ than `sx-request-response-get-items') to allow STOP-WHEN to access the response wrapper." ;; @TODO: Refactor. This is the product of a late-night jam ;; session... it is not intended to be model code. + (declare (indent 1)) (let* ((return-value []) (current-page 1) (stop-when (or stop-when #'sx-request-all-stop-when-no-more)) @@ -149,6 +150,7 @@ then read with `json-read-from-string'. `sx-request-remaining-api-requests' is updated appropriately and the main content of the response is returned." + (declare (indent 1)) (let* ((url-automatic-caching t) (url-inhibit-uncompression t) (url-request-data (sx-request--build-keyword-arguments args nil)) -- cgit v1.2.3 From dd9c2017cb3f0b145b39150562a0c4e59c244df1 Mon Sep 17 00:00:00 2001 From: Sean Allred Date: Fri, 2 Jan 2015 01:35:12 -0500 Subject: Use variable instead of default for request-delay --- sx-request.el | 13 ++++++++----- 1 file changed, 8 insertions(+), 5 deletions(-) diff --git a/sx-request.el b/sx-request.el index 8f5056f..00b90be 100644 --- a/sx-request.el +++ b/sx-request.el @@ -92,15 +92,18 @@ number of requests left every time it finishes a call." :group 'sx :type 'integer) +(defvar sx-request-all-items-delay + 1 + "Delay in seconds with each `sx-request-all-items' iteration. +It is good to use a reasonable delay to avoid rate-limiting.") + ;;; Making Requests (defun sx-request-all-items (method &optional args request-method - process-function stop-when delay) + process-function stop-when) "Call METHOD with ARGS until there are no more items. STOP-WHEN is a function that takes the entire response and -returns non-nil if the process should stop. DELAY is the number -of seconds (possibly a float value) to wait after each request is -made (to avoid throttling). The default value is 0.25. +returns non-nil if the process should stop. All other arguments are identical to `sx-request-make', but PROCESS-FUNCTION is given the default value of `identity' (rather @@ -121,7 +124,7 @@ access the response wrapper." return-value (vconcat return-value (cdr (assoc 'items response)))) - (sleep-for (or delay 0.25)) + (sleep-for sx-request-all-items-delay) (setq response (sx-request-make method `((page . ,current-page) ,@args) request-method process-function))) -- cgit v1.2.3