diff options
44 files changed, 2762 insertions, 661 deletions
@@ -1,3 +1,5 @@ +# -*- gitignore -*- + # Backup files *~ \#*\# @@ -18,3 +20,6 @@ test/data-samples # Info files *.info + +# Data directory +data/ diff --git a/.travis.yml b/.travis.yml index ae882b2..d00ab46 100644 --- a/.travis.yml +++ b/.travis.yml @@ -1,6 +1,10 @@ # Stolen from capitaomorte/yasnippet language: emacs-lisp +branches: + except: + - data + env: - EVM_EMACS=emacs-24.1-bin - EVM_EMACS=emacs-24.2-bin diff --git a/CONTRIBUTING.org b/CONTRIBUTING.org new file mode 100644 index 0000000..3fcf111 --- /dev/null +++ b/CONTRIBUTING.org @@ -0,0 +1,23 @@ +If you need help, search the issue tracker to see if anyone has asked +your question before. If it hasn't, a good place to ask first is our +chat room on [[https://gitter.im/vermiculus/sx.el][Gitter]]. Opening an issue is welcome of course, but chat +will likely be faster for you. If a code change needs to be made, an +issue can be written up as necessary. + +Have a great idea for SX? Again, discuss it on [[https://gitter.im/vermiculus/sx.el][Gitter]] first! Don't +limit ideas to mimicking the official website, either -- this is +Emacs; we should take advantage of its abilities. + +To see what we're working on /right now/, check out our [[http://www.waffle.io/vermiculus/sx.el][Waffle board]]. +If you would like to contribute, feel free to take on anything in the +=ready= Waffle column (or the [[https://github.com/vermiculus/sx.el/issues?q=is%3Aopen+is%3Aissue+label%3Aready+-label%3A%22in+progress%22][=ready= GitHub label]]). These are issues +which have been discussed enough to provide a good idea of what should +be done. Issues in =backlog= are either still under discussion or +simply are in the backlog. + +Of course, the greatest gift you can give to SX is a good word. Star +the project on GitHub, mention it to others who would use it in your +StackExchange chat rooms (as always, be courteous and respectful), and +use it yourself. + +Enjoy! @@ -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")) @@ -25,6 +25,7 @@ $(VERSIONS) :: evm use emacs-24.$@-bin emacs --version cask install + rm -rf .sx/ emacs --batch -L . -l ert -l test/tests.el -f ert-run-tests-batch-and-exit install_cask: @@ -32,7 +33,3 @@ install_cask: install_evm: curl -fsSkL https://raw.github.com/rejeep/evm/master/go | bash - -# Local Variables: -# indent-tabs-mode: t -# End: @@ -4,58 +4,62 @@ [[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 -- ~sx-tab-frontpage~ :: - List questions on a StackExchange site. -- Viewing Posts :: - - Use =jknp= to open questions from within ~list-questions~; use - =RET= to move focus. - - Use =v= to open the object at point in your browser. - - Use =TAB= to fold questions and answers. - - Use =RET= to open a link at point. - - Use =:= to switch sites. - - Vote up and down with =u= and =d=. +** Viewing Questions +View questions with one of the ~sx-tab-~ commands. These translate to the +different 'tabs' that you can view on the official site. Implemented tabs +include: +- =frontpage= :: The default front page of questions. +- =newest= :: Newest questions first. +- =topvoted= :: Highest-voted questions first. +- =hot= :: Questions with the most views, answers, and votes over the last few + days. +- =week= :: Questions with the most views, answers, and votes this week. +- =month= :: Questions with the most views, answers, and votes this month. +The meaning of these tabs hopefully needs no explanation, but the official +behavior is given as a tooltip on any site in the StackExchange network. -** Planned -- Archiving questions for offline access -- Browsing and favoriting networks -- Advanced searching -- Writing questions, answers, and comments (with source code in its - native major mode) -- Notifications -- Reputation reporting -- ... +Each of these opens up a list of questions. Switch sites with =:=. Navigate +this list of questions with =jk= or =np=. =jk= will also view the question in a +separate buffer. =v= will visit the question in your browser where =w= will +simply copy a link. Upvote and downvote with =u= and =d=. =RET= will take you +to the question buffer, where =RET= on headlines will expand and collapse each +section. Add comments with =c=. -Have a feature in mind that isn't on the list? Submit a pull request -to add it to the list! If you want to discuss it first, pop in our -Gitter chatroom (badge above) -- someone will be around shortly to -talk about it. +As always, =C-h m= is the definitive resource for the functions of this mode. * Installation To install the development version, follow the usual steps: - Clone this repository - Add this directory to your ~load-path~ -- Issue ~(require 'sx)~ -This should give you access to the only entry point function at the -moment, ~sx-tab-frontpage~. +- Issue ~(require 'sx-load)~ +This should give you access to the ~sx-tab-~ functions (the main entry points at +this time). + +If you are going to be doing any asking / answering / commenting / upvoting / +downvoting / /etc./, you must use ~sx-authenticate~ to provide SX with an +authentication token to act on your behalf. Eventually, this package will be available on MELPA. * Contributing -Please help contribute! Doing any of the following will help us immensely: +Please help contribute! Doing any of the following will help us immensely: - [[https://github.com/vermiculus/sx.el/issues/new][Open an issue]] - [[https://github.com/vermiculus/sx.el/pulls][Submit a pull request]] - [[https://gitter.im/vermiculus/sx.el][Suggest a package or library in our Chat on Gitter]] (or just hang out =:)=) - Spread the word! -For a better view of all of the open issues, take a look at our lovely -[[http://www.waffle.io/vermiculus/sx.el][Waffle board]]. Feel free to take the torch on anything in =backlog= or -=ready=. If you have thoughts on any other issues, don't hesitate to -chime in! +For a better view of all of the open issues, take a look at our lovely [[http://www.waffle.io/vermiculus/sx.el][Waffle +board]]. Feel free to take the torch on anything in =backlog= or =ready=. If you +have thoughts on any other issues, don't hesitate to chime in! + +See also =CONTRIBUTING.org=. * Resources - [[http://www.gnu.org/software/emacs/][GNU Emacs]] @@ -68,3 +72,7 @@ it. - [[file:resources/emacs.svg][Emacs icon]] - [[file:resources/stackexchange.svg][Stack Exchange icon]] +* COMMENT Local Variables +# Local Variables: +# fill-column: 80 +# End: diff --git a/bot/sx-bot.el b/bot/sx-bot.el new file mode 100644 index 0000000..b32a69c --- /dev/null +++ b/bot/sx-bot.el @@ -0,0 +1,82 @@ +;;; sx-bot.el --- Functions for automated maintanence -*- lexical-binding: t; -*- + +;; Copyright (C) 2014 Artur Malabarba + +;; Author: Artur Malabarba <bruce.connor.am@gmail.com> + +;; 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 <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; This file defines the behavior of a bot. To allow completion for +;; tags, this bot runs through all sites in the network and retrieves +;; all of their tags. This data is then written to a directory which +;; is tracked by the git repository. + + +;;; Code: + +(require 'package) +(package-initialize) + +(require 'sx-load) + +(setq sx-request-remaining-api-requests-message-threshold 50000) + +(defcustom sx-bot-out-dir "./data/tags/" + "Directory where output tag files are saved." + :type 'directory + :group 'sx) + + +;;; Printing +(defun sx-bot-write-to-file (data) + "Write (cdr DATA) to file named (car DATA). +File is savedd in `sx-bot-out-dir'." + (let ((file-name (expand-file-name (car data) sx-bot-out-dir))) + (with-temp-file file-name + (let* (print-length + (repr (prin1-to-string + (sort (cdr data) + #'string-lessp)))) + (insert repr "\n") + (goto-char (point-min)) + (while (search-forward "\" \"" nil t) + (replace-match "\"\n \"" nil t)))) + (message "Wrote %S" file-name) + file-name)) + +(defun sx-bot-fetch-and-write-tags () + "Get a list of all tags of all sites and save to disk." + (make-directory sx-bot-out-dir t) + (let* ((url-show-status nil) + (site-tokens (sx-site-get-api-tokens)) + (number-of-sites (length site-tokens)) + (current-site-number 0) + (sx-request-all-items-delay 0.25)) + (mapcar + (lambda (site) + (message "[%d/%d] Working on %S" + (cl-incf current-site-number) + number-of-sites + site) + (sx-bot-write-to-file + (cons (concat site ".el") + (sx-tag--get-all site)))) + site-tokens))) + + +;;; Newest +(provide 'sx-bot) +;;; sx-bot.el ends here diff --git a/bot/sx-bot.sh b/bot/sx-bot.sh new file mode 100755 index 0000000..6a5df17 --- /dev/null +++ b/bot/sx-bot.sh @@ -0,0 +1,36 @@ +#!/usr/bin/bash + +DESTINATION_BRANCH=gh-pages + +function notify-done { + local title + local message + title="SX Tag Bot" + message="Finished retrieving tag lists" + case $(uname | tr '[[:upper:]]' '[[:lower:]]') in + darwin) + terminal-notifier \ + -message ${message} \ + -title ${title} \ + -sound default + ;; + *) + echo ${message} + esac +} + +function generate-tags { + emacs -Q --batch \ + -L "./" -L "./bot/" -l sx-bot \ + -f sx-bot-fetch-and-write-tags + ret = $? + notify-done + return ${ret} +} + +git branch ${DESTINATION_BRANCH} && + git pull && + generate-tags && + git stage data/ && + git commit -m "Update tag data" && + echo 'Ready for "git push"' diff --git a/list-and-question.png b/list-and-question.png Binary files differnew file mode 100644 index 0000000..9e89fec --- /dev/null +++ b/list-and-question.png @@ -1,4 +1,4 @@ -;;; sx-auth.el --- user authentication -*- lexical-binding: t -*- +;;; sx-auth.el --- user authentication -*- lexical-binding: t; -*- ;; Copyright (C) 2014 Sean Allred @@ -89,7 +89,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 @@ -135,8 +136,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-babel.el b/sx-babel.el new file mode 100644 index 0000000..4386172 --- /dev/null +++ b/sx-babel.el @@ -0,0 +1,127 @@ +;;; sx-babel.el --- font-locking pre blocks according to language -*- lexical-binding: t; -*- + +;; Copyright (C) 2014 Artur Malabarba + +;; Author: Artur Malabarba <bruce.connor.am@gmail.com> + +;; 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 <http://www.gnu.org/licenses/>. + +;;; 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) + ;; @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. + +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 mode copy) + (with-temp-buffer + (insert text) + (setq indent (sx-babel--unindent-buffer)) + (goto-char (point-min)) + (setq mode (sx-babel--determine-major-mode)) + (setq copy (replace-regexp-in-string "[[:space:]]+\\'" "" (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-and-inherit space) + (forward-line 1))) + (setq text (buffer-string))) + (goto-char beg) + (delete-region beg end) + (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." + (let ((alist sx-babel-major-mode-alist) + 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) + (setq out (cadr cell))))) + out)) + +(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 + +;; Local Variables: +;; indent-tabs-mode: nil +;; End: diff --git a/sx-button.el b/sx-button.el index c1abf90..4c0666b 100644 --- a/sx-button.el +++ b/sx-button.el @@ -1,4 +1,4 @@ -;;; sx-button.el --- Defining buttons used throughout SX. +;;; sx-button.el --- defining buttons -*- lexical-binding: t; -*- ;; Copyright (C) 2014 Artur Malabarba @@ -18,6 +18,25 @@ ;; along with this program. If not, see <http://www.gnu.org/licenses/>. ;;; Commentary: +;; +;; This file defines all buttons used by SX. For information on +;; buttons, see: +;; http://www.gnu.org/software/emacs/manual/html_node/elisp/Buttons.html +;; +;; Most interactible parts of the SX buffers are buttons. Wherever you +;; are, you can always cycle through all buttons by hitting `TAB', +;; that should help identify what's a button in each buffer. +;; +;; To define a new type of button follow the examples below using +;; `define-button-type' with :supertype `sx-button'. Required +;; properties are `action' and `help-echo'. You'll probably want to +;; give it a `face' as well, unless you want it to look like a link. +;; +;; Buttons can then be inserted in their respective files using +;; `insert-text-button'. Give it the string, the `:type' you defined, +;; and any aditional properties that can only be determined at +;; creation. Existing text can be transformed into a button with +;; `make-text-button' instead. ;;; Code: @@ -27,6 +46,15 @@ (require 'sx-question) +;;; Face +(defface sx-custom-button + '((((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\"." + :group 'sx) + + ;;; Command definitions ;; This extends `button-map', which already defines RET and mouse-1. (defvar sx-button-map @@ -49,27 +77,30 @@ 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'." (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 @@ -118,12 +149,21 @@ code-block." 'help-echo (concat "mouse-1, RET" (propertize ": write a comment" 'face 'minibuffer-prompt)) + 'face 'sx-custom-button 'action #'sx-comment :supertype 'sx-button) +(define-button-type 'sx-button-answer + 'help-echo (concat "mouse-1, RET" + (propertize ": write an answer" + 'face 'minibuffer-prompt)) + 'face 'sx-custom-button + 'action #'sx-answer + :supertype 'sx-button) + (provide 'sx-button) ;;; sx-button.el ends here ;; Local Variables: -;; lexical-binding: t +;; indent-tabs-mode: nil ;; End: diff --git a/sx-cache.el b/sx-cache.el index 598a5df..3a5bd3b 100644 --- a/sx-cache.el +++ b/sx-cache.el @@ -1,4 +1,4 @@ -;;; sx-cache.el --- caching -*- lexical-binding: t -*- +;;; sx-cache.el --- caching -*- lexical-binding: t; -*- ;; Copyright (C) 2014 Sean Allred diff --git a/sx-compose.el b/sx-compose.el new file mode 100644 index 0000000..f4fcd0a --- /dev/null +++ b/sx-compose.el @@ -0,0 +1,308 @@ +;;; sx-compose.el --- major-mode for composing questions and answers -*- lexical-binding: t; -*- + +;; Copyright (C) 2014 Artur Malabarba + +;; Author: Artur Malabarba <bruce.connor.am@gmail.com> + +;; 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 <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; This file defines `sx-compose-mode' and its auxiliary functions and +;; variables. In order to use `sx-compose-mode', it is vital that the +;; variable `sx-compose--send-function' be set. Otherwise it's just a +;; regular markdown buffer. +;; +;; In order to help avoid mistakes, there is the function +;; `sx-compose-create'. This is the preferred way of activating the +;; mode. It creates a buffer, activates the major mode, and sets the +;; `send-function' variable according to the arguments it is given. + + +;;; Code: +(require 'markdown-mode) + +(require 'sx) + +(defgroup sx-compose-mode nil + "Customization group for sx-compose-mode." + :prefix "sx-compose-mode-" + :tag "SX compose Mode" + :group 'sx) + + +;;; Faces and Variables +(defvar sx-compose-before-send-hook nil + "Hook run before POSTing to the API. +Functions are called without arguments and should return non-nil. + +Returning nil indicates something went wrong and the sending will +be aborted. In this case, the function is responsible for +notifying the user. + +Current buffer is the compose-mode buffer whose content is about +to be POSTed.") + +(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 +returned by `sx-compose--send-function' (usually the object +created by the API). They are only called if the transaction +succeeds.") + +(defvar sx-compose--send-function nil + "Function used by `sx-compose-send' to send the data. +Is invoked between `sx-compose-before-send-hook' and +`sx-compose-after-send-functions'.") + +(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" + 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'.") + +(defvar sx-compose--site nil + "Site which the curent compose buffer belongs to.") +(make-variable-buffer-local 'sx-compose--site) + + +;;; Major-mode +(define-derived-mode sx-compose-mode markdown-mode "Compose" + "Major mode for coposing questions and answers. +Most of the functionality comes from `markdown-mode'. This mode +just implements some extra features related to posting to the +API. + +This mode won't function if `sx-compose--send-function' isn't +set. To make sure you set it correctly, you can create the buffer +with the `sx-compose-create' function. + +\\<sx-compose-mode> +\\{sx-compose-mode}" + (add-hook 'sx-compose-after-send-functions + #'sx-compose-quit nil t) + (add-hook 'sx-compose-after-send-functions + #'sx-compose--copy-as-kill nil t)) + +(define-key sx-compose-mode-map "\C-c\C-c" #'sx-compose-send) +(define-key sx-compose-mode-map "\C-c\C-k" #'sx-compose-quit) + +(defun sx-compose-send () + "Finish composing current buffer and send it. +Calls `sx-compose-before-send-hook', POSTs the the current buffer +contents to the API, then calls `sx-compose-after-send-functions'." + (interactive) + (when (run-hook-with-args-until-failure + 'sx-compose-before-send-hook) + (let ((result (funcall sx-compose--send-function))) + (with-demoted-errors + (run-hook-with-args 'sx-compose-after-send-functions + (current-buffer) result))))) + + +;;; Functions for use in hooks +(defun sx-compose-quit (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 _) + "Copy BUFFER contents to the kill-ring." + (when (buffer-live-p buffer) + (with-current-buffer buffer + (kill-new (buffer-string))))) + +(defun sx-compose--check-tags () + "Check if tags in current compose buffer are valid." + (save-excursion + (goto-char (point-min)) + (unless (search-forward-regexp + "^Tags : *\\([^[:space:]].*\\) *$" + (next-single-property-change (point-min) 'sx-compose-separator) + 'noerror) + (error "No Tags header found")) + (let ((invalid-tags + (sx-tag--invalid-name-p + (split-string (match-string 1) "[[:space:],;]" + 'omit-nulls "[[:space:]]") + sx-compose--site))) + (if invalid-tags + ;; If the user doesn't want to create the tags, we return + ;; nil and sending is aborted. + (y-or-n-p "Following tags don't exist. Create them? %s " invalid-tags) + t)))) + + +;;; 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. + +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. + +Each element of BEFORE-FUNCTIONS and AFTER-FUNCTIONS are +respectively added locally to `sx-compose-before-send-hook' and +`sx-compose-after-send-functions'." + (or (integerp parent) (listp parent) + (error "Invalid PARENT")) + (let ((is-question + (and (listp parent) + (or (null parent) + (cdr (assoc 'title parent)))))) + (with-current-buffer (sx-compose--get-buffer-create site parent) + (sx-compose-mode) + (setq sx-compose--site site) + (setq sx-compose--send-function + (if (consp parent) + (sx-assoc-let parent + (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 .comment_id .answer_id .question_id) + :submethod 'edit))) + (lambda () (sx-method-call 'questions + :auth 'warn + :url-method 'post + :filter sx-browse-filter + :site site + :keywords (sx-compose--generate-keywords is-question) + :id parent + :submethod (if parent 'answers/add 'add))))) + ;; Reverse so they're left in the same order. + (dolist (it (reverse before-functions)) + (add-hook 'sx-compose-before-send-hook it nil t)) + (dolist (it (reverse after-functions)) + (add-hook 'sx-compose-after-send-functions it nil t)) + (when is-question + (add-hook 'sx-compose-before-send-hook #'sx-compose--check-tags nil t)) + ;; If the buffer is empty, the draft didn't exist. So prepare the + ;; question. + (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) + (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'. + +`body' is read as the `buffer-string'. If IS-QUESTION is non-nil, +other keywords are read from the header " + `(,@(when is-question + (let ((inhibit-point-motion-hooks t) + (inhibit-read-only t) + (header-end + (next-single-property-change + (point-min) 'sx-compose-separator)) + keywords) + ;; Read the Title. + (goto-char (point-min)) + (unless (search-forward-regexp + "^Title: *\\(.*\\) *$" header-end 'noerror) + (error "No Title header found")) + (push (cons 'title (match-string 1)) keywords) + ;; And the tags + (goto-char (point-min)) + (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)) + keywords) + ;; And erase the header so it doesn't get sent. + (delete-region + (point-min) + (next-single-property-change + header-end 'sx-compose-separator)) + keywords)) + (body . ,(buffer-string)))) + +(defun sx-compose--get-buffer-create (site data) + "Get or create a buffer for use with `sx-compose-mode'. +SITE is the site for which composing is aimed (just used to +uniquely identify the buffers). + +If DATA is nil, get a fresh compose buffer. +If DATA is an integer, try to find an existing buffer +corresponding to that integer, otherwise create one. +If DATA is an alist (question or answer data), like above but use +the id property." + (cond + ((null data) + (generate-new-buffer + (format "*sx draft question %s*" site))) + ((integerp data) + (get-buffer-create + (format "*sx draft answer %s %s*" + site data))) + (t + (get-buffer-create + (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 + +;; Local Variables: +;; indent-tabs-mode: nil +;; End: diff --git a/sx-encoding.el b/sx-encoding.el index c8a7862..d8ad2ba 100644 --- a/sx-encoding.el +++ b/sx-encoding.el @@ -1,4 +1,4 @@ -;;; sx-encoding.el --- encoding -*- lexical-binding: t -*- +;;; sx-encoding.el --- encoding -*- lexical-binding: t; -*- ;; Copyright (C) 2014 Sean Allred diff --git a/sx-favorites.el b/sx-favorites.el index 9408dd5..7fdc772 100644 --- a/sx-favorites.el +++ b/sx-favorites.el @@ -1,4 +1,4 @@ -;;; sx-favorites.el --- starred questions -*- lexical-binding: t -*- +;;; sx-favorites.el --- starred questions -*- lexical-binding: t; -*- ;; Copyright (C) 2014 Sean Allred @@ -28,15 +28,11 @@ (require 'sx-cache) (require 'sx-site) (require 'sx-networks) +(require 'sx-filter) (defvar sx-favorite-list-filter - '((.backoff - .items - .quota_max - .quota_remaining - question.question_id) - nil - none)) + (sx-filter-from-nil + (question.question_id))) (defvar sx-favorites--user-favorite-list nil "Alist of questions favorited by the user. diff --git a/sx-filter.el b/sx-filter.el index cd919f7..4695446 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 @@ -45,7 +45,27 @@ Structure: ...)") -;;; Compilation +;;; Creation +(defmacro sx-filter-from-nil (included) + "Creates a filter data structure with INCLUDED fields. +All wrapper fields are included by default." + `(quote + ((,@(sx--tree-expand + (lambda (path) + (intern (mapconcat #'symbol-name path "."))) + included) + .backoff + .error_id + .error_message + .error_name + .has_more + .items + .page + .page_size + .quota_max + .quota_remaining + .total) + nil none))) ;;; @TODO allow BASE to be a precompiled filter name (defun sx-filter-compile (&optional include exclude base) @@ -85,6 +105,50 @@ return the compiled filter." (sx-cache-set 'filter sx--filter-alist) filter)))) + +;;; Browsing filter +(defvar sx-browse-filter + (sx-filter-from-nil + ((question body_markdown + bounty_amount + comments + answers + last_editor + last_activity_date + accepted_answer_id + link + upvoted + downvoted + question_id + share_link) + (user display_name + reputation) + (shallow_user display_name + reputation) + (comment owner + body_markdown + body + link + edited + creation_date + upvoted + score + post_type + post_id + comment_id) + (answer answer_id + last_editor + last_activity_date + link + share_link + owner + body_markdown + upvoted + downvoted + comments))) + "The filter applied when retrieving question data. +See `sx-question-get-questions' and `sx-question-get-question'.") + (provide 'sx-filter) ;;; sx-filter.el ends here diff --git a/sx-inbox.el b/sx-inbox.el new file mode 100644 index 0000000..01000a6 --- /dev/null +++ b/sx-inbox.el @@ -0,0 +1,216 @@ +;;; sx-inbox.el --- base inbox logic -*- lexical-binding: t; -*- + +;; Copyright (C) 2014 Artur Malabarba + +;; Author: Artur Malabarba <bruce.connor.am@gmail.com> + +;; 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 <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;;; Code: + +(require 'sx) +(require 'sx-filter) +(require 'sx-method) +(require 'sx-question-list) + + +;;; API +(defvar sx-inbox-filter + '((inbox_item.answer_id + inbox_item.body + inbox_item.comment_id + inbox_item.creation_date + inbox_item.is_unread + inbox_item.item_type + inbox_item.link + inbox_item.question_id + inbox_item.site + inbox_item.title) + (site.logo_url + site.audience + site.icon_url + site.high_resolution_icon_url + site.site_state + site.launch_date + site.markdown_extensions + site.related_sites + site.styling)) + "Filter used when retrieving inbox items.") + +(defcustom sx-inbox-fill-column 40 + "`fill-column' used in `sx-inbox-mode'." + :type 'integer + :group 'sx) + +(defun sx-inbox-get (&optional notifications page keywords) + "Get an array of inbox items for the current user. +If NOTIFICATIONS is non-nil, query from `notifications' method, +otherwise use `inbox' method. + +Return an array of items. Each item is an alist of properties +returned by the API. +See https://api.stackexchange.com/docs/types/inbox-item + +KEYWORDS are added to the method call along with PAGE. + +`sx-method-call' is used with `sx-inbox-filter'." + (sx-method-call (if notifications 'notifications 'inbox) + :keywords keywords + :filter sx-inbox-filter)) + + +;;; Major-mode +(defvar sx-inbox--notification-p nil + "If non-nil, current buffer lists notifications, not inbox.") +(make-variable-buffer-local 'sx-inbox--notification-p) + +(defvar sx-inbox--unread-inbox nil + "List of inbox items still unread.") + +(defvar sx-inbox--unread-notifications nil + "List of notifications items still unread.") + +(defvar sx-inbox--read-inbox nil + "List of inbox items which are read. +These are identified by their links.") + +(defvar sx-inbox--read-notifications nil + "List of notification items which are read. +These are identified by their links.") + +(defvar sx-inbox--header-line + '(" " + (:propertize "n p j k" face mode-line-buffer-id) + ": Navigate" + " " + (:propertize "RET" face mode-line-buffer-id) + ": View" + " " + (:propertize "v" face mode-line-buffer-id) + ": Visit externally" + " " + (:propertize "q" face mode-line-buffer-id) + ": Quit") + "Header-line used on the inbox list.") + +(defvar sx-inbox--mode-line + '(" " + (:propertize + (sx-inbox--notification-p + "Notifications" + "Inbox") + face mode-line-buffer-id)) + "Mode-line used on the inbox list.") + +(define-derived-mode sx-inbox-mode + sx-question-list-mode "Question List" + "Mode used to list inbox and notification items." + (toggle-truncate-lines 1) + (setq fill-column sx-inbox-fill-column) + (setq sx-question-list--print-function #'sx-inbox--print-info) + (setq sx-question-list--next-page-function + (lambda (page) (sx-inbox-get sx-inbox--notification-p page))) + (setq tabulated-list-format + [("Type" 30 t nil t) ("Date" 10 t :right-align t) ("Title" 0)]) + (setq mode-line-format sx-inbox--mode-line) + (setq header-line-format sx-inbox--header-line) + ;; @TODO: This will no longer be necessary once we properly + ;; refactor sx-question-list-mode. + (remove-hook 'tabulated-list-revert-hook + #'sx-question-list--update-mode-line t)) + + +;;; Keybinds +(mapc (lambda (x) (define-key sx-inbox-mode-map (car x) (cadr x))) + '( + ("t" nil) + ("a" nil) + ("h" nil) + ("m" sx-inbox-mark-read) + ([?\r] sx-display) + )) + + +;;; print-info +(defun sx-inbox--print-info (data) + "Convert `json-read' DATA into tabulated-list format. + +This is the default printer used by `sx-inbox'. It assumes DATA +is an alist containing the elements: + `answer_id', `body', `comment_id', `creation_date', `is_unread', + `item_type', `link', `question_id', `site', `title'." + (list + data + (sx-assoc-let data + (vector + (list + (concat (capitalize + (replace-regexp-in-string + "_" " " (or .item_type .notification_type))) + (cond (.answer_id " on Answer at:") + (.question_id " on:"))) + 'face 'font-lock-keyword-face) + (list + (concat (sx-time-since .creation_date) + sx-question-list-ago-string) + 'face 'sx-question-list-date) + (list + (propertize + " " 'display + (concat "\n " (propertize .title 'face 'sx-question-list-date) "\n" + (let ((col fill-column)) + (with-temp-buffer + (setq fill-column col) + (insert " " .body) + (fill-region (point-min) (point-max)) + (buffer-string)))) + 'face 'default)))))) + + +;;; Entry commands +(defvar sx-inbox--buffer nil + "Buffer being used to display inbox.") + +(defun sx-inbox (&optional notifications) + "Display a buffer listing inbox items. +With prefix NOTIFICATIONS, list notifications instead of inbox." + (interactive "P") + (setq sx-inbox--buffer (get-buffer-create "*sx-inbox*")) + (let ((inhibit-read-only t)) + (with-current-buffer sx-inbox--buffer + (erase-buffer) + (sx-inbox-mode) + (setq sx-inbox--notification-p notifications) + (tabulated-list-revert))) + (let ((w (get-buffer-window sx-inbox--buffer))) + (if (window-live-p w) + (select-window w) + (pop-to-buffer sx-inbox--buffer) + (enlarge-window + (- (+ fill-column 4) (window-width)) + 'horizontal)))) + +(defun sx-inbox-notifications () + "Display a buffer listing notification items." + (interactive) + (sx-inbox t)) + +(provide 'sx-inbox) +;;; sx-inbox.el ends here + +;; Local Variables: +;; indent-tabs-mode: nil +;; End: diff --git a/sx-interaction.el b/sx-interaction.el index 598a113..4d71c17 100644 --- a/sx-interaction.el +++ b/sx-interaction.el @@ -1,4 +1,4 @@ -;;; sx-interaction.el --- voting, commenting, and other interaction -*- lexical-binding: t -*- +;;; sx-interaction.el --- voting, commenting, and other interaction -*- lexical-binding: t; -*- ;; Copyright (C) 2014 Artur Malabarba @@ -19,42 +19,85 @@ ;;; Commentary: -;; This file provides voting, commenting, and other interactive -;; facilities. Most functions are scoped relative to `sx--data-here' -;; when called interactively. +;; This file holds a series of functions for performing arbitrary +;; interactions with arbitrary objects (objects here always mean the +;; alist of a question, answer, or comment). All commands take at +;; least a DATA argument corresponding to the object which, when +;; called interactively, is always derived from the context at point +;; (usually using the `sx--data-here' function). +;; +;; Interactions represented here involve voting, commenting, asking, +;; answering, editing. +;; +;; These are commands are meant to be available throughout the +;; interface. So it didn't make sense to put them in a specific +;; module. They also rely on a lot of dependencies, so they couldn't +;; be put in sx.el. ;;; Code: +(eval-when-compile + '(require 'cl-lib)) (require 'sx) (require 'sx-question) (require 'sx-question-mode) (require 'sx-question-list) +(require 'sx-compose) ;;; Using data in buffer -(defun sx--data-here (&optional noerror) - "Get data for the question or other object under point. -If NOERROR is non-nil, don't throw an error on failure. - -This looks at the text property `sx--data-here'. If it's not set, -it looks at a few other reasonable variables. If those fail too, -it throws an error." - (or (get-text-property (point) 'sx--data-here) - (and (derived-mode-p 'sx-question-list-mode) - (tabulated-list-get-id)) - (and (derived-mode-p 'sx-question-mode) - sx-question-mode--data) +(defun sx--data-here (&optional type noerror) + "Get the alist regarding object under point of type TYPE. +Looks at the text property `sx--data-here'. If it's not set, it +looks at a few other reasonable variables. If those fail too, it +throws an error. + +TYPE is a symbol restricting the type of object desired. Possible +values are 'question, 'answer, 'comment, or nil (for any type). + +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 data + ;; Is data of the right type? + (cl-case type + (question (when .title data)) + (answer (when .answer_id data)) + (comment (when .comment_id data)))))) + ;; The following two only ever return questions. + (when (or (null type) (eq type 'question)) + ;; @TODO: `sx-question-list-mode' may one day display answers. + ;; Ideally, it would use the `sx--data-here' (so no special + ;; handling would be necessary. + (or (and (derived-mode-p 'sx-question-list-mode) + (tabulated-list-get-id)) + (and (derived-mode-p 'sx-question-mode) + sx-question-mode--data))) + ;; Nothing was found (and (null noerror) - (error "No question data found here")))) + (error "No %s found here" (or type "data"))))) + +(defun sx--error-if-unread (data) + "Throw a user-error if DATA is an unread question. +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))) + (sx-user-error "Question not yet read. View it before acting on it") + data)) -(defun sx--maybe-update-display () - "Refresh the question list if we're inside it." - (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--maybe-update-display (&optional buffer) + "Refresh whatever is displayed in BUFFER or the current buffer. +If BUFFER is not live, nothing is done." + (setq buffer (or buffer (current-buffer))) + (when (buffer-live-p buffer) + (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. @@ -64,7 +107,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. @@ -76,27 +119,64 @@ Interactively, this is specified with a prefix argument. If DATA is a question, also mark it as read." (interactive (list (sx--data-here) current-prefix-arg)) (sx-assoc-let data - (let ((link - (when (stringp .link) - (funcall (if copy-as-kill #'kill-new #'browse-url) - .link)))) + (if (not (stringp .link)) + (sx-message "Nothing to visit here.") + (funcall (if copy-as-kill #'kill-new #'browse-url) .link) (when (and (called-interactively-p 'any) copy-as-kill) - (message "Copied: %S" link))) - (when (and .title (not copy-as-kill)) - (sx-question--mark-read data) - (sx--maybe-update-display)))) + (message "Copied: %S" .link)) + (when (and .title (not copy-as-kill)) + (sx-question--mark-read data) + (sx--maybe-update-display))))) + +(defun sx-open-link (link) + "Visit element given by LINK inside Emacs. +Element can be a question, answer, or comment." + (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 + (answer + (sx-display-question + (sx-question-get-from-answer .site_par .id) 'focus)) + (question + (sx-display-question + (sx-question-get-question .site_par .id) 'focus)))))) ;;; Displaying +(defun sx-display (&optional data) + "Display object given by DATA. +Interactively, display object under point. Object can be a +question, an answer, or an inbox_item. + +This is meant for interactive use. In lisp code, use +object-specific functions such as `sx-display-question' and the +likes." + (interactive (list (sx--data-here))) + (sx-assoc-let data + (cond + (.notification_type + (sx-message "Viewing notifications is not yet implemented")) + (.item_type (sx-open-link .link)) + (.answer_id + (sx-display-question + (sx-question-get-from-answer .site_par .id) 'focus)) + (.title + (sx-display-question data 'focus))))) + (defun sx-display-question (&optional data focus window) "Display question given by DATA, on WINDOW. -When DATA is nil, display question under point. When FOCUS is +Interactively, display question under point. When FOCUS is non-nil (the default when called interactively), also focus the -relevant window. +relevant window. If WINDOW nil, the window is decided by `sx-question-mode-display-buffer-function'." - (interactive (list (sx--data-here) t)) + (interactive (list (sx--data-here 'question) t)) (when (sx-question--mark-read data) (sx--maybe-update-display)) ;; Display the question. @@ -109,22 +189,42 @@ If WINDOW nil, the window is decided by (switch-to-buffer sx-question-mode--buffer)))) +;;; Favoriting +(defun sx-favorite (data &optional undo) + "Favorite question given by DATA. +Interactively, it is guessed from context at point. +With the UNDO prefix argument, unfavorite the question instead." + (interactive (list (sx--error-if-unread (sx--data-here 'question)) + current-prefix-arg)) + (sx-assoc-let data + (sx-method-call 'questions + :id .question_id + :submethod (if undo 'favorite/undo 'favorite) + :auth 'warn + :site .site_par + :url-method 'post + :filter sx-browse-filter))) +(defalias 'sx-star #'sx-favorite) + + ;;; Voting -(defun sx-toggle-upvote (data) - "Apply or remove upvote from DATA. +(defun sx-upvote (data &optional undo) + "Upvote an object given by DATA. DATA can be a question, answer, or comment. Interactively, it is -guessed from context at point." - (interactive (list (sx--data-here))) - (sx-assoc-let data - (sx-set-vote data "upvote" (null (eq .upvoted t))))) +guessed from context at point. +With UNDO prefix argument, remove upvote instead of applying it." + (interactive (list (sx--error-if-unread (sx--data-here)) + current-prefix-arg)) + (sx-set-vote data "upvote" (not undo))) -(defun sx-toggle-downvote (data) - "Apply or remove downvote from DATA. +(defun sx-downvote (data &optional undo) + "Downvote an object given by DATA. DATA can be a question or an answer. Interactively, it is guessed -from context at point." - (interactive (list (sx--data-here))) - (sx-assoc-let data - (sx-set-vote data "downvote" (null (eq .downvoted t))))) +from context at point. +With UNDO prefix argument, remove downvote instead of applying it." + (interactive (list (sx--error-if-unread (sx--data-here)) + current-prefix-arg)) + (sx-set-vote data "downvote" (not undo))) (defun sx-set-vote (data type status) "Set the DATA's vote TYPE to STATUS. @@ -143,9 +243,9 @@ changes." :id (or .comment_id .answer_id .question_id) :submethod (concat type (unless status "/undo")) :auth 'warn - :url-method "POST" + :url-method 'post :filter sx-browse-filter - :site .site)))) + :site .site_par)))) ;; The api returns the new DATA. (when (> (length result) 0) (sx--copy-data (elt result 0) data) @@ -161,7 +261,7 @@ it is guessed from context at point. If DATA is a comment, the comment is posted as a reply to it. TEXT is a string. Interactively, it is read from the minibufer." - (interactive (list (sx--data-here) 'query)) + (interactive (list (sx--error-if-unread (sx--data-here)) 'query)) ;; When clicking the "Add a Comment" button, first arg is a marker. (when (markerp data) (setq data (sx--data-here)) @@ -173,8 +273,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")) @@ -184,29 +284,41 @@ TEXT is a string. Interactively, it is read from the minibufer." :id (or .post_id .answer_id .question_id) :submethod "comments/add" :auth 'warn - :url-method "POST" + :url-method 'post :filter sx-browse-filter - :site .site - :keywords `((body ,text))))) + :site .site_par + :keywords `((body . ,text))))) ;; The api returns the new DATA. (when (> (length result) 0) (sx--add-comment-to-object (elt result 0) (if .post_id - (sx--get-post .post_type .site .post_id) + (sx--get-post .post_type .site_par .post_id) data)) ;; Display the changes in `data'. (sx--maybe-update-display))))) +(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'. +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 @@ -214,7 +326,7 @@ ID is an integer." (car (cl-member-if (lambda (x) (sx-assoc-let x (and (equal (or .answer_id .question_id) id) - (equal .site site)))) + (equal .site_par site)))) db)))) (defun sx--add-comment-to-object (comment object) @@ -226,14 +338,109 @@ OBJECT can be a question or an answer." (setcdr com-cell (apply #'vector - (append - (cl-map 'list #'identity - (cdr com-cell)) - (list comment))))) + (append + (cl-map 'list #'identity + (cdr com-cell)) + (list comment))))) ;; No previous comments, add it manually. (setcdr object (cons (car object) (cdr object))) (setcar object `(comments . [,comment]))))) + +;;; Editing +(defun sx-edit (data) + "Start editing an answer or question given by DATA. +DATA is an answer or question alist. Interactively, it is guessed +from context at point." + (interactive (list (sx--data-here))) + ;; If we ever make an "Edit" button, first arg is a marker. + (when (markerp data) (setq data (sx--data-here))) + (sx-assoc-let data + (let ((buffer (current-buffer))) + (pop-to-buffer + (sx-compose-create + .site_par 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) + (sx--maybe-update-display buffer)))))))) + + +;;; 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_par) + sx-default-site))) + (sx-completing-read + (format "Site (%s): " default) + (sx-site-get-api-tokens) nil t nil nil + default))) + +(defun sx--maybe-site-prompt (arg) + "Get a site token conditionally in an interactive context. +If ARG is non-nil, use `sx--interactive-site-prompt'. +Otherwise, use `sx-question-list--site' if non-nil. +If nil, use `sx--interactive-site-prompt' anyway." + ;; This could eventually be generalized into (sx--maybe-prompt + ;; prefix-arg value-if-non-nil #'prompt-function). + (if arg + (sx--interactive-site-prompt) + (or sx-question-list--site + (sx--interactive-site-prompt)))) + +;;;###autoload +(defun sx-ask (site) + "Start composing a question for SITE. +SITE is a string, indicating where the question will be posted." + (interactive (list (sx--interactive-site-prompt))) + (let ((buffer (current-buffer))) + (pop-to-buffer + (sx-compose-create + site nil nil + ;; After send functions + (list (lambda (_b _res) (sx--maybe-update-display buffer))))))) + + +;;; Answering +(defun sx-answer (data) + "Start composing an answer for question given by DATA. +DATA is a question alist. Interactively, it is guessed from +context at point. " + ;; If the user tries to answer a question that's not viewed, he + ;; probaby hit the button by accident. + (interactive + (list (sx--error-if-unread (sx--data-here 'question)))) + ;; When clicking the "Write an Answer" button, first arg is a marker. + (when (markerp data) (setq data (sx--data-here))) + (let ((buffer (current-buffer))) + (sx-assoc-let data + (pop-to-buffer + (sx-compose-create + .site_par .question_id nil + ;; After send functions + (list (lambda (_ res) + (sx--add-answer-to-question-object + (elt res 0) sx-question-mode--data) + (sx--maybe-update-display buffer)))))))) + +(defun sx--add-answer-to-question-object (answer question) + "Add alist ANSWER to alist QUESTION in the right place." + (let ((cell (assoc 'answers question))) + (if cell + (setcdr cell (apply #'vector + (append (cdr cell) (list answer)))) + ;; No previous comments, add it manually. + (setcdr question (cons (car question) (cdr question))) + (setcar question `(answers . [,answer]))))) + (provide 'sx-interaction) ;;; sx-interaction.el ends here diff --git a/sx-load.el b/sx-load.el new file mode 100644 index 0000000..003f965 --- /dev/null +++ b/sx-load.el @@ -0,0 +1,56 @@ +;;; sx-load.el --- load all files of the SX package -*- lexical-binding: t; -*- + +;; Copyright (C) 2014 Artur Malabarba + +;; Author: Artur Malabarba <bruce.connor.am@gmail.com> + +;; 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 <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;;; Code: +(mapc #'require + '(sx + sx-time + sx-auth + sx-button + sx-babel + sx-cache + sx-compose + sx-encoding + sx-favorites + sx-filter + sx-inbox + sx-interaction + sx-method + sx-networks + sx-notify + sx-question + sx-question-list + sx-question-mode + sx-question-print + sx-request + sx-search + sx-site + sx-switchto + sx-tab + sx-tag + )) + +(provide 'sx-load) +;;; sx-load.el ends here + +;; Local Variables: +;; indent-tabs-mode: nil +;; End: diff --git a/sx-method.el b/sx-method.el index 88525a3..9d61e60 100644 --- a/sx-method.el +++ b/sx-method.el @@ -1,4 +1,4 @@ -;;; sx-method.el --- method calls -*- lexical-binding: t -*- +;;; sx-method.el --- method calls -*- lexical-binding: t; -*- ;; Copyright (C) 2014 Sean Allred @@ -35,9 +35,14 @@ (cl-defun sx-method-call (method &key id submethod keywords + page + (pagesize 100) (filter '(())) auth - (url-method "GET") + (url-method 'get) + get-all + (process-function + #'sx-request-response-get-items) site) "Call METHOD with additional keys. @@ -48,8 +53,15 @@ user. :FILTER is the set of filters to control the returned information :AUTH defines how to act if the method or filters require authentication. -:URL-METHOD is either \"POST\" or \"GET\" +:URL-METHOD is either `post' or `get' :SITE is the api parameter specifying the site. +:GET-ALL is nil or non-nil +:PROCESS-FUNCTION is a response-processing function +:PAGE is the page number which will be requested +:PAGESIZE is the number of items to retrieve per request, default 100 + +Any conflicting information in :KEYWORDS overrides the :PAGE +and :PAGESIZE settings. When AUTH is nil, it is assumed that no auth-requiring filters or methods will be used. If they are an error will be signaled. This is @@ -66,6 +78,18 @@ for interactive commands that absolutely require authentication \(submitting questions/answers, reading inbox, etc). Filters will treat 'warn as equivalent to t. +If GET-ALL is nil, this method will only return the first (or +specified) page available from this method call. If t, all pages +will be retrieved (`sx-request-all-stop-when-no-more') . +Otherwise, it is a function STOP-WHEN for `sx-request-all-items'. + +If PROCESS-FUNCTION is nil, only the items of the response will +be returned (`sx-request-response-get-items'). Otherwise, it is +a function that processes the entire response (as returned by +`json-read'). + +See `sx-request-make' and `sx-request-all-items'. + Return the entire response as a complex alist." (declare (indent 1)) (let ((access-token (sx-cache-get 'auth)) @@ -78,20 +102,23 @@ Return the entire response as a complex alist." (format "/%s" submethod)) ;; On GET methods site is buggy, so we ;; need to provide it as a url argument. - (when (and site (string= url-method "GET")) + (when (and site (eq url-method 'get)) (prog1 (format "?site=%s" site) (setq site nil))))) - (call #'sx-request-make) - parameters) + (call (if get-all #'sx-request-all-items #'sx-request-make)) + (get-all + (cond + ((eq get-all t) #'sx-request-all-stop-when-no-more) + (t get-all)))) (lwarn "sx-call-method" :debug "A: %S T: %S. M: %S,%s. F: %S" (equal 'warn auth) access-token method-auth full-method filter-auth) (unless access-token (cond ;; 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.")) + (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) (setq call 'sx-request-fallback)) @@ -102,15 +129,18 @@ Return the entire response as a complex alist." ((and (or filter-auth method-auth) (not auth)) (error "This request requires authentication.")))) ;; Concatenate all parameters now that filter is ensured. - (setq parameters - (cons (cons 'filter (sx-filter-get-var filter)) - keywords)) + (push `(filter . ,(sx-filter-get-var filter)) keywords) + (unless (assq 'page keywords) + (push `(page . ,page) keywords)) + (unless (assq 'pagesize keywords) + (push `(pagesize . ,pagesize) keywords)) (when site - (setq parameters (cons (cons 'site site) parameters))) + (push `(site . ,site) keywords)) (funcall call full-method - parameters - url-method))) + keywords + url-method + (or get-all process-function)))) (provide 'sx-method) ;;; sx-method.el ends here diff --git a/sx-networks.el b/sx-networks.el index e9bc1c7..2695689 100644 --- a/sx-networks.el +++ b/sx-networks.el @@ -1,4 +1,4 @@ -;;; sx-networks.el --- user network information -*- lexical-binding: t -*- +;;; sx-networks.el --- user network information -*- lexical-binding: t; -*- ;; Copyright (C) 2014 Sean Allred @@ -27,31 +27,23 @@ (require 'sx-method) (require 'sx-cache) (require 'sx-site) +(require 'sx-filter) (defvar sx-network--user-filter - '((.backoff - .error_id - .error_message - .error_name - .has_more - .items - .quota_max - .quota_remaining - badge_count.bronze - badge_count.silver - badge_count.gold - network_user.account_id - network_user.answer_count - network_user.badge_counts - network_user.creation_date - network_user.last_access_date - network_user.reputation - network_user.site_name - network_user.site_url - network_user.user_id - network_user.user_type) - nil - none)) + (sx-filter-from-nil + ((badge_count bronze + silver + gold) + (network_user account_id + answer_count + badge_counts + creation_date + last_access_date + reputation + site_name + site_url + user_id + user_type)))) (defun sx-network--get-associated () "Retrieve cached information for network user. diff --git a/sx-notify.el b/sx-notify.el new file mode 100644 index 0000000..6dc90b9 --- /dev/null +++ b/sx-notify.el @@ -0,0 +1,86 @@ +;;; sx-notify.el --- mode-line notifications -*- lexical-binding: t; -*- + +;; Copyright (C) 2014 Artur Malabarba + +;; Author: Artur Malabarba <bruce.connor.am@gmail.com> + +;; 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 <http://www.gnu.org/licenses/>. + +;;; Commentary: + + +;;; Code: + +(require 'sx) +(require 'sx-inbox) + + +;;; mode-line notification +(defvar sx-notify--mode-line + '((sx-inbox--unread-inbox (sx-inbox--unread-notifications " [")) + (sx-inbox--unread-inbox + (:propertize + (:eval (format "i:%s" (length sx-inbox--unread-inbox))) + face mode-line-buffer-id + mouse-face mode-line-highlight)) + (sx-inbox--unread-inbox (sx-inbox--unread-notifications " ")) + (sx-inbox--unread-notifications + (:propertize + (:eval (format "n:%s" (length sx-inbox--unread-notifications))) + mouse-face mode-line-highlight)) + (sx-inbox--unread-inbox (sx-notify--unread-notifications "]"))) + "") +(put 'sx-notify--mode-line 'risky-local-variable t) + + +;;; minor-mode definition +(defcustom sx-notify-timer-delay (* 60 5) + "Idle time, in seconds, before querying for inbox items." + :type 'integer + :group 'sx-notify) + +(defvar sx-notify--timer nil + "Timer used for fetching notifications.") + +(define-minor-mode sx-notify-mode nil nil nil nil + :global t + (if sx-notify-mode + (progn + (add-to-list 'global-mode-string '(t sx-notify--mode-line) 'append) + (setq sx-notify--timer + (run-with-idle-timer sx-notify-timer-delay 'repeat + #'sx-notify--update-unread))) + (when (timerp sx-notify--timer) + (cancel-timer sx-notify--timer) + (setq sx-notify--timer nil)) + (setq global-mode-string + (delete '(t sx-notify--mode-line) global-mode-string)))) + +(defun sx-notify--update-unread () + "Update the lists of unread notifications." + (setq sx-inbox--unread-inbox + (cl-remove-if + (lambda (x) (member (cdr (assq 'link x)) sx-inbox--read-inbox)) + (append (sx-inbox-get) nil))) + (setq sx-inbox--unread-notifications + (cl-remove-if + (lambda (x) (member (cdr (assq 'link x)) sx-inbox--read-notifications)) + (append (sx-inbox-get t) nil)))) + +(provide 'sx-notify) +;;; sx-notify.el ends here + +;; Local Variables: +;; indent-tabs-mode: nil +;; End: diff --git a/sx-question-list.el b/sx-question-list.el index bed432f..b9f34a0 100644 --- a/sx-question-list.el +++ b/sx-question-list.el @@ -1,4 +1,4 @@ -;;; sx-question-list.el --- major-mode for navigating questions list -*- lexical-binding: t -*- +;;; sx-question-list.el --- major-mode for navigating questions list -*- lexical-binding: t; -*- ;; Copyright (C) 2014 Artur Malabarba @@ -106,6 +106,21 @@ "" :group 'sx-question-list-faces) +(defface sx-question-list-bounty + '((t :inherit font-lock-warning-face)) + "" + :group 'sx-question-list-faces) + +(defface sx-question-list-reputation + '((t :inherit sx-question-list-date)) + "" + :group 'sx-question-list-faces) + +(defface sx-question-list-user + '((t :inherit font-lock-builtin-face)) + "" + :group 'sx-question-list-faces) + ;;; Backend variables (defvar sx-question-list--print-function #'sx-question-list--print-info @@ -129,7 +144,7 @@ elements: Also see `sx-question-list-refresh'." (sx-assoc-let question-data (let ((favorite (if (member .question_id - (assoc .site + (assoc .site_par sx-favorites--user-favorite-list)) (if (char-displayable-p ?\x2b26) "\x2b26" "*") " "))) (list @@ -143,20 +158,35 @@ Also see `sx-question-list-refresh'." 'sx-question-list-answers-accepted 'sx-question-list-answers)) (concat + ;; First line (propertize .title 'face (if (sx-question--read-p question-data) 'sx-question-list-read-question 'sx-question-list-unread-question)) (propertize " " 'display "\n ") + ;; Second line (propertize favorite 'face 'sx-question-list-favorite) - " " - (propertize (concat (sx-time-since .last_activity_date) - sx-question-list-ago-string) + (if (and (numberp .bounty_amount) (> .bounty_amount 0)) + (propertize (format "%4d" .bounty_amount) + 'face 'sx-question-list-bounty) + " ") + " " + (propertize (format "%3s%s" + (sx-time-since .last_activity_date) + sx-question-list-ago-string) 'face 'sx-question-list-date) " " - (propertize (mapconcat #'sx-question--tag-format .tags " ") + ;; @TODO: Make this width customizable. (Or maybe just make + ;; the whole thing customizable) + (propertize (format "%-40s" (mapconcat #'sx-question--tag-format .tags " ")) 'face 'sx-question-list-tags) + " " + (let-alist .owner + (format "%15s %5s" + (propertize .display_name 'face 'sx-question-list-user) + (propertize (number-to-string .reputation) + 'face 'sx-question-list-reputation))) (propertize " " 'display "\n"))))))) (defvar sx-question-list--pages-so-far 0 @@ -198,6 +228,21 @@ 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" + " " + (:propertize "q" face mode-line-buffer-id) + ": Quit") + "Header-line used on the question list.") + ;;; Mode Definition (define-derived-mode sx-question-list-mode @@ -265,10 +310,10 @@ into consideration. ;; it's not terribly intuitive. (setq tabulated-list-sort-key nil) (add-hook 'tabulated-list-revert-hook - #'sx-question-list-refresh nil t) + #'sx-question-list-refresh nil t) (add-hook 'tabulated-list-revert-hook - #'sx-question-list--update-mode-line nil t) - (tabulated-list-init-header)) + #'sx-question-list--update-mode-line nil t) + (setq header-line-format sx-question-list--header-line)) (defcustom sx-question-list-date-sort-method 'last_activity_date "Parameter which controls date sorting." @@ -288,7 +333,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-next) + ([up] sx-question-list-previous) + ("n" sx-question-list-next) ("p" sx-question-list-previous) ("j" sx-question-list-view-next) ("k" sx-question-list-view-previous) @@ -297,14 +346,18 @@ into consideration. ("J" sx-question-list-next-far) ("K" sx-question-list-previous-far) ("g" sx-question-list-refresh) - (":" sx-question-list-switch-site) - ("t" sx-question-list-switch-tab) - ("v" sx-visit) - ("u" sx-toggle-upvote) - ("d" sx-toggle-downvote) + ("t" sx-tab-switch) + ("a" sx-ask) + ("S" sx-search) + ("s" sx-switchto-map) + ("v" sx-visit-externally) + ("u" sx-upvote) + ("d" sx-downvote) ("h" sx-question-list-hide) ("m" sx-question-list-mark-read) - ([?\r] sx-display-question))) + ("*" sx-favorite) + ([?\r] sx-display) + )) (defun sx-question-list-hide (data) "Hide question under point. @@ -312,8 +365,13 @@ 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) + ;; 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))) @@ -323,7 +381,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) @@ -374,6 +432,7 @@ Non-interactively, DATA is a question alist." (defvar sx-question-list--site nil "Site being displayed in the *question-list* buffer.") +(make-variable-buffer-local 'sx-question-list--site) (defun sx-question-list-refresh (&optional redisplay no-update) "Update the list of questions. @@ -399,7 +458,11 @@ a new list before redisplaying." (setq tabulated-list-entries (mapcar sx-question-list--print-function (cl-remove-if #'sx-question--hidden-p question-list))) - (when redisplay (tabulated-list-print 'remember)) + (when redisplay + (tabulated-list-print 'remember) + ;; Display weird chars correctly + (set-buffer-multibyte nil) + (set-buffer-multibyte t)) (when window (set-window-start window old-start))) (sx-message "Done.")) @@ -424,9 +487,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 () @@ -532,12 +594,11 @@ This does not update `sx-question-mode--window'." (defun sx-question-list-switch-site (site) "Switch the current site to SITE and display its questions. -Use `ido-completing-read' if variable `ido-mode' is active. Retrieve completions from `sx-site-get-api-tokens'. Sets `sx-question-list--site' and then call `sx-question-list-refresh' with `redisplay'." (interactive - (list (funcall (if ido-mode #'ido-completing-read #'completing-read) + (list (sx-completing-read "Switch to site: " (sx-site-get-api-tokens) (lambda (site) (not (equal site sx-question-list--site))) t))) diff --git a/sx-question-mode.el b/sx-question-mode.el index 9be02ce..f702822 100644 --- a/sx-question-mode.el +++ b/sx-question-mode.el @@ -1,4 +1,4 @@ -;;; sx-question-mode.el --- major-mode for displaying questions -*- lexical-binding: t -*- +;;; sx-question-mode.el --- major-mode for displaying questions -*- lexical-binding: t; -*- ;; Copyright (C) 2014 Artur Malabarba @@ -33,11 +33,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-mode-map>`\\[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) @@ -65,7 +67,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) @@ -121,13 +125,11 @@ 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 (car-safe (sx-question-mode--section-overlays-at (line-end-position))))) + (let ((ov (sx-question-mode--section-overlays-at (line-end-position)))) (when (and (overlayp ov) (> (overlay-end ov) (window-end))) (recenter sx-question-mode-recenter-line)))) (sx-message-help-echo))) @@ -176,12 +178,34 @@ 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" + " " + (:propertize "q" face mode-line-buffer-id) + ": Quit") + "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> \\{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 @@ -196,15 +220,23 @@ 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) - ("v" sx-visit) - ("u" sx-toggle-upvote) - ("d" sx-toggle-downvote) + ("v" sx-visit-externally) + ("u" sx-upvote) + ("d" sx-downvote) ("q" quit-window) (" " scroll-up-command) + ("a" sx-answer) + ("e" sx-edit) + ("S" sx-search) + ("s" sx-switchto-map) + ("*" sx-favorite) (,(kbd "S-SPC") scroll-down-command) ([backspace] scroll-down-command) ([tab] forward-button) @@ -228,7 +260,7 @@ query the api." (if no-update sx-question-mode--data (sx-assoc-let sx-question-mode--data - (sx-question-get-question .site .question_id)))) + (sx-question-get-question .site_par .question_id)))) (goto-char point) (when (equal (selected-window) (get-buffer-window (current-buffer))) diff --git a/sx-question-print.el b/sx-question-print.el index c35da16..e148d5f 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. -*- lexical-binding: t -*- +;;; sx-question-print.el --- populating the question-mode buffer with content -*- lexical-binding: t; -*- ;; Copyright (C) 2014 Artur Malabarba @@ -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." @@ -182,9 +180,8 @@ QUESTION must be a data structure returned by `json-read'." (sx-question-mode--print-section question) (sx-assoc-let question (mapc #'sx-question-mode--print-section .answers)) - ;; Display weird chars correctly - (set-buffer-multibyte nil) - (set-buffer-multibyte t) + (insert "\n\n ") + (insert-text-button "Write an Answer" :type 'sx-button-answer) ;; Go up (goto-char (point-min)) (sx-question-mode-next-section)) @@ -238,8 +235,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" @@ -290,18 +286,22 @@ 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 (and (numberp .score) (> .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) - (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. @@ -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. @@ -350,7 +350,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+ (not space)))) symbol-end) 1 font-lock-builtin-face))) ;; Everything. @@ -362,26 +362,14 @@ 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))) - -(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) - ;; 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)))) + (let ((beg (point))) + (skip-chars-forward "\r\n[:blank:]") + (forward-paragraph) + (fill-region beg (point))))) + (replace-regexp-in-string "[[:blank:]]+\\'" "" (buffer-string)))) + +;;; Handling links (defun sx-question-mode--process-links-in-buffer () "Turn all markdown links in this buffer into compact format." (save-excursion @@ -393,10 +381,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. @@ -425,29 +414,57 @@ 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) + ;; 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. Handling means to turn it into a button and remove erroneous font-locking." - (let (beg end text) - (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)))) + (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)) + t))) + +(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." + (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))) + +(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 diff --git a/sx-question.el b/sx-question.el index b04c180..b9fc78a 100644 --- a/sx-question.el +++ b/sx-question.el @@ -1,4 +1,4 @@ -;;; sx-question.el --- question logic -*- lexical-binding: t -*- +;;; sx-question.el --- question logic -*- lexical-binding: t; -*- ;; Copyright (C) 2014 Sean Allred @@ -29,7 +29,7 @@ (require 'sx-filter) (require 'sx-method) -(defun sx-question-get-questions (site &optional page keywords) +(defun sx-question-get-questions (site &optional page keywords submethod) "Get SITE questions. Return page PAGE (the first if nil). Return a list of question. Each question is an alist of properties returned by the API with an added (site SITE) @@ -42,6 +42,7 @@ KEYWORDS are added to the method call along with PAGE. :keywords `((page . ,page) ,@keywords) :site site :auth t + :submethod submethod :filter sx-browse-filter)) (defun sx-question-get-question (site question-id) @@ -57,6 +58,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 @@ -83,8 +98,8 @@ If no cache exists for it, initialize one with SITE." "Non-nil if QUESTION has been read since last updated. See `sx-question--user-read-list'." (sx-assoc-let question - (sx-question--ensure-read-list .site) - (let ((ql (cdr (assoc .site sx-question--user-read-list)))) + (sx-question--ensure-read-list .site_par) + (let ((ql (cdr (assoc .site_par sx-question--user-read-list)))) (and ql (>= (or (cdr (assoc .question_id ql)) 0) .last_activity_date))))) @@ -96,18 +111,19 @@ read, i.e., if it was `sx-question--read-p'. See `sx-question--user-read-list'." (prog1 (sx-assoc-let question - (sx-question--ensure-read-list .site) - (let ((site-cell (assoc .site sx-question--user-read-list)) + (sx-question--ensure-read-list .site_par) + (let ((site-cell (assoc .site_par sx-question--user-read-list)) (q-cell (cons .question_id .last_activity_date)) cell) (cond ;; First question from this site. ((null site-cell) - (push (list .site q-cell) sx-question--user-read-list)) + (push (list .site_par q-cell) sx-question--user-read-list)) ;; Question already present. ((setq cell (assoc .question_id site-cell)) ;; Current version is newer than cached version. - (when (> .last_activity_date (cdr cell)) + (when (or (not (numberp (cdr cell))) + (> .last_activity_date (cdr cell))) (setcdr cell .last_activity_date))) ;; Question wasn't present. (t @@ -138,25 +154,23 @@ If no cache exists for it, initialize one with SITE." (defun sx-question--hidden-p (question) "Non-nil if QUESTION has been hidden." (sx-assoc-let question - (sx-question--ensure-hidden-list .site) - (let ((ql (cdr (assoc .site sx-question--user-hidden-list)))) + (sx-question--ensure-hidden-list .site_par) + (let ((ql (cdr (assoc .site_par sx-question--user-hidden-list)))) (and ql (memq .question_id ql))))) (defun sx-question--mark-hidden (question) "Mark QUESTION as being hidden." (sx-assoc-let question - (let ((site-cell (assoc .site sx-question--user-hidden-list)) - cell) + (let ((site-cell (assoc .site_par sx-question--user-hidden-list))) ;; If question already hidden, do nothing. (unless (memq .question_id site-cell) - ;; First question from this site. - (push (list .site .question_id) sx-question--user-hidden-list) - ;; Question wasn't present. - ;; Add it in, but make sure it's sorted (just in case we need - ;; it later). - (sx-sorted-insert-skip-first .question_id site-cell >) - ;; This causes a small lag on `j' and `k' as the list gets large. - ;; Should we do this on a timer? + (if (null site-cell) + ;; First question from this site. + (push (list .site_par .question_id) sx-question--user-hidden-list) + ;; Not first question and question wasn't present. + ;; Add it in, but make sure it's sorted (just in case we + ;; decide to rely on it later). + (sx-sorted-insert-skip-first .question_id site-cell >)) ;; Save the results. (sx-cache-set 'hidden-questions sx-question--user-hidden-list))))) diff --git a/sx-request.el b/sx-request.el index 653e17c..ebc16d2 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 @@ -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) @@ -88,16 +92,52 @@ 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 + 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. + +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. + (declare (indent 1)) + (let* ((return-value []) + (current-page 1) + (stop-when (or stop-when #'sx-request-all-stop-when-no-more)) + (process-function #'identity) + (response + (sx-request-make method `((page . ,current-page) ,@args) + request-method process-function))) + (while (not (funcall stop-when response)) + (setq current-page (1+ current-page) + return-value + (vconcat return-value + (cdr (assoc 'items response)))) + (sleep-for sx-request-all-items-delay) + (setq 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) +(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'. +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 @@ -113,50 +153,58 @@ 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)) (request-url (concat sx-request-api-root method)) - (url-request-method request-method) + (url-request-method (and request-method (symbol-name request-method))) (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))))))) - -(defun sx-request-fallback (method &optional args request-method) + (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 + ;; 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" + (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 remaining" + sx-request-remaining-api-requests)) + (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. This is for UI generation when the associated API call would require authentication. @@ -188,13 +236,23 @@ false, use the symbol `false'. Each element is processed with (concat (sx--thing-as-string (car pair)) "=" - (sx--thing-as-string (cdr pair) kv-sep))) + (sx--thing-as-string (cdr pair) kv-sep t))) (delq nil (mapcar (lambda (pair) (when (cdr pair) pair)) 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))) + +(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/sx-search.el b/sx-search.el new file mode 100644 index 0000000..d47905e --- /dev/null +++ b/sx-search.el @@ -0,0 +1,116 @@ +;;; sx-search.el --- searching for questions -*- lexical-binding: t; -*- + +;; Copyright (C) 2014 Artur Malabarba + +;; Author: Artur Malabarba <bruce.connor.am@gmail.com> + +;; 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 <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;; Implements sarch functionality. The basic function is +;; `sx-search-get-questions', which returns an array of questions +;; according to a search term. +;; +;; This also defines a user-level command, `sx-search', which is an +;; interactive wrapper around `sx-search-get-questions' and +;; `sx-question-list-mode'. + + +;;; Code: + +(require 'sx) +(require 'sx-question-list) + +(defvar sx-search--query-history nil + "Query history for interactive prompts.") + +(defvar sx-search--tag-history nil + "Tags history for interactive prompts.") + + +;;; Basic function +(defun sx-search-get-questions (site page query &optional tags excluded-tags keywords) + "Like `sx-question-get-questions', but restrict results by a search. + +Perform search on SITE. PAGE is an integer indicating which page +of results to return. QUERY, TAGS, and EXCLUDED-TAGS restrict the +possible returned questions as per `sx-search'. + +Either QUERY or TAGS must be non-nil, or the search will +fail. EXCLUDED-TAGS is only is used if TAGS is also provided. + +KEYWORDS is passed to `sx-method-call'." + (sx-method-call 'search + :keywords `((page . ,page) + (sort . activity) + (intitle . ,query) + (tagged . ,tags) + (nottagged . ,excluded-tags) + ,@keywords) + :site site + :auth t + :filter sx-browse-filter)) + + +;;; User command +(defun sx-search (site query &optional tags excluded-tags) + "Display search on SITE for question titles containing QUERY. +When TAGS is given, it is a lists of tags, one of which must +match. When EXCLUDED-TAGS is given, it is a list of tags, none +of which is allowed to match. + +Interactively, the user is asked for SITE and QUERY. With a +prefix argument, the user is asked for everything." + (interactive + (let ((site (sx--maybe-site-prompt current-prefix-arg)) + (query (read-string + (format "Query (%s): " + (if current-prefix-arg "optional" "mandatory")) + "" + 'sx-search--query-history)) + tags excluded-tags) + (when (string= query "") + (setq query nil)) + (when current-prefix-arg + (setq tags (sx--multiple-read + (format "Tags (%s)" + (if query "optional" "mandatory")) + 'sx-search--tag-history)) + (when (and (not query) (string= "" tags)) + (sx-user-error "Must supply either QUERY or TAGS")) + (setq excluded-tags + (sx--multiple-read + "Excluded tags (optional)" 'sx-search--tag-history))) + (list site query tags excluded-tags))) + + ;; Here starts the actual function + (sx-initialize) + (with-current-buffer (get-buffer-create "*sx-search-result*") + (sx-question-list-mode) + (setq sx-question-list--next-page-function + (lambda (page) + (sx-search-get-questions + sx-question-list--site page + query tags excluded-tags))) + (setq sx-question-list--site site) + (sx-question-list-refresh 'redisplay) + (switch-to-buffer (current-buffer)))) + +(provide 'sx-search) +;;; sx-search.el ends here + +;; Local Variables: +;; indent-tabs-mode: nil +;; End: @@ -1,4 +1,4 @@ -;;; sx-site.el --- browsing sites -*- lexical-binding: t -*- +;;; sx-site.el --- browsing sites -*- lexical-binding: t; -*- ;; Copyright (C) 2014 Sean Allred @@ -26,25 +26,16 @@ (require 'sx-method) (require 'sx-cache) +(require 'sx-filter) (defvar sx-site-browse-filter - '((.backoff - .error_id - .error_message - .error_name - .has_more - .items - .quota_max - .quota_remaining - site.site_type - site.name - site.site_url - site.api_site_parameter - site.related_sites - related_site.api_site_parameter - related_site.relation) - nil - none) + (sx-filter-from-nil + ((site site_type + name + api_site_parameter + related_sites) + (related_site api_site_parameter + relation))) "Filter for browsing sites.") (defun sx-site--get-site-list () @@ -52,7 +43,7 @@ (sx-cache-get 'site-list '(sx-method-call 'sites - :keywords '((pagesize . 999)) + :pagesize 999 :filter sx-site-browse-filter))) (defcustom sx-site-favorites diff --git a/sx-switchto.el b/sx-switchto.el new file mode 100644 index 0000000..458586a --- /dev/null +++ b/sx-switchto.el @@ -0,0 +1,77 @@ +;;; sx-switchto.el --- keymap for navigating between pages -*- lexical-binding: t; -*- + +;; Copyright (C) 2014 Artur Malabarba + +;; Author: Artur Malabarba <bruce.connor.am@gmail.com> + +;; 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 <http://www.gnu.org/licenses/>. + +;;; Commentary: + +;;; Code: + +(require 'sx) +(require 'sx-filter) +(require 'sx-method) +(require 'sx-question-list) + + +;;; Keybinds +;;;###autoload +(define-prefix-command 'sx-switchto-map) + +(mapc (lambda (x) (define-key sx-switchto-map (car x) (cadr x))) + '( + ;; These immitate the site's G hotkey. + ("a" sx-ask) + ("h" sx-tab-frontpage) + ("m" sx-tab-meta-or-main) + ;; This is `n' on the site. + ("u" sx-tab-unanswered) + ;; These are extra things we can do, because we're awesome. + ("f" sx-tab-featured) + ("i" sx-inbox) + ("n" sx-tab-newest) + ("t" sx-tab-switch) + ("U" sx-tab-unanswered-my-tags) + ("v" sx-tab-topvoted) + ("w" sx-tab-week) + ("*" sx-tab-starred) + )) + + +;;; These are keys which depend on context. +;;;; For instance, it makes no sense to have `switch-site' bound to a +;;;; key on a buffer with no `sx-question-list--site' variable. +(defmacro sx--define-conditional-key (keymap key def &rest body) + "In KEYMAP, define key sequence KEY as DEF conditionally. +This is like `define-key', except the definition \"disapears\" +whenever BODY evaluates to nil." + (declare (indent 3) + (debug (form form form &rest sexp))) + `(define-key ,keymap ,key + '(menu-item + ,(format "maybe-%s" (or (car (cdr-safe def)) def)) ignore + :filter (lambda (&optional _) + (when (progn ,@body) ,def))))) + +(sx--define-conditional-key sx-switchto-map "s" #'sx-question-list-switch-site + (and (boundp 'sx-question-list--site) sx-question-list--site)) + +(provide 'sx-switchto) +;;; sx-switchto.el ends here + +;; Local Variables: +;; indent-tabs-mode: nil +;; End: @@ -1,4 +1,4 @@ -;;; sx-tab.el --- functions for viewing different tabs -*- lexical-binding: t -*- +;;; sx-tab.el --- functions for viewing different tabs -*- lexical-binding: t; -*- ;; Copyright (C) 2014 Artur Malabarba @@ -24,32 +24,35 @@ ;;; Tabs: -;; - frontpage :: the frontpage of a single site - - -;;; Code: +;; - FrontPage :: The standard front page +;; - Newest :: Newest questions +;; - TopVoted :: Top-voted questions +;; - Hot :: Hot questions recently +;; - Week :: Hot questions for the week +;; - Month :: Hot questions for the month +;; - Unanswered :: Unanswered questions +;; - Unanswered My-tags :: Unanswered questions (subscribed tags) +;; - Featured :: Featured questions +;; - Starred :: Favorite questions (require 'sx) (require 'sx-question-list) (require 'sx-interaction) -(defcustom sx-tab-default-site "emacs" - "Name of the site to use by default when listing questions." - :type 'string - :group 'sx) - -(defvar sx-tab--list nil +(defvar sx-tab--list nil "List of the names of all defined tabs.") (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))))) + +;;; The main macro (defmacro sx-tab--define (tab pager &optional printer refresher &rest body) "Define a StackExchange tab called TAB. @@ -80,16 +83,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 - (funcall (if ido-mode #'ido-completing-read #'completing-read) - (format "Site (%s): " sx-tab-default-site) - (sx-site-get-api-tokens) nil t nil nil - sx-tab-default-site))) + (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 @@ -200,6 +200,81 @@ If SITE is nil, use `sx-tab-default-site'." (file-name-directory load-file-name))) nil t) + +;;; Unanswered +(sx-tab--define "Unanswered" + (lambda (page) + (sx-question-get-questions + sx-question-list--site page nil 'unanswered))) +;;;###autoload +(autoload 'sx-tab-unanswered + (expand-file-name + "sx-tab" + (when load-file-name + (file-name-directory load-file-name))) + nil t) + + +;;; Unanswered My-tags +(sx-tab--define "Unanswered-my-tags" + (lambda (page) + (sx-question-get-questions + sx-question-list--site page nil 'unanswered/my-tags))) +;;;###autoload +(autoload 'sx-tab-unanswered + (expand-file-name + "sx-tab" + (when load-file-name + (file-name-directory load-file-name))) + nil t) + + +;;; Featured +(sx-tab--define "Featured" + (lambda (page) + (sx-question-get-questions + sx-question-list--site page nil 'featured))) +;;;###autoload +(autoload 'sx-tab-featured + (expand-file-name + "sx-tab" + (when load-file-name + (file-name-directory load-file-name))) + nil t) + + +;;; Starred +(sx-tab--define "Starred" + (lambda (page) + (sx-method-call 'me + :page page + :site sx-question-list--site + :auth t + :submethod 'favorites + :filter sx-browse-filter))) +;;;###autoload +(autoload 'sx-tab-featured + (expand-file-name + "sx-tab" + (when load-file-name + (file-name-directory load-file-name))) + nil t) + + +;;; Inter-modes navigation +(defun sx-tab-meta-or-main () + "Switch to the meta version of a main site, or vice-versa. +Inside a question, go to the frontpage of the site this question +belongs to." + (interactive) + (if (and (derived-mode-p 'sx-question-list-mode) + sx-question-list--site) + (sx-question-list-switch-site + (if (string-match "\\`meta\\." sx-question-list--site) + (replace-match "" :fixedcase nil sx-question-list--site) + (concat "meta." sx-question-list--site))) + (sx-tab-frontpage nil (sx--site (sx--data-here 'question))))) + (provide 'sx-tab) ;;; sx-tab.el ends here diff --git a/sx-tag.el b/sx-tag.el new file mode 100644 index 0000000..7ac80c6 --- /dev/null +++ b/sx-tag.el @@ -0,0 +1,90 @@ +;;; sx-tag.el --- retrieving list of tags and handling tags -*- lexical-binding: t; -*- + +;; 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 <http://www.gnu.org/licenses/>. + +;;; Commentary: + + + +;;; Code: +(eval-when-compile + '(require 'cl-lib)) + +(require 'sx) +(require 'sx-method) + + +;;; Getting the list from a site +(defvar sx-tag-filter + (sx-filter-from-nil + (tag.name + tag.synonyms)) + "Filter used when querying tags.") + +(defun sx-tag--get-all (site &optional no-synonyms) + "Retrieve all tags for SITE. +If NO-SYNONYMS is non-nil, don't return synonyms." + (cl-reduce + (lambda (so-far tag) + (let-alist tag + (cons .name + (if no-synonyms so-far + (append .synonyms so-far))))) + (sx-method-call 'tags + :get-all t + :filter sx-tag-filter + :site site) + :initial-value nil)) + +(defun sx-tag--get-some-tags-containing (site string) + "Return at most 100 tags for SITE containing STRING. +Returns an array." + (sx-method-call 'tags + :auth nil + :filter sx-tag-filter + :site site + :keywords `((inname . ,string)))) + +(defun sx-tag--get-some-tag-names-containing (site string) + "Return at most 100 tag names for SITE containing STRING. +Returns a list." + (mapcar (lambda (x) (cdr (assoc 'name x))) + (sx-tag--get-some-tags-containing site string))) + + +;;; Check tag validity +(defun sx-tag--invalid-name-p (site tags) + "Nil if TAGS exist in SITE. +TAGS can be a string (the tag name) or a list of strings. +Fails if TAGS is a list with more than 100 items. +Return the list of invalid tags in TAGS." + (and (listp tags) (> (length tags) 100) + (error "Invalid argument. TAG has more than 100 items")) + (let ((result + (mapcar + (lambda (x) (cdr (assoc 'name x))) + (sx-method-call 'tags + :id (sx--thing-as-string tags) + :submethod 'info + :auth nil + :filter sx-tag-filter + :site site)))) + (cl-remove-if (lambda (x) (member x result)) tags))) + +(provide 'sx-tag) +;;; sx-tag.el ends here + +;; Local Variables: +;; indent-tabs-mode: nil +;; End: @@ -1,4 +1,4 @@ -;;; sx-time.el --- time -*- lexical-binding: t -*- +;;; sx-time.el --- time -*- lexical-binding: t; -*- ;; Copyright (C) 2014 Sean Allred @@ -43,7 +43,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" @@ -1,4 +1,4 @@ -;;; sx.el --- core functions -*- lexical-binding: t -*- +;;; sx.el --- StackExchange client. Ask and answer questions on Stack Overflow, Super User, and the likes -*- lexical-binding: t; -*- ;; Copyright (C) 2014 Sean Allred @@ -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.3")) ;; This program is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by @@ -31,12 +31,11 @@ (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) - ;;; User commands (defun sx-version () @@ -52,45 +51,148 @@ (browse-url "https://github.com/vermiculus/sx.el/issues/new")) -;;; Browsing filter -(defvar sx-browse-filter - '((question.body_markdown - question.comments - question.answers - question.last_editor - question.accepted_answer_id - question.link - question.upvoted - question.downvoted - question.question_id - question.share_link - user.display_name - comment.owner - comment.body_markdown - comment.body - comment.link - comment.edited - comment.creation_date - comment.upvoted - comment.score - comment.post_type - comment.post_id - comment.comment_id - answer.answer_id - answer.last_editor - answer.link - answer.share_link - answer.owner - answer.body_markdown - answer.upvoted - answer.downvoted - answer.comments) - (user.profile_image shallow_user.profile_image)) - "The filter applied when retrieving question data. -See `sx-question-get-questions' and `sx-question-get-question'.") +;;; 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 + (rx string-start + "http" (optional "s") "://" + (or + (sequence + (group-n 1 (+ (not (any "/")))) + ".stackexchange") + (group-n 2 (+ (not (any "/"))))) + "." (+ (not (any "."))) + "/" (* any) + string-end) + "\\1\\2" link)))) + +(defun sx--ensure-site (data) + "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 + (let-alist data + (unless .site_par + ;; @TODO: Change this to .site.api_site_parameter sometime + ;; after February. + (setcdr data (cons (cons 'site_par + (or (cdr (assq 'api_site_parameter .site)) + (sx--site data))) + (cdr data))))) + data)) + +(defun sx--link-to-data (link) + "Convert string LINK into data that can be displayed." + (let ((result (list (cons 'site (sx--site link))))) + ;; Try to strip a question or answer ID + (when (or + ;; Answer + (and (or (string-match + ;; From 'Share' button + (rx "/a/" + ;; Question ID + (group (+ digit)) + ;; User ID + "/" (+ digit) + ;; Answer ID + (group (or (sequence "#" (* any)) "")) + string-end) link) + (string-match + ;; From URL + (rx "/questions/" (+ digit) "/" + (+ (not (any "/"))) "/" + ;; User ID + (optional (group (+ digit))) + (optional "/") + (group (or (sequence "#" (* any)) "")) + string-end) link)) + (push '(type . answer) result)) + ;; Question + (and (or (string-match + ;; From 'Share' button + (rx "/q/" + ;; Question ID + (group (+ digit)) + ;; User ID + (optional "/" (+ digit)) + ;; Answer or Comment ID + (group (or (sequence "#" (* any)) "")) + string-end) link) + (string-match + ;; From URL + (rx "/questions/" + ;; Question ID + (group (+ digit)) + "/") link)) + (push '(type . question) result))) + (push (cons 'id (string-to-number (match-string-no-properties 1 link))) + result)) + result)) + +(defun sx--tree-paths (tree) + "Return a list of all paths in TREE. +Adapted from http://stackoverflow.com/q/3019250." + (if (atom tree) + (list (list tree)) + (apply #'append + (mapcar (lambda (node) + (mapcar (lambda (path) + (cons (car tree) path)) + (sx--tree-paths node))) + (cdr tree))))) + +(defun sx--tree-expand (path-func tree) + "Apply PATH-FUNC to every path in TREE. +Return the result. See `sx--tree-paths'." + (mapcar path-func + (apply #'append + (mapcar #'sx--tree-paths + tree)))) + +(defmacro sx-assoc-let (alist &rest body) + "Use ALIST with `let-alist' to execute BODY. +`.site_par' has a special meaning, thanks to `sx--ensure-site'. +If ALIST doesn't have a `site' property, one is created using the +`link' property." + (declare (indent 1) (debug t)) + (require 'let-alist) + `(progn + (sx--ensure-site ,alist) + ,(macroexpand + `(let-alist ,alist ,@body)))) ;;; 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)) + +(defun sx--multiple-read (prompt hist-var) + "Interactively query the user for a list of strings. +Call `read-string' multiple times, until the input is empty. + +PROMPT is a string displayed to the user and should not end with +a space nor a colon. HIST-VAR is a quoted symbol, indicating a +list in which to store input history." + (let (list input) + (while (not (string= + "" + (setq input (read-string + (concat prompt " [" + (mapconcat #'identity list ",") + "]: ") + "" hist-var)))) + (push input list)) + list)) (defmacro sx-sorted-insert-skip-first (newelt list &optional predicate) "Inserted NEWELT into LIST sorted by PREDICATE. @@ -105,6 +207,12 @@ 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-string) args)))) + (defun sx-message (format-string &rest args) "Display FORMAT-STRING as a message with ARGS. See `format'." @@ -115,63 +223,32 @@ See `format'." (let ((echo (get-text-property (point) 'help-echo))) (when echo (message "%s" echo)))) -(defun sx--thing-as-string (thing &optional sequence-sep) +(defun sx--thing-as-string (thing &optional sequence-sep url-hexify) "Return a string representation of THING. If THING is already a string, just return it. Optional argument SEQUENCE-SEP is the separator applied between -elements of a sequence." - (cond - ((stringp thing) thing) - ((symbolp thing) (symbol-name thing)) - ((numberp thing) (number-to-string thing)) - ((sequencep thing) - (mapconcat #'sx--thing-as-string - thing (if sequence-sep 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)))) +elements of a sequence. If SEQUENCE-SEP is a list, use the first +element for the top level joining, the second for the next level, +etc. \";\" is used as a default. + +If optional argument URL-HEXIFY is non-nil, this function behaves +as `url-hexify-string'; this option is only effective on strings +and sequences of strings." + (let ((process (if url-hexify #'url-hexify-string #'identity)) + (first-f (if (listp sequence-sep) #'car #'identity)) + (rest-f (if (listp sequence-sep) #'cdr #'identity))) + (cond + ((stringp thing) (funcall process thing)) + ((symbolp thing) (funcall process (symbol-name thing))) + ((numberp thing) (number-to-string thing)) + ((sequencep thing) + (mapconcat (lambda (thing) + (sx--thing-as-string + thing (funcall rest-f sequence-sep) url-hexify)) + thing (if sequence-sep + (funcall first-f sequence-sep) + ";")))))) (defun sx--shorten-url (url) "Shorten URL hiding anything other than the domain. @@ -184,38 +261,17 @@ 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))) -(defun sx--unindent-text (text) - "Remove indentation from TEXT." - (with-temp-buffer - (insert text) - (goto-char (point-min)) - (let (result) - (while (null (eobp)) - (skip-chars-forward "[:blank:]") - (unless (looking-at "$") - (push (current-column) result)) - (forward-line 1)) - (when result - (let ((rx (format "^ \\{0,%s\\}" - (apply #'min result)))) - (goto-char (point-min)) - (while (and (null (eobp)) - (search-forward-regexp rx nil 'noerror)) - (replace-match "") - (forward-line 1))))) - (buffer-string))) - ;;; Printing request data (defvar sx--overlays nil "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) @@ -244,72 +300,50 @@ 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 -(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))))) - (unless (stringp link) - (error "Data has no link property")) - (replace-regexp-in-string - "^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)))))) - -(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))" - (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))) - (defcustom sx-init-hook nil "Hook run when SX initializes. Run after `sx-init--internal-hook'." @@ -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 @@ -67,7 +75,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,8 +95,27 @@ 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 +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. @@ -95,7 +123,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= @@ -108,7 +136,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 @@ -117,11 +145,56 @@ 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-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. +- ~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 diff --git a/test/data-samples/inbox-item.el b/test/data-samples/inbox-item.el new file mode 100644 index 0000000..faeba12 --- /dev/null +++ b/test/data-samples/inbox-item.el @@ -0,0 +1,13 @@ +((title . "Can I mark inbox items as read in api v2.2?") + (link . "http://stackapps.com/posts/comments/12080?noredirect=1") + (item_type . "comment") + (question_id . 5059) + (comment_id . 12080) + (creation_date . 1419153905) + (is_unread . :json-false) + (site (site_type . "main_site") + (name . "Stack Apps") + (api_site_parameter . "stackapps") + (site_url . "http://stackapps.com") + (favicon_url . "http://cdn.sstatic.net/stackapps/img/favicon.ico") + (styling (link_color . "#0077DD") (tag_foreground_color . "#555555") (tag_background_color . "#E7ECEC")))) diff --git a/test/test-api.el b/test/test-api.el new file mode 100644 index 0000000..b7d5dbb --- /dev/null +++ b/test/test-api.el @@ -0,0 +1,16 @@ +(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-method-get-all () + "Tests sx-method interface to `sx-request-all-items'" + (should (< 250 (length (sx-method-call 'sites :get-all t))))) diff --git a/test/test-macros.el b/test/test-macros.el new file mode 100644 index 0000000..1634603 --- /dev/null +++ b/test/test-macros.el @@ -0,0 +1,44 @@ +(defmacro sx-test-with-json-data (cell &rest body) + "Run BODY with sample data let-bound to CELL" + (declare (indent 1)) + `(let ((,cell '((test . nil) (test-one . 1) (test-two . 2) + (link . "http://meta.emacs.stackexchange.com/")))) + ,@body)) + +(ert-deftest macro-test--sx-assoc-let () + "Test `sx-assoc-let'" + (sx-test-with-json-data data + (should + (null (let-alist data .site_par)))) + + (sx-test-with-json-data data + (should + (equal (sx-assoc-let data .site_par) + "meta.emacs"))) + + (sx-test-with-json-data data + (should + (equal (sx-assoc-let data (cons .test-one .test-two)) + '(1 . 2))))) + +(ert-deftest macro-test--sx-filter-from-nil () + "Test `sx-filter-from-nil'" + (should + (equal + (sx-filter-from-nil + (one two (three four five) (six seven) + (a b c d e))) + '((one two three.four three.five six.seven + a.b a.c a.d a.e + .backoff + .error_id + .error_message + .error_name + .has_more + .items + .page + .page_size + .quota_max + .quota_remaining + .total) + nil none)))) diff --git a/test/test-printing.el b/test/test-printing.el new file mode 100644 index 0000000..2857cb7 --- /dev/null +++ b/test/test-printing.el @@ -0,0 +1,73 @@ + +;;; Setup +(require 'cl-lib) + +(defmacro line-should-match (regexp) + "Test if the line at point matches REGEXP" + `(let ((line (buffer-substring-no-properties + (line-beginning-position) + (line-end-position)))) + (sx-test-message "Line here is: %S" line) + (should (string-match ,regexp line)))) + +(defmacro question-list-regex (title votes answers &rest tags) + "Construct a matching regexp for TITLE, VOTES, and ANSWERS. +Each element of TAGS is appended at the end of the expression +after being run through `sx-question--tag-format'." + `(rx line-start + (+ whitespace) ,(number-to-string votes) + (+ whitespace) ,(number-to-string answers) + (+ whitespace) + ,title + (+ (any whitespace digit)) + (or "y" "d" "h" "m" "mo" "s") " ago" + (+ whitespace) + (eval (mapconcat #'sx-question--tag-format + (list ,@tags) " ")))) + + +;;; Tests +(ert-deftest question-list-tag () + "Test `sx-question--tag-format'." + (should + (string= + (sx-question--tag-format "tag") + "[tag]"))) + +(ert-deftest question-list-display () + (cl-letf (((symbol-function #'sx-request-make) + (lambda (&rest _) sx-test-data-questions))) + (sx-tab-frontpage nil "emacs") + (switch-to-buffer "*question-list*") + (goto-char (point-min)) + (should (equal (buffer-name) "*question-list*")) + (line-should-match + (question-list-regex + "Focus-hook: attenuate colours when losing focus" + 1 0 "frames" "hooks" "focus")) + (sx-question-list-next 5) + (line-should-match + (question-list-regex + "Babel doesn't wrap results in verbatim" + 0 1 "org-mode" "org-export" "org-babel")) + ;; ;; Use this when we have a real sx-question buffer. + ;; (call-interactively 'sx-question-list-display-question) + ;; (should (equal (buffer-name) "*sx-question*")) + (switch-to-buffer "*question-list*") + (sx-question-list-previous 4) + (line-should-match + (question-list-regex + ""Making tag completion table" Freezes/Blocks -- how to disable" + 2 1 "autocomplete" "performance" "ctags")))) + +(ert-deftest sx--user-@name () + "Test `sx--user-@name' character substitution" + (should + (string= + (sx--user-@name '((display_name . "ĥÞßđłřğĝýÿñńśşšŝżźžçćčĉùúûüŭůòóôõöøőðìíîïıèéêëęàåáâäãåąĵ★"))) + "@hTHssdlrggyynnsssszzzccccuuuuuuooooooooiiiiieeeeeaaaaaaaaj")) + (should + (string= + (sx--user-@name '((display_name . "ĤÞßĐŁŘĞĜÝŸÑŃŚŞŠŜŻŹŽÇĆČĈÙÚÛÜŬŮÒÓÔÕÖØŐÐÌÍÎÏıÈÉÊËĘÀÅÁÂÄÃÅĄĴ"))) + "@HTHssDLRGGYYNNSSSSZZZCCCCUUUUUUOOOOOOOOIIIIiEEEEEAAAAAAAAJ"))) + diff --git a/test/test-search.el b/test/test-search.el new file mode 100644 index 0000000..72f0846 --- /dev/null +++ b/test/test-search.el @@ -0,0 +1,53 @@ +(defmacro test-with-bogus-string (cell &rest body) + "Let-bind a bogus string to CELL and execute BODY." + (declare (indent 1)) + `(let ((,cell "E7631BCF-A94B-4507-8F0C-02CFB3207F55")) + ,@body)) + + +(ert-deftest test-search-basic () + "Test basic search functionality" + (should + (sx-search-get-questions + "emacs" 1 "emacs"))) + +(ert-deftest test-search-empty () + "Test bogus search returns empty vector" + (test-with-bogus-string query + (should + (equal + [] + (sx-search-get-questions "emacs" 1 query))))) + +(ert-deftest test-search-invalid () + "Test invalid search" + (should-error + ;; @todo: test the interactive call + (sx-search + "emacs" nil nil ["emacs"]))) + +(ert-deftest test-search-full-page () + "Test retrieval of the full search page" + (should + (= 100 (length (sx-search-get-questions + "stackoverflow" 1 "jquery"))))) + +(ert-deftest test-search-exclude-tags () + "Test excluding tags from a search" + (should + (cl-every + (lambda (p) + (sx-assoc-let p + (not (member "org-export" .tags)))) + (sx-search-get-questions + "emacs" 1 nil "org-mode" "org-export"))) + (should + (cl-every + (lambda (p) + (sx-assoc-let p + (not (or (member "org-export" .tags) + (member "org-agenda" .tags))))) + (sx-search-get-questions + "emacs" 1 nil "org-mode" + ["org-export" "org-agenda"])))) + diff --git a/test/test-state.el b/test/test-state.el new file mode 100644 index 0000000..7af4a64 --- /dev/null +++ b/test/test-state.el @@ -0,0 +1,22 @@ +(defmacro with-question-data (cell id &rest body) + (declare (indent 2)) + `(let ((,cell '((question_id . ,id) + (site_par . "emacs") + (last_activity_date . 1234123456)))) + ,@body)) + +(ert-deftest test-question-mark-read () + "00ccd139248e782cd8316eff65c26aed838c7e46" + (with-question-data q 10 + ;; Check basic logic. + (should (sx-question--mark-read q)) + (should (sx-question--read-p q)) + (should (not (setcdr (assq 10 (cdr (assoc "emacs" sx-question--user-read-list))) nil))) + ;; Don't freak out because the cdr was nil. + (should (not (sx-question--read-p q))) + (should (sx-question--mark-read q))) + (should + (with-question-data q nil + ;; Don't freak out because question_id was nil. + (sx-question--mark-read q)))) + diff --git a/test/test-util.el b/test/test-util.el new file mode 100644 index 0000000..1e3dc2b --- /dev/null +++ b/test/test-util.el @@ -0,0 +1,45 @@ +(ert-deftest thing-as-string () + "Test `sx--thing-as-string'" + (should + (string= (sx--thing-as-string + '(hello world (this is a test)) + '(";" "+")) + "hello;world;this+is+a+test")) + (should + (string= (sx--thing-as-string + '(this is a test) '(";" "+")) + "this;is;a;test")) + (should + (string= (sx--thing-as-string + '(this is a test) "+") + "this+is+a+test")) + (should + (string= (sx--thing-as-string + '(this is a test)) + "this;is;a;test")) + (should + (string= (sx--thing-as-string + 'test) + "test")) + (should + (string= (sx--thing-as-string + 'test&) + "test&")) + (should + (string= (sx--thing-as-string + 'test& nil t) + "test%26"))) + +(ert-deftest tree () + (should + (equal + (sx--tree-expand + (lambda (path) (mapconcat #'symbol-name path ".")) + '(a b (c d (e f g) h i (j k) l) m (n o) p)) + '("a" "b" "c.d" "c.e.f" "c.e.g" "c.h" "c.i" "c.j.k" "c.l" "m" "n.o" "p"))) + (should + (equal + (sx--tree-expand + (lambda (path) (intern (mapconcat #'symbol-name path "/"))) + '(a b (c d (e f g) h i (j k) l) m (n o) p)) + '(a b c/d c/e/f c/e/g c/h c/i c/j/k c/l m n/o p)))) diff --git a/test/tests.el b/test/tests.el index 75238fe..ce42a9f 100644 --- a/test/tests.el +++ b/test/tests.el @@ -1,3 +1,5 @@ + +;;; SX Settings (defun -sx--nuke () (interactive) (mapatoms @@ -5,11 +7,18 @@ (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 + url-show-status nil + 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/" - (or (file-name-directory 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,116 +29,34 @@ (insert-file-contents file) (read (buffer-string)))))) -(defmacro line-should-match (regexp) - "" - `(let ((line (buffer-substring-no-properties - (line-beginning-position) - (line-end-position)))) - (message "Line here is: %S" line) - (should (string-match ,regexp line)))) - (setq - sx-initialized t - sx-request-remaining-api-requests-message-threshold 50000 - debug-on-error t - user-emacs-directory "." - sx-test-data-questions (sx-test-sample-data "questions") sx-test-data-sites (sx-test-sample-data "sites")) -(setq package-user-dir - (expand-file-name (format "../../.cask/%s/elpa" emacs-version) - sx-test-data-dir)) -(package-initialize) - -(require 'cl-lib) -(require 'sx) -(require 'sx-question) -(require 'sx-question-list) -(require 'sx-tab) - -(ert-deftest test-basic-request () - "Test basic request functionality" - (should (sx-request-make "sites"))) + +;;; General Settings +(setq + package-user-dir (expand-file-name + (format "../../.cask/%s/elpa" emacs-version) + sx-test-data-dir)) -(ert-deftest test-question-retrieve () - "Test the ability to receive a list of questions." - (should (sx-question-get-questions 'emacs))) +(package-initialize) -(ert-deftest test-bad-request () - "Test a method given a bad set of keywords" - (should-error - (sx-request-make "questions" '(())))) +(require 'sx-load) -(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)))) +(defun sx-load-test (test) + (load-file + (format "%s/test-%s.el" + sx-test-base-dir + (symbol-name test)))) - ;; 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))))) +(setq sx-test-enable-messages nil) -(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]+[ydhms] 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\\]") - ;; ;; 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\\]"))) +(defun sx-test-message (message &rest args) + (when sx-test-enable-messages + (apply #'message message args))) -(ert-deftest macro-test--sx-assoc-let () - "Tests macro expansion for `sx-assoc-let'" - (should - (equal '(let ((.test (cdr (assoc 'test data)))) - .test) - (macroexpand - '(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 - '(sx-assoc-let data - (cons .test-one .test-two)))))) +(mapc #'sx-load-test + '(api macros printing util search)) |
