diff --git a/elpa/sx-20160125.1601/sx-auth.el b/elpa/sx-20160125.1601/sx-auth.el new file mode 100644 index 0000000..5fc30ca --- /dev/null +++ b/elpa/sx-20160125.1601/sx-auth.el @@ -0,0 +1,196 @@ +;;; sx-auth.el --- user authentication -*- lexical-binding: t; -*- + +;; Copyright (C) 2014 Sean Allred + +;; Author: Sean Allred + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + +;; This file handles logic related to authentication. This includes +;; determining if a certain filter requires authentication (via the +;; variable `sx-auth-filter-auth' and function `sx-auth--filter-p'), +;; determining if a method requires authentication (via the variable +;; `sx-auth-method-auth' and function `sx-auth--method-p'), and +;; actually authenticating the user (with `sx-auth-authenticate'). + +;;; Code: + +(require 'sx) +(require 'sx-request) +(require 'sx-cache) + +(defconst sx-auth-root + "https://stackexchange.com/oauth/dialog") +(defconst sx-auth-redirect-uri + "http://seanallred.com/sx.el/auth/auth.htm") +(defconst sx-auth-client-id + "3291") +(defvar sx-auth-access-token + nil + "Your access token. +This is needed to use your account to write questions, make +comments, and read your inbox. Do not alter this unless you know +what you are doing! + +This variable is set with `sx-auth-authenticate'.") + +(defconst sx-auth-method-auth + '((me . t) + (inbox . t) + (notifications . t) + (events . t) + (posts (comments add)) + (comments delete + edit + flags + upvote) + (answers accept + delete + downvote + edit + flags + upvote) + (questions answers + add + close + delete + downvote + edit + favorite + flags + render + upvote + (unanswered my-tags))) + "List of methods that require auth. +Methods are of the form \(METHOD . SUBMETHODS) where SUBMETHODS + is \(METHOD METHOD METHOD ...). + +If all SUBMETHODS require auth or there are no submethods, form +will be \(METHOD . t)") + +(defconst sx-auth-filter-auth + '(question.upvoted + question.downvoted + answer.upvoted + answer.downvoted + comment.upvoted) + "List of filter types that require auth. +Keywords are of the form \(OBJECT TYPES) where TYPES is \(FILTER +FILTER FILTER).") + +;;;###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 +questions). + +When this function is called, `browse-url' is used to send the +user to an authorization page managed by StackExchange. The +following privileges are requested: + +* read_inbox + use SX to manage and visit items in your inbox + +* write_acesss + write comments, ask questions, and post answers on your + behalf + +* no_expiry + do not pester you to reauthorize again + +After authorization with StackExchange, the user is then +redirected to a website managed by SX. The access token required +to use authenticated methods is included in the hash (which is +parsed and displayed prominently on the page)." + (interactive) + (setq + sx-auth-access-token + (let ((url (concat + sx-auth-root + "?" + (sx-request--build-keyword-arguments + `((client_id . ,sx-auth-client-id) + (scope . (read_inbox + no_expiry + private_info + write_access)) + (redirect_uri . ,(url-hexify-string + sx-auth-redirect-uri))) + ",")))) + (browse-url url) + (read-string "Enter the access token displayed on the webpage: "))) + (if (string-equal "" sx-auth-access-token) + (progn (setq sx-auth-access-token nil) + (error "You must enter this code to use this client fully")) + (sx-cache-set 'auth `((access_token . ,sx-auth-access-token))))) + +(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." + (let ((method-auth (cdr (assoc method sx-auth-method-auth))) + ;; If the submethod has additional options, they may all be + ;; eligible, in which case we only need to check the `car'. + (sub-head (if (listp submethod) + (car submethod)))) + (lwarn " sx-auth method" :debug "Method %s requires auth" method-auth) + (and method-auth + (or + ;; All submethods require auth. + (eq t method-auth) + ;; All sub-submethods require auth. + (member sub-head method-auth) + ;; Specific submethod requires auth. + (member submethod method-auth))))) + +;; Temporary solution. When we switch to pre-defined filters we will +;; have to change the logic to match against specific filters. +(defun sx-auth--filter-p (filter) + "Check if FILTER contains properties that require authentication. +If it has `auth-required' properties, return a filter that has +removed those properties." + (let* ((incl-filter (if (listp filter) (car filter))) + (rest-filter (if incl-filter (cdr filter))) + (auth-filters (remove nil + ;; Only retrieve the elements that + ;; are issues. + (mapcar (lambda (prop) + (car + (member prop + sx-auth-filter-auth))) + (or incl-filter filter)))) + clean-filter out-filter) + (lwarn "sx-auth filter" :debug "Filter: %S" filter) + ;; Auth-filters is the filters that are issues + (when auth-filters + (setq clean-filter + (cl-remove-if (lambda (prop) + (member prop auth-filters)) + (or incl-filter filter)))) + (if (and incl-filter clean-filter) + (setq out-filter + (cons clean-filter rest-filter)) + (setq out-filter clean-filter)) + (lwarn "sx-auth filter2" :debug "Filter property %s requires auth. %S" + auth-filters out-filter) + out-filter)) + +(provide 'sx-auth) +;;; sx-auth.el ends here + +;; Local Variables: +;; indent-tabs-mode: nil +;; End: diff --git a/elpa/sx-20160125.1601/sx-autoloads.el b/elpa/sx-20160125.1601/sx-autoloads.el new file mode 100644 index 0000000..4bcb087 --- /dev/null +++ b/elpa/sx-20160125.1601/sx-autoloads.el @@ -0,0 +1,154 @@ +;;; sx-autoloads.el --- automatically extracted autoloads +;; +;;; Code: +(add-to-list 'load-path (or (file-name-directory #$) (car load-path))) + +;;;### (autoloads nil "sx" "sx.el" (22499 64016 771000 0)) +;;; Generated autoloads from sx.el + +(autoload 'sx-bug-report "sx" "\ +File a bug report about the `sx' package. + +\(fn)" t nil) + +;;;*** + +;;;### (autoloads nil "sx-auth" "sx-auth.el" (22499 64016 736000 +;;;;;; 0)) +;;; Generated autoloads from sx-auth.el + +(autoload 'sx-authenticate "sx-auth" "\ +Authenticate this application. +Authentication is required to read your personal data (such as +notifications) and to write with the API (asking and answering +questions). + +When this function is called, `browse-url' is used to send the +user to an authorization page managed by StackExchange. The +following privileges are requested: + +* read_inbox + use SX to manage and visit items in your inbox + +* write_acesss + write comments, ask questions, and post answers on your + behalf + +* no_expiry + do not pester you to reauthorize again + +After authorization with StackExchange, the user is then +redirected to a website managed by SX. The access token required +to use authenticated methods is included in the hash (which is +parsed and displayed prominently on the page). + +\(fn)" t nil) + +;;;*** + +;;;### (autoloads nil "sx-inbox" "sx-inbox.el" (22499 64016 832000 +;;;;;; 0)) +;;; Generated autoloads from sx-inbox.el + +(autoload 'sx-inbox "sx-inbox" "\ +Display a buffer listing inbox items. +With prefix NOTIFICATIONS, list notifications instead of inbox. + +\(fn &optional NOTIFICATIONS)" t nil) + +(autoload 'sx-inbox-notifications "sx-inbox" "\ +Display a buffer listing notification items. + +\(fn)" t nil) + +;;;*** + +;;;### (autoloads nil "sx-interaction" "sx-interaction.el" (22499 +;;;;;; 64016 748000 0)) +;;; Generated autoloads from sx-interaction.el + +(autoload 'sx-org-get-link "sx-interaction" "\ +Add a link to this post to Org's memory. + +\(fn)" nil nil) + +(autoload 'sx-ask "sx-interaction" "\ +Start composing a question for SITE. +SITE is a string, indicating where the question will be posted. + +\(fn SITE)" t nil) + +;;;*** + +;;;### (autoloads nil "sx-search" "sx-search.el" (22499 64016 829000 +;;;;;; 0)) +;;; Generated autoloads from sx-search.el + +(autoload 'sx-search "sx-search" "\ +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. + +\(fn SITE QUERY &optional TAGS EXCLUDED-TAGS)" t nil) + +(autoload 'sx-search-tag-at-point "sx-search" "\ +Follow tag under position POS or point. + +\(fn &optional POS)" t nil) + +;;;*** + +;;;### (autoloads nil "sx-switchto" "sx-switchto.el" (22499 64016 +;;;;;; 752000 0)) +;;; Generated autoloads from sx-switchto.el + +(define-prefix-command 'sx-switchto-map) + +;;;*** + +;;;### (autoloads nil "sx-tab" "sx-tab.el" (22499 64016 778000 0)) +;;; Generated autoloads from sx-tab.el + +(autoload 'sx-tab-all-questions "sx-tab" nil t) + +(autoload 'sx-tab-unanswered "sx-tab" nil t) + +(autoload 'sx-tab-unanswered-my-tags "sx-tab" nil t) + +(autoload 'sx-tab-featured "sx-tab" nil t) + +(autoload 'sx-tab-starred "sx-tab" nil t) + +(autoload 'sx-tab-frontpage "sx-tab" nil t) + +(autoload 'sx-tab-newest "sx-tab" nil t) + +(autoload 'sx-tab-topvoted "sx-tab" nil t) + +(autoload 'sx-tab-hot "sx-tab" nil t) + +(autoload 'sx-tab-week "sx-tab" nil t) + +(autoload 'sx-tab-month "sx-tab" nil t) + +;;;*** + +;;;### (autoloads nil nil ("sx-babel.el" "sx-button.el" "sx-cache.el" +;;;;;; "sx-compose.el" "sx-encoding.el" "sx-favorites.el" "sx-filter.el" +;;;;;; "sx-load.el" "sx-method.el" "sx-networks.el" "sx-notify.el" +;;;;;; "sx-pkg.el" "sx-question-list.el" "sx-question-mode.el" "sx-question-print.el" +;;;;;; "sx-question.el" "sx-request.el" "sx-site.el" "sx-tag.el" +;;;;;; "sx-time.el" "sx-user.el") (22499 64016 864121 943000)) + +;;;*** + +;; Local Variables: +;; version-control: never +;; no-byte-compile: t +;; no-update-autoloads: t +;; End: +;;; sx-autoloads.el ends here diff --git a/elpa/sx-20160125.1601/sx-babel.el b/elpa/sx-20160125.1601/sx-babel.el new file mode 100644 index 0000000..7f84fe0 --- /dev/null +++ b/elpa/sx-20160125.1601/sx-babel.el @@ -0,0 +1,133 @@ +;;; sx-babel.el --- font-locking pre blocks according to language -*- lexical-binding: t; -*- + +;; Copyright (C) 2014 Artur Malabarba + +;; Author: Artur Malabarba + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + +;; This file contains functions and a variable for font-locking the +;; content of markdown pre blocks according to their language. The +;; main configuration point, for both the user and the developer is +;; the variable `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) + ;; Not sure if leaving out "[{" might lead to false positives. + (,(rx "\\" (+ alnum) (any "[{")) latex-mode) + ;; Right now, this will match a lot of stuff. Once we are capable + ;; of determining major-mode from tags, site, and comments, this + ;; will work as a last case fallback. + (,(rx (or (and "int" (+ space) "main" (* space) "("))) c-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/elpa/sx-20160125.1601/sx-button.el b/elpa/sx-20160125.1601/sx-button.el new file mode 100644 index 0000000..a4fcb76 --- /dev/null +++ b/elpa/sx-20160125.1601/sx-button.el @@ -0,0 +1,215 @@ +;;; sx-button.el --- defining buttons -*- lexical-binding: t; -*- + +;; Copyright (C) 2014 Artur Malabarba + +;; Author: Artur Malabarba + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: +;; +;; This file defines all buttons used by SX. For information on +;; buttons, see: +;; http://www.gnu.org/software/emacs/manual/html_node/elisp/Buttons.html +;; +;; Most interactive 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 additional properties that can only be determined at +;; creation. Existing text can be transformed into a button with +;; `make-text-button' instead. + + +;;; Code: +(require 'button) + +(require 'sx) +(require 'sx-question) + +(declare-function sx-accept "sx-interaction") +(declare-function sx-answer "sx-interaction") +(declare-function sx-comment "sx-interaction") +(declare-function sx-open-link "sx-interaction") +(declare-function sx-question-mode-hide-show-section "sx-question-mode") + + +;;; Face +(defface sx-custom-button + '((((type x w32 ns) (class color)) ; Like default mode line + :box (:line-width 3 :style released-button) + :height 0.9 + :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 + (let ((map (copy-keymap button-map))) + (define-key map "w" #'sx-button-copy) + map) + "Keymap used on buttons.") + +(defun sx-button-copy () + "Copy the content of thing at point. +This is usually a link's URL, or the content of a code block." + (interactive) + (let ((content + (get-text-property (point) 'sx-button-copy))) + (if (null content) + (sx-message "Nothing to copy here.") + (kill-new content) + (sx-message "Copied %s to kill ring." + (or (get-text-property + (point) 'sx-button-copy-type) + content))))) + +(defun sx-button-edit-this (text-or-marker &optional majormode) + "Open a temp buffer populated with the string TEXT-OR-MARKER using MAJORMODE. +When given a marker (or interactively), use the 'sx-button-copy +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 majormode (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) + (when majormode + (funcall majormode)))) + +(defun sx-button-follow-link (&optional pos) + "Follow link at POS. If POS is nil, use `point'." + (interactive) + (let ((url (or (get-text-property (or pos (point)) 'sx-button-url) + (sx-user-error "No url under point: %s" (or pos (point)))))) + ;; If we didn't recognize the link, this errors immediately. If + ;; we mistakenly recognize it, it will error when we try to fetch + ;; whatever we thought it was. + (condition-case nil (sx-open-link url) + ;; When it errors, don't blame the user, just visit externally. + (error (browse-url url))))) + + +;;; Help-echo definitions +(defconst sx-button--help-echo + (concat "mouse-1, RET" + (propertize ": %s -- " 'face 'minibuffer-prompt) + "w" + (propertize ": copy %s" 'face 'minibuffer-prompt)) + "Base help-echo on which others can be written.") + +(defconst sx-button--user-help-echo + (format sx-button--help-echo + "visit user page" + "link") + "Help echoed in the minibuffer when point is on a user.") + +(defconst sx-button--tag-help-echo + (format sx-button--help-echo + "Tag search" + "tag") + "Help echoed in the minibuffer when point is on a tag.") + +(defconst sx-button--question-title-help-echo + (format sx-button--help-echo + "hide content" + "link") + "Help echoed in the minibuffer when point is on a section.") + +(defconst sx-button--link-help-echo + (format sx-button--help-echo + "visit %s" + "URL") + "Help echoed in the minibuffer when point is on a section.") + + +;;; Type definitions +(define-button-type 'sx-button + 'follow-link t + 'keymap sx-button-map) + +(define-button-type 'sx-question-mode-title + 'face 'sx-question-mode-title + 'action #'sx-question-mode-hide-show-section + 'help-echo sx-button--question-title-help-echo + 'sx-button-copy-type "Share Link" + :supertype 'sx-button) + +(define-button-type 'sx-question-mode-code-block + 'action #'sx-button-edit-this + 'face nil + :supertype 'sx-button) + +(define-button-type 'sx-button-link + 'action #'sx-button-follow-link + :supertype 'sx-button) + +(define-button-type 'sx-button-user + 'action #'sx-button-follow-link + 'help-echo sx-button--user-help-echo + ;; We use different faces on different parts of the user button. + 'face 'sx-user-name + :supertype 'sx-button) + +(declare-function sx-search-tag-at-point "sx-search") +(define-button-type 'sx-button-tag + 'action #'sx-search-tag-at-point + 'help-echo sx-button--tag-help-echo + 'face 'sx-tag + :supertype 'sx-button) + +(define-button-type 'sx-button-comment + 'help-echo (concat "mouse-1, RET" + (propertize ": write a comment" + 'face 'minibuffer-prompt)) + 'face 'sx-custom-button + 'action #'sx-comment + :supertype 'sx-button) + +(define-button-type 'sx-button-accept + 'help-echo (concat "mouse-1, RET" + (propertize ": accept answer" + 'face 'minibuffer-prompt)) + 'face 'sx-custom-button + 'action #'sx-accept + :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: +;; indent-tabs-mode: nil +;; End: diff --git a/elpa/sx-20160125.1601/sx-cache.el b/elpa/sx-20160125.1601/sx-cache.el new file mode 100644 index 0000000..4770fc2 --- /dev/null +++ b/elpa/sx-20160125.1601/sx-cache.el @@ -0,0 +1,119 @@ +;;; sx-cache.el --- caching -*- lexical-binding: t; -*- + +;; Copyright (C) 2014 Sean Allred + +;; Author: Sean Allred + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + +;; This file handles the cache system. All caches are retrieved and +;; set using symbols. The symbol should be the sub-package that is +;; using the cache. For example, `sx-pkg' would use +;; +;; `(sx-cache-get 'pkg)' +;; +;; This symbol is then converted into a filename within +;; `sx-cache-directory' using `sx-cache-get-file-name'. +;; +;; Currently, the cache is written at every `sx-cache-set', but this +;; write will eventually be done by some write-all function which will +;; be set on an idle timer. + +;;; Code: + +(defcustom sx-cache-directory (locate-user-emacs-file ".sx") + "Directory containing cached data." + :type 'directory + :group 'sx) + +(defun sx-cache--ensure-sx-cache-directory-exists () + "Ensure `sx-cache-directory' exists." + (unless (file-exists-p sx-cache-directory) + (mkdir sx-cache-directory))) + +(defun sx-cache-get-file-name (filename) + "Expand FILENAME in the context of `sx-cache-directory'." + (expand-file-name + (concat (symbol-name filename) ".el") + sx-cache-directory)) + +(defun sx-cache-get (cache &optional form) + "Return the data within CACHE. +If CACHE does not exist, use `sx-cache-set' to set CACHE to the +result of evaluating FORM. + +CACHE is resolved to a file name by `sx-cache-get-file-name'." + (sx-cache--ensure-sx-cache-directory-exists) + (let ((file (sx-cache-get-file-name cache))) + ;; If the file exists, return the data it contains + (if (file-exists-p file) + (with-temp-buffer + (insert-file-contents (sx-cache-get-file-name cache)) + (read (buffer-string))) + ;; Otherwise, set CACHE to the evaluation of FORM. + ;; `sx-cache-set' returns the data that CACHE was set to. + (sx-cache-set cache (eval form))))) + +(defun sx-cache-set (cache data) + "Set the content of CACHE to DATA and save. +DATA will be written as returned by `prin1'. + +CACHE is resolved to a file name by `sx-cache-get-file-name'." + (sx-cache--ensure-sx-cache-directory-exists) + (let (print-length print-level) + (write-region (prin1-to-string data) nil + (sx-cache-get-file-name cache))) + data) + +(defun sx-cache--invalidate (cache &optional vars init-method) + "Set cache CACHE to nil. + +VARS is a list of variables to unbind to ensure cache is cleared. +If INIT-METHOD is defined, call it after all invalidation to +re-initialize the cache." + (let ((file (sx-cache-get-file-name cache))) + (delete-file file)) + (mapc #'makunbound vars) + (when init-method + (funcall init-method))) + +(defun sx-cache-invalidate-all (&optional save-auth) + "Invalidate all caches using `sx-cache--invalidate'. +Afterwards reinitialize caches using `sx-initialize'. If +SAVE-AUTH is non-nil, do not clear AUTH cache. + +Interactively, SAVE-AUTH is the negation of the prefix argument. +That is, by default the auth cache is PRESERVED interactively. +If you provide a prefix argument, the auth cache is INVALIDATED. + +Note: This will also remove read/unread status of questions as well +as delete the list of hidden questions." + (interactive (list (not current-prefix-arg))) + (let* ((default-directory sx-cache-directory) + (caches (file-expand-wildcards "*.el"))) + (when save-auth + (setq caches (cl-remove-if (lambda (x) + (string= x "auth.el")) caches))) + (lwarn 'sx :debug "Invalidating: %S" caches) + (mapc #'delete-file caches) + (sx-initialize 'force))) + +(provide 'sx-cache) +;;; sx-cache.el ends here + +;; Local Variables: +;; indent-tabs-mode: nil +;; End: diff --git a/elpa/sx-20160125.1601/sx-compose.el b/elpa/sx-20160125.1601/sx-compose.el new file mode 100644 index 0000000..e3f9c00 --- /dev/null +++ b/elpa/sx-20160125.1601/sx-compose.el @@ -0,0 +1,355 @@ +;;; sx-compose.el --- major-mode for composing questions and answers -*- lexical-binding: t; -*- + +;; Copyright (C) 2014 Artur Malabarba + +;; Author: Artur Malabarba + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + +;; This file 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) +(require 'sx-tag) + +(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'.") + +(defconst 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'.") + +(defconst sx-compose--header-line + '(" " + (:propertize "C-c C-c" face mode-line-buffer-id) + ": Finish and Send" + (sx-compose--is-question-p + (" " + (:propertize "C-c C-q" face mode-line-buffer-id) + ": Insert tags")) + " " + (:propertize "C-c C-k" face mode-line-buffer-id) + ": Discard Draft") + "Header-line used on `sx-compose-mode' drafts.") + +(defvar sx-compose--is-question-p nil + "Non-nil if this `sx-compose-mode' buffer is a question.") +(make-variable-buffer-local 'sx-compose--is-question-p) + +(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. + +If creating a question draft, the `sx-compose--is-question-p' +variable should also be set to enable more functionality. + +\\ +\\{sx-compose-mode}" + (setq header-line-format sx-compose--header-line) + (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) +(sx--define-conditional-key + sx-compose-mode-map "\C-c\C-q" #'sx-compose-insert-tags + sx-compose--is-question-p) + +(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)) + (buf (current-buffer))) + (run-hook-wrapped + 'sx-compose-after-send-functions + (lambda (func) + (with-demoted-errors + "[sx] Error encountered AFTER sending post, but the post was sent successfully: %s" + (funcall func buf result)) + nil))))) + +(defun sx-compose-insert-tags () + "Prompt for a tag list for this draft and insert them." + (interactive) + (save-excursion + (let* ((old (sx-compose--goto-tag-header)) + (new + (save-match-data + (mapconcat + #'identity + (sx-tag-multiple-read sx-compose--site "Tags" old) + " ")))) + (if (match-string 1) + (replace-match new :fixedcase nil nil 1) + (insert new))))) + + +;;; 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) + (ignore-errors (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--goto-tag-header () + "Move to the \"Tags:\" header. +Match data is set so group 1 encompasses any already inserted +tags. Return a list of already inserted tags." + (goto-char (point-min)) + (unless (search-forward-regexp + (rx bol "Tags : " (group-n 1 (* not-newline)) eol) + (next-single-property-change (point-min) 'sx-compose-separator) + 'noerror) + (error "No Tags header found")) + (save-match-data + (sx--split-string (match-string 1) (rx (any space ",;"))))) + +(defun sx-compose--check-tags () + "Check if tags in current compose buffer are valid." + (save-excursion + (let ((invalid-tags + (sx-tag--invalid-name-p + sx-compose--site (sx-compose--goto-tag-header)))) + (if invalid-tags + ;; If the user doesn't want to create the tags, we return + ;; nil and sending is aborted. + (y-or-n-p (format "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--is-question-p is-question) + (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 " + (goto-char (point-min)) + `(,@(when is-question + (let ((inhibit-point-motion-hooks t) + (header-end + (next-single-property-change + (point-min) 'sx-compose-separator)) + keywords) + ;; Read the Title. + (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 (sx--split-string (match-string 1) "[[:space:],;]")) + keywords) + ;; And move past the header so it doesn't get sent. + (goto-char (next-single-property-change + header-end 'sx-compose-separator)) + keywords)) + (body . ,(buffer-substring-no-properties (point) (point-max))))) + +(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/elpa/sx-20160125.1601/sx-encoding.el b/elpa/sx-20160125.1601/sx-encoding.el new file mode 100644 index 0000000..3ce1d6b --- /dev/null +++ b/elpa/sx-20160125.1601/sx-encoding.el @@ -0,0 +1,179 @@ +;;; sx-encoding.el --- encoding -*- lexical-binding: t; -*- + +;; Copyright (C) 2014 Sean Allred + +;; Author: Sean Allred + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + +;; This file handles decoding the responses we get from the API. They +;; are received either as plain-text or as a `gzip' compressed archive. +;; For this, `sx-encoding-gzipped-p' is used to determine if content +;; has been compressed under `gzip'. + +;;; Code: + +(require 'cl-lib) + + +;;;; HTML Encoding + +(defcustom sx-encoding-html-entities-plist + '(Aacute "Á" aacute "á" Acirc "Â" acirc "â" acute "´" AElig "Æ" aelig "æ" + Agrave "À" agrave "à" alefsym "ℵ" Alpha "Α" alpha "α" amp "&" and "∧" + ang "∠" apos "'" aring "å" Aring "Å" asymp "≈" atilde "ã" Atilde "Ã" + auml "ä" Auml "Ä" bdquo "„" Beta "Β" beta "β" brvbar "¦" bull "•" + cap "∩" ccedil "ç" Ccedil "Ç" cedil "¸" cent "¢" Chi "Χ" chi "χ" + circ "ˆ" clubs "♣" cong "≅" copy "©" crarr "↵" cup "∪" curren "¤" + Dagger "‡" dagger "†" darr "↓" dArr "⇓" deg "°" Delta "Δ" delta "δ" + diams "♦" divide "÷" eacute "é" Eacute "É" ecirc "ê" Ecirc "Ê" egrave "è" + Egrave "È" empty "∅" emsp " " ensp " " Epsilon "Ε" epsilon "ε" equiv "≡" + Eta "Η" eta "η" eth "ð" ETH "Ð" euml "ë" Euml "Ë" euro "€" + exist "∃" fnof "ƒ" forall "∀" frac12 "½" frac14 "¼" frac34 "¾" frasl "⁄" + Gamma "Γ" gamma "γ" ge "≥" gt ">" harr "↔" hArr "⇔" hearts "♥" + hellip "…" iacute "í" Iacute "Í" icirc "î" Icirc "Î" iexcl "¡" igrave "ì" + Igrave "Ì" image "ℑ" infin "∞" int "∫" Iota "Ι" iota "ι" iquest "¿" + isin "∈" iuml "ï" Iuml "Ï" Kappa "Κ" kappa "κ" Lambda "Λ" lambda "λ" + lang "〈" laquo "«" larr "←" lArr "⇐" lceil "⌈" ldquo "“" le "≤" + lfloor "⌊" lowast "∗" loz "◊" lrm "" lsaquo "‹" lsquo "‘" lt "<" + macr "¯" mdash "—" micro "µ" middot "·" minus "−" Mu "Μ" mu "μ" + nabla "∇" nbsp " " ndash "–" ne "≠" ni "∋" not "¬" notin "∉" + nsub "⊄" ntilde "ñ" Ntilde "Ñ" Nu "Ν" nu "ν" oacute "ó" Oacute "Ó" + ocirc "ô" Ocirc "Ô" OElig "Œ" oelig "œ" ograve "ò" Ograve "Ò" oline "‾" + omega "ω" Omega "Ω" Omicron "Ο" omicron "ο" oplus "⊕" or "∨" ordf "ª" + ordm "º" oslash "ø" Oslash "Ø" otilde "õ" Otilde "Õ" otimes "⊗" ouml "ö" + Ouml "Ö" para "¶" part "∂" permil "‰" perp "⊥" Phi "Φ" phi "φ" + Pi "Π" pi "π" piv "ϖ" plusmn "±" pound "£" Prime "″" prime "′" + prod "∏" prop "∝" Psi "Ψ" psi "ψ" quot "\"" radic "√" rang "〉" + raquo "»" rarr "→" rArr "⇒" rceil "⌉" rdquo "”" real "ℜ" reg "®" + rfloor "⌋" Rho "Ρ" rho "ρ" rlm "" rsaquo "›" rsquo "’" sbquo "‚" + scaron "š" Scaron "Š" sdot "⋅" sect "§" shy "" Sigma "Σ" sigma "σ" + sigmaf "ς" sim "∼" spades "♠" sub "⊂" sube "⊆" sum "∑" sup "⊃" + sup1 "¹" sup2 "²" sup3 "³" supe "⊇" szlig "ß" Tau "Τ" tau "τ" + there4 "∴" Theta "Θ" theta "θ" thetasym "ϑ" thinsp " " thorn "þ" THORN "Þ" + tilde "˜" times "×" trade "™" uacute "ú" Uacute "Ú" uarr "↑" uArr "⇑" + ucirc "û" Ucirc "Û" ugrave "ù" Ugrave "Ù" uml "¨" upsih "ϒ" Upsilon "Υ" + upsilon "υ" uuml "ü" Uuml "Ü" weierp "℘" Xi "Ξ" xi "ξ" yacute "ý" + Yacute "Ý" yen "¥" yuml "ÿ" Yuml "Ÿ" Zeta "Ζ" zeta "ζ" zwj "" zwnj "") + "Plist of HTML entities and their respective glyphs. +See `sx-encoding-decode-entities'." + :type '(repeat (choice symbol string)) + :group 'sx) + +(defun sx-encoding-decode-entities (string) + "Decode HTML entities (e.g. \""\") in STRING. + +Done according to `sx-encoding-html-entities-plist'. If this +list does not contain the entity, it is assumed to be a number +and converted to a string (with `char-to-string'). + +Return the decoded string." + (let* ((plist sx-encoding-html-entities-plist) + (get-function + (lambda (s) + (let ((ss (substring s 1 -1))) + ;; Handle things like " + (or (plist-get plist (intern ss)) + ;; Handle things like ' + (char-to-string + (string-to-number + ;; Skip the `#' + (substring ss 1)))))))) + (replace-regexp-in-string "&[^; ]*;" get-function string))) + + +;;;; Convenience Functions + +(defun sx-encoding-normalize-line-endings (string) + "Normalize the line endings for STRING. +The API returns strings that use Windows-style line endings. +These are largely useless in an Emacs environment. Windows uses +\"\\r\\n\", Unix uses just \"\\n\". Deleting \"\\r\" is sufficient for +conversion." + (delete ?\r string)) + +(defun sx-encoding-clean-content (string) + "Clean STRING for display. +Applies `sx-encoding-normalize-line-endings' and +`sx-encoding-decode-entities' (in that order) to prepare STRING +for sane display." + (sx-encoding-decode-entities + (sx-encoding-normalize-line-endings + string))) + +(defun sx-encoding-clean-content-deep (data) + "Clean DATA recursively where necessary. + +If DATA is a list or a vector, map this function over DATA and +return as the the same type of structure. + +If DATA is a cons cell (but not a list), use +`sx-encoding-clean-content-deep' on the `cdr' of DATA. + +If DATA is a string, return DATA after applying +`sx-encoding-clean-content'. + +Otherwise, return DATA. + +This function is highly specialized for the data structures +returned by `json-read' via `sx-request-make'. It may fail in +some cases." + (if (consp data) + (if (listp (cdr data)) + (cl-map #'list #'sx-encoding-clean-content-deep data) + (cons (car data) (sx-encoding-clean-content-deep (cdr data)))) + (cond + ((stringp data) + (sx-encoding-clean-content data)) + ((vectorp data) + (cl-map #'vector #'sx-encoding-clean-content-deep data)) + (t data)))) + + +;;;; GZIP + +(defun sx-encoding-gzipped-p (data) + "Check for magic bytes in DATA. +Check if the first two bytes of a string in DATA match the magic +numbers identifying the gzip file format. + +See URL `http://www.gzip.org/zlib/rfc-gzip.html'." + ;; Credit: http://emacs.stackexchange.com/a/2978 + (equal (substring (string-as-unibyte data) 0 2) + (unibyte-string 31 139))) + +(defun sx-encoding-gzipped-buffer-p (buffer) + "Check if BUFFER is gzip-compressed. +See `sx-encoding-gzipped-p'." + (with-current-buffer buffer + (sx-encoding-gzipped-p + (buffer-string)))) + +(defun sx-encoding-gzipped-file-p (file) + "Check if the FILE is gzip-compressed. +See `sx-encoding-gzipped-p'." + (let ((first-two-bytes (with-temp-buffer + (set-buffer-multibyte nil) + (insert-file-contents-literally file nil 0 2) + (buffer-string)))) + (sx-encoding-gzipped-p first-two-bytes))) + +(provide 'sx-encoding) +;;; sx-encoding.el ends here + +;; Local Variables: +;; indent-tabs-mode: nil +;; End: diff --git a/elpa/sx-20160125.1601/sx-favorites.el b/elpa/sx-20160125.1601/sx-favorites.el new file mode 100644 index 0000000..444df29 --- /dev/null +++ b/elpa/sx-20160125.1601/sx-favorites.el @@ -0,0 +1,83 @@ +;;; sx-favorites.el --- starred questions -*- lexical-binding: t; -*- + +;; Copyright (C) 2014 Sean Allred + +;; Author: Sean Allred + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + +;; This file provides logic for retrieving and managing a user's +;; starred questions. + +;;; Code: + +(require 'sx-method) +(require 'sx-cache) +(require 'sx-site) +(require 'sx-networks) +(require 'sx-filter) + +(defconst sx-favorite-list-filter + (sx-filter-from-nil + (question.question_id))) + +(defvar sx-favorites--user-favorite-list nil + "Alist of questions favorited by the user. +Each element has the form (SITE FAVORITE-LIST). And each element +in FAVORITE-LIST is the numerical QUESTION_ID.") + +(defun sx-favorites--initialize () + "Ensure question-favorites cache is available. +Added as hook to initialization." + (or (setq sx-favorites--user-favorite-list + (sx-cache-get 'question-favorites)) + (sx-favorites-update))) +;; ;; Append to ensure `sx-network--initialize' is run before it. +;; This is removed for now because it performs a lot of API calls and +;; was never used. +;; (add-hook 'sx-init--internal-hook #'sx-favorites--initialize 'append) + +(defun sx-favorites--retrieve-favorites (site) + "Obtain list of starred QUESTION_IDs for SITE." + (sx-method-call 'me + :submethod 'favorites + :site site + :filter sx-favorite-list-filter + :auth t)) + +(defun sx-favorites--update-site-favorites (site) + "Update list of starred QUESTION_IDs for SITE. +Writes list to cache QUESTION-FAVORITES." + (let* ((favs (sx-favorites--retrieve-favorites site)) + (site-cell (assoc site + sx-favorites--user-favorite-list)) + (fav-cell (mapcar #'cdar favs))) + (if site-cell + (setcdr site-cell fav-cell) + (push (cons site fav-cell) sx-favorites--user-favorite-list)) + (sx-cache-set 'question-favorites sx-favorites--user-favorite-list))) + +(defun sx-favorites-update () + "Update all sites retrieved from `sx-network--user-sites'." + (mapc #'sx-favorites--update-site-favorites + sx-network--user-sites)) + +(provide 'sx-favorites) +;;; sx-favorites.el ends here + +;; Local Variables: +;; indent-tabs-mode: nil +;; End: diff --git a/elpa/sx-20160125.1601/sx-filter.el b/elpa/sx-20160125.1601/sx-filter.el new file mode 100644 index 0000000..31e0470 --- /dev/null +++ b/elpa/sx-20160125.1601/sx-filter.el @@ -0,0 +1,172 @@ +;;; sx-filter.el --- handles retrieval of filters -*- lexical-binding: t; -*- + +;; Copyright (C) 2014 Sean Allred + +;; Author: Sean Allred + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + +;; This file manages filters and provides an API to compile filters +;; and retrieve them from the cache. See `sx-filter-compile' and +;; `sx-filter-get-var', respectively. + +;;; Code: + + +;;; Dependencies + +(require 'sx) +(require 'sx-cache) +(require 'sx-request) + + +;;; Customizations + +(defvar sx--filter-alist + nil + "An alist of known filters. See `sx-filter-compile'. +Structure: + + (((INCLUDE EXCLUDE BASE ) . \"compiled filter \") + ((INCLUDE2 EXCLUDE2 BASE2) . \"compiled filter2\") + ...)") + + +;;; Creation +(defmacro sx-filter-from-nil (included) + "Create 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 + ) + nil nil))) + +;;; @TODO allow BASE to be a precompiled filter name +(defun sx-filter-compile (&optional include exclude base) + "Compile INCLUDE and EXCLUDE into a filter derived from BASE. +INCLUDE and EXCLUDE must both be lists; BASE should be a symbol. + +Returns the compiled filter as a string." + (let ((keyword-arguments + `((include . ,(if include (sx--thing-as-string include))) + (exclude . ,(if exclude (sx--thing-as-string exclude))) + (base . ,(if base base))))) + (let ((result (elt (sx-request-make "filter/create" keyword-arguments) 0))) + (sx-assoc-let result + .filter)))) + + +;;; Storage and Retrieval + +(defun sx-filter-get-var (filter-variable) + "Return the string representation of FILTER-VARIABLE." + (apply #'sx-filter-get filter-variable)) + +(defun sx-filter-get (&optional include exclude base) + "Return the string representation of the given filter. + +If the filter data exists in `sx--filter-alist', that value will +be returned. Otherwise, compile INCLUDE, EXCLUDE, and BASE into +a filter with `sx-filter-compile' and push the association onto +`sx--filter-alist'. Re-cache the alist with `sx-cache-set' and +return the compiled filter." + (unless sx--filter-alist + (setq sx--filter-alist (sx-cache-get 'filter))) + (or (cdr (assoc (list include exclude base) sx--filter-alist)) + (let ((filter (sx-filter-compile include exclude base))) + (when filter + (push (cons (list include exclude base) filter) sx--filter-alist) + (sx-cache-set 'filter sx--filter-alist) + filter)))) + + +;;; Browsing filter +(defconst sx-browse-filter + (sx-filter-from-nil + ((question body_markdown + bounty_amount + comments + creation_date + closed_reason + closed_date + closed_details + answers + answer_count + score + title + owner + tags + last_editor + last_activity_date + accepted_answer_id + link + upvoted + downvoted + question_id + share_link) + (user display_name + link + accept_rate + reputation) + (shallow_user display_name + link + accept_rate + reputation) + (comment owner + body_markdown + body + link + edited + creation_date + upvoted + score + post_type + post_id + comment_id) + (answer answer_id + creation_date + last_editor + last_activity_date + link + share_link + score + 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 + +;; Local Variables: +;; indent-tabs-mode: nil +;; End: diff --git a/elpa/sx-20160125.1601/sx-inbox.el b/elpa/sx-20160125.1601/sx-inbox.el new file mode 100644 index 0000000..6114516 --- /dev/null +++ b/elpa/sx-20160125.1601/sx-inbox.el @@ -0,0 +1,216 @@ +;;; sx-inbox.el --- base inbox logic -*- lexical-binding: t; -*- + +;; Copyright (C) 2014 Artur Malabarba + +;; Author: Artur Malabarba + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + +;;; Code: + +(require 'sx) +(require 'sx-filter) +(require 'sx-method) +(require 'sx-question-list) +(require 'sx-interaction) + + +;;; API +(defconst 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 + :page page + :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.") + +(defconst 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.") + +(defconst 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)) + + +;;; 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.") + +;;;###autoload +(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)))) + +;;;###autoload +(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/elpa/sx-20160125.1601/sx-interaction.el b/elpa/sx-20160125.1601/sx-interaction.el new file mode 100644 index 0000000..5d1039e --- /dev/null +++ b/elpa/sx-20160125.1601/sx-interaction.el @@ -0,0 +1,577 @@ +;;; sx-interaction.el --- voting, commenting, and other interaction -*- lexical-binding: t; -*- + +;; Copyright (C) 2014 Artur Malabarba + +;; Author: Artur Malabarba + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + +;; This file 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) +(require 'sx-cache) + + +;;; Using data in buffer +(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 %s found here" (or type "data"))))) + +(defun sx--marker-to-data (marker &rest rest) + "Get the data at MARKER. +REST is passed to `sx--data-here'." + (save-excursion + (goto-char marker) + (apply #'sx--data-here rest))) + +(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 (&optional buffer site id) + "Refresh whatever is displayed in BUFFER or the current buffer. +If BUFFER is not live, nothing is done. + +If SITE is given but ID isn't, only update if BUFFER appears to +be a question-list displaying SITE. +If both SITE and ID are given, only update if BUFFER appears to +be a question matching SITE and ID." + (setq buffer (or buffer (current-buffer))) + (when (buffer-live-p buffer) + (with-current-buffer buffer + (cond ((derived-mode-p 'sx-question-list-mode) + (when (or (not site) + (and (not id) + (string= site sx-question-list--site))) + (sx-question-list-refresh 'redisplay 'no-update))) + ((derived-mode-p 'sx-question-mode) + (when (or (not site) + (and id + (equal + (let-alist (sx--data-here 'question) + (cons .site_par .question_id)) + (cons site id)))) + (sx-question-mode-refresh 'no-update))))))) + +(defun sx--copy-data (from to) + "Copy all fields of alist FORM onto TO. +Only fields contained in TO are copied." + (setcar to (car from)) + (setcdr to (cdr from))) + +(defun sx-ensure-authentication () + "Signal user-error if the user refuses to authenticate. +Note that `sx-method-call' already does authentication checking. +This function is meant to be used by commands that don't +immediately perform method calls, such as `sx-ask'. This way, +the unauthenticated user will be prompted before going through +the trouble of composing an entire question." + (unless (sx-cache-get 'auth) + (if (y-or-n-p "This command requires authentication, would you like to authenticate? ") + (sx-authenticate) + (sx-user-error "This command requires authentication, please run `M-x sx-authenticate' and try again.")))) + +(defmacro sx--make-update-callback (&rest body) + "Return a function that runs BODY and updates display. +`sx--maybe-update-display' is only called if the buffer where the +function was created still exists. In that case, BODY is also +run in this buffer." + (declare (debug t)) + `(let ((buffer (current-buffer))) + (lambda (result) + ;; See http://emacs.stackexchange.com/a/10725/50 + (ignore result) + (if (buffer-live-p buffer) + (with-current-buffer buffer + ,@body + (sx--maybe-update-display)) + ,@body)))) + +(defun sx--copy-update-callback (data) + "Return a function that overwrites DATA and updates display. +First, DATA is destructively overwritten with the car of the +argument passed to the function. Then, +`sx--maybe-update-display' is called in the original buffer." + (sx--make-update-callback + ;; The api returns the new DATA. + (when result + (sx--copy-data (elt result 0) data)))) + + +;;; Visiting +(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. + +If copy-as-kill is non-nil, do not call `browse-url'. +Instead, copy the link as a new kill with `kill-new'. +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 + (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))))) + +(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)))) + ;; For now, we have no chance of handling chat links, let's just + ;; send them to the browser. + (if (string-match (rx string-start "http" (opt "s") "://chat.") link) + (sx-visit-externally link) + (let ((data (sx--link-to-data link))) + (sx-assoc-let data + (cl-case .type + (comment + (sx-display-question + (sx-question-get-from-comment .site_par .id) 'focus) + (sx--find-in-buffer 'comment .id)) + (answer + (sx-display-question + (sx-question-get-from-answer .site_par .id) 'focus) + (sx--find-in-buffer 'answer .id)) + (question + (sx-display-question + (sx-question-get-question .site_par .id) 'focus)) + (t (error "Don't know how to open this link, please file a bug report: %s" + link) + nil)))))) + +;;;###autoload +(defun sx-org-get-link () + "Add a link to this post to Org's memory." + (when (memq major-mode '(sx-question-mode sx-question-list-mode)) + (sx-assoc-let (sx--data-here) + (when .link + (org-store-link-props :type 'http + :link .link + :description .title))))) +(eval-after-load "org" + '(add-to-list 'org-store-link-functions #'sx-org-get-link)) + + +;;; 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 + ;; This is an attempt to identify when we have the question + ;; object itself, so there's no need to fetch anything. This + ;; happens inside the question-list, but it can be easily + ;; confused with the inbox (whose items have a title, a body, and + ;; a question_id). + ((and .title .question_id .score + (not .item_type) (not .notification_type)) + (sx-display-question data 'focus)) + (.answer_id + (sx-display-question + (sx-question-get-from-answer .site_par .answer_id) + 'focus) + (if .comment_id + (sx--find-in-buffer 'comment .comment_id) + (sx--find-in-buffer 'answer .answer_id))) + (.question_id + (sx-display-question + (sx-question-get-question .site_par .question_id) 'focus) + (when .comment_id + (sx--find-in-buffer 'comment .comment_id))) + ;; `sx-question-get-from-comment' takes 2 api requests, so we + ;; test it last. + (.comment_id + (sx-display-question + (sx-question-get-from-comment .site_par .comment_id) 'focus) + (sx--find-in-buffer 'comment .comment_id)) + (.notification_type + (sx-message "Viewing notifications is not yet implemented")) + (.item_type (sx-open-link .link))))) + +(defun sx-display-question (&optional data focus window) + "Display question given by DATA, on WINDOW. +Interactively, display question under point. When FOCUS is +non-nil (the default when called interactively), also focus the +relevant window. + +If WINDOW nil, the window is decided by +`sx-question-mode-display-buffer-function'." + (interactive (list (sx--data-here 'question) t)) + (when (sx-question--mark-read data) + (sx--maybe-update-display)) + ;; Display the question. + (setq window + (get-buffer-window + (sx-question-mode--display data window))) + (when focus + (if (window-live-p window) + (select-window window) + (switch-to-buffer sx-question-mode--buffer)))) + + +;;; Simple interactions +(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-method-post-from-data data + (if undo 'favorite/undo 'favorite) + :callback (sx--copy-update-callback data))) +(defalias 'sx-star #'sx-favorite) + +(defun sx-accept (data &optional undo) + "Accept answer given by DATA. +Interactively, it is guessed from context at point. +With the UNDO prefix argument, unaccept the question instead." + (interactive (list (sx--data-here 'answer) + current-prefix-arg)) + (sx-ensure-authentication) + ;; When clicking the "Accept" button, first arg is a marker. + (when (markerp data) + (setq data (sx--marker-to-data data 'answer))) + (sx-method-post-from-data data + (if undo 'accept/undo 'accept) + :callback (sx--copy-update-callback data))) + + +;;; Voting +(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. +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-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. +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. +DATA can be a question, answer, or comment. TYPE can be +\"upvote\" or \"downvote\". STATUS is a boolean. + +Besides posting to the api, DATA is also altered to reflect the +changes." + (sx-ensure-authentication) + (sx-method-post-from-data data + (concat type (unless status "/undo")) + :callback (sx--copy-update-callback data))) + + +;;; Delete +(defun sx-delete (data &optional undo) + "Delete an object given by DATA. +DATA can be a question, answer, or comment. Interactively, it is +guessed from context at point. +With UNDO prefix argument, undelete instead." + (interactive (list (sx--error-if-unread (sx--data-here)) + current-prefix-arg)) + (sx-ensure-authentication) + (when (y-or-n-p (format "DELETE this %s? " + (let-alist data + (cond (.comment_id "comment") + (.answer_id "answer") + (.question_id "question"))))) + (sx-method-post-from-data data + (if undo 'delete/undo 'delete) + :callback (sx--make-update-callback + ;; Indicate to ourselves this has been deleted. + (setcdr data (cons (car data) (cdr data))) + (setcar data 'deleted))))) + + +;;; Commenting +(defun sx-comment (data &optional text) + "Post a comment on DATA given by TEXT. +DATA can be a question, an answer, or a comment. Interactively, +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--error-if-unread (sx--data-here)) 'query)) + (sx-ensure-authentication) + ;; When clicking the "Add a Comment" button, first arg is a marker. + (when (markerp data) + (setq data (sx--marker-to-data data)) + (setq text 'query)) + (sx-assoc-let data + ;; Get the comment text + (when (eq text 'query) + (setq text (read-string + "Comment text: " + (when .comment_id + (substring-no-properties (sx-user--format "%@ " .owner))))) + (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")) + ;; And post + (let ((result + (sx-method-call 'posts + :id (or .post_id .answer_id .question_id) + :submethod "comments/add" + :auth 'warn + :url-method 'post + :filter sx-browse-filter + :site .site_par + :keywords `((body . ,text))))) + ;; The api returns the new DATA. + (when result + (sx--add-comment-to-object + (sx--ensure-owner-in-object (list (cons 'display_name "(You)")) (elt result 0)) + (if .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'. +SITE is a string. +ID is an integer." + (let ((db (cons sx-question-mode--data + sx-question-list--dataset))) + (setq db + (cond + ((string= type "question") db) + ((string= type "answer") + (apply #'cl-map 'list #'identity + (mapcar (lambda (x) (cdr (assoc 'answers x))) db))))) + (car (cl-member-if + (lambda (x) (sx-assoc-let x + (and (equal (or .answer_id .question_id) id) + (equal .site_par site)))) + db)))) + +(defun sx--add-comment-to-object (comment object) + "Add COMMENT to OBJECT's `comments' property. +OBJECT can be a question or an answer." + (let ((com-cell (assoc 'comments object))) + (if com-cell + (progn + (setcdr + com-cell + (append (cdr com-cell) + (list comment)))) + ;; No previous comments, add it manually. + (setcdr object (cons (car object) (cdr object))) + (setcar object `(comments . (,comment))))) + object) + +(defun sx--ensure-owner-in-object (owner object) + "Add `owner' property with value OWNER to OBJECT." + (unless (cdr-safe (assq 'owner object)) + (setcdr object (cons (car object) (cdr object))) + (setcar object `(owner . ,owner))) + object) + + +;;; 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))) + (sx-ensure-authentication) + ;; 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))) + (sx-ensure-authentication) + (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)))) + (sx-ensure-authentication) + ;; 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) data) + (sx--maybe-update-display buffer .site_par .question_id)))))))) + +(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 (append (cdr cell) (list answer))) + ;; No previous comments, add it manually. + (setcdr question (cons (car question) (cdr question))) + (setcar question `(answers . (,answer)))) + question)) + +(provide 'sx-interaction) +;;; sx-interaction.el ends here + +;; Local Variables: +;; indent-tabs-mode: nil +;; End: diff --git a/elpa/sx-20160125.1601/sx-load.el b/elpa/sx-20160125.1601/sx-load.el new file mode 100644 index 0000000..003f965 --- /dev/null +++ b/elpa/sx-20160125.1601/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 + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + +;;; Code: +(mapc #'require + '(sx + sx-time + sx-auth + sx-button + sx-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/elpa/sx-20160125.1601/sx-method.el b/elpa/sx-20160125.1601/sx-method.el new file mode 100644 index 0000000..98d510b --- /dev/null +++ b/elpa/sx-20160125.1601/sx-method.el @@ -0,0 +1,184 @@ +;;; sx-method.el --- method calls -*- lexical-binding: t; -*- + +;; Copyright (C) 2014 Sean Allred + +;; Author: Sean Allred + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + +;;; This file is effectively a common-use wrapper for +;;; `sx-request-make'. It provides higher-level handling such as +;;; (authentication, filters, ...) that `sx-request-make' doesn't need +;;; to handle. + +;;; Code: +(require 'json) +(require 'url) +(require 'sx) +(require 'sx-auth) +(require 'sx-request) +(require 'sx-filter) + +(cl-defun sx-method-call (method &key id + submethod + keywords + page + (pagesize 100) + (filter '(())) + auth + (url-method 'get) + get-all + (process-function + #'sx-request-response-get-items) + callback + site) + "Call METHOD with additional keys. + +ID is the id associated with a question, answer, comment, post or +user. +SUBMETHOD is the additional segments of the method. +KEYWORDS are the api parameters. Some parameters have their own +keywords too, for convenience. The KEYWORDS argument overrides +parameter specific keywords. +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' +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 +CALLBACK is a function to be called if the request succeeds. It +is given the returned result as an argument. + +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 +to ensure awareness of where auth is needed. + +When AUTH Is t, filters will automatically use a non-auth subset if +no `access_token' is available. Methods requiring auth will instead +use `sx-request-fallback' rather than have a failed API response. +This is meant to allow for UI pages where portions may require AUTH +but could still be used without authenticating (i.e a launch/home page). + +When AUTH is 'warn, methods will signal a `user-error'. This is meant +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)) + (method-auth (sx-auth--method-p method submethod)) + (filter-auth (sx-auth--filter-p filter)) + (full-method (concat (format "%s" method) + (when id + (format "/%s" id)) + (when submethod + (format "/%s" submethod)) + ;; On GET methods site is buggy, so we + ;; need to provide it as a url argument. + (when (and site (eq url-method 'get)) + (prog1 + (format "?site=%s" site) + (setq site nil))))) + (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)) + (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)) + ;; 3. Need auth for type. Use auth-less filter. + ((and filter-auth auth) + (setq filter filter-auth)) + ;; 4. Requires auth but no value set for auth + ((and (or filter-auth method-auth) (not auth)) + (error "This request requires authentication.")))) + ;; Concatenate all parameters now that filter is ensured. + (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 + (push `(site . ,site) keywords)) + (let ((result (funcall call + full-method + keywords + url-method + (or get-all process-function)))) + (when callback + (funcall callback result)) + result))) + +(defun sx-method-post-from-data (data &rest keys) + "Make a POST `sx-method-call', deriving parameters from DATA. +KEYS are [KEYWORD VALUE] pairs passed to `sx-method-call', except +the following which are decided by this function: + + METHOD :site and :id are derived from DATA, where METHOD is + either \"answers\", \"comments\", or \"questions\". + :url-method is post. + :filter is `sx-browse-filter'. + :auth is warn. + +As a special exception, if the car of KEYS is not a keyword, it +is assumed to be the :submethod argument." + (declare (indent 1)) + (sx-assoc-let data + (apply #'sx-method-call + (cond (.comment_id "comments") + (.answer_id "answers") + (.question_id "questions")) + :id (or .comment_id .answer_id .question_id) + :auth 'warn + :url-method 'post + :filter sx-browse-filter + :site .site_par + (if (keywordp (car keys)) + keys + (cons :submethod keys))))) + +(provide 'sx-method) +;;; sx-method.el ends here + +;; Local Variables: +;; indent-tabs-mode: nil +;; End: diff --git a/elpa/sx-20160125.1601/sx-networks.el b/elpa/sx-20160125.1601/sx-networks.el new file mode 100644 index 0000000..8bd9d34 --- /dev/null +++ b/elpa/sx-20160125.1601/sx-networks.el @@ -0,0 +1,105 @@ +;;; sx-networks.el --- user network information -*- lexical-binding: t; -*- + +;; Copyright (C) 2014 Sean Allred + +;; Author: Sean Allred + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + +;; This file provides logic for retrieving information about the user +;; across the entire network, e.g. their registered sites. + +;;; Code: + +(require 'sx-method) +(require 'sx-cache) +(require 'sx-site) +(require 'sx-filter) + +(defvar sx-network--user-information nil + "User information for the various sites.") + +(defvar sx-network--user-information-alist nil + "User information for the various site parameters.") + +(defvar sx-network--user-sites nil + "List of sites where user already has an account.") + +(defconst sx-network--user-filter + (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. +If cache is not available, retrieve current data." + (unless (setq sx-network--user-information (sx-cache-get 'network-user)) + (sx-network--update)) + (let ((url-par-alist (mapcar (lambda (x) + (cons (cdr (assoc 'site_url x)) + (cdr (assoc 'api_site_parameter + x)))) + (sx-site--get-site-list)))) + (setq sx-network--user-sites nil) + (setq sx-network--user-information-alist nil) + (mapc (lambda (nu) + (let ((parameter (cdr (assoc (cdr (assq 'site_url nu)) + url-par-alist)))) + (push parameter sx-network--user-sites) + (push (cons parameter nu) + sx-network--user-information-alist))) + sx-network--user-information))) + +(defun sx-network--update () + "Update user information. +Sets cache and then uses `sx-network--get-associated' to update +the variables." + (setq sx-network--user-information + (sx-method-call 'me + :submethod 'associated + :keywords '((types . (main_site meta_site))) + :filter sx-network--user-filter + :auth t)) + (sx-cache-set 'network-user sx-network--user-information)) + +(defun sx-network--initialize () + "Ensure network-user cache is available. +Added as hook to initialization." + ;; Cache was not retrieved, retrieve it. + (sx-network--get-associated)) +(add-hook 'sx-init--internal-hook #'sx-network--initialize) + +(defun sx-network-user (site) + "Return an alist containing user information for SITE." + (cdr (assoc site sx-network--user-information-alist))) + +(provide 'sx-networks) +;;; sx-networks.el ends here + +;; Local Variables: +;; indent-tabs-mode: nil +;; End: diff --git a/elpa/sx-20160125.1601/sx-notify.el b/elpa/sx-20160125.1601/sx-notify.el new file mode 100644 index 0000000..24aa9b7 --- /dev/null +++ b/elpa/sx-20160125.1601/sx-notify.el @@ -0,0 +1,86 @@ +;;; sx-notify.el --- mode-line notifications -*- lexical-binding: t; -*- + +;; Copyright (C) 2014 Artur Malabarba + +;; Author: Artur Malabarba + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + + +;;; Code: + +(require 'sx) +(require 'sx-inbox) + + +;;; mode-line notification +(defconst 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)) + (sx-inbox-get))) + (setq sx-inbox--unread-notifications + (cl-remove-if + (lambda (x) (member (cdr (assq 'link x)) sx-inbox--read-notifications)) + (sx-inbox-get t)))) + +(provide 'sx-notify) +;;; sx-notify.el ends here + +;; Local Variables: +;; indent-tabs-mode: nil +;; End: diff --git a/elpa/sx-20160125.1601/sx-pkg.el b/elpa/sx-20160125.1601/sx-pkg.el new file mode 100644 index 0000000..c2a0028 --- /dev/null +++ b/elpa/sx-20160125.1601/sx-pkg.el @@ -0,0 +1,11 @@ +(define-package "sx" "20160125.1601" "StackExchange client. Ask and answer questions on Stack Overflow, Super User, and the likes" + '((emacs "24.1") + (cl-lib "0.5") + (json "1.3") + (markdown-mode "2.0") + (let-alist "1.0.3")) + :url "https://github.com/vermiculus/sx.el/" :keywords + '("help" "hypermedia" "tools")) +;; Local Variables: +;; no-byte-compile: t +;; End: diff --git a/elpa/sx-20160125.1601/sx-question-list.el b/elpa/sx-20160125.1601/sx-question-list.el new file mode 100644 index 0000000..ea91045 --- /dev/null +++ b/elpa/sx-20160125.1601/sx-question-list.el @@ -0,0 +1,674 @@ +;;; sx-question-list.el --- major-mode for navigating questions list -*- lexical-binding: t; -*- + +;; Copyright (C) 2014 Artur Malabarba + +;; Author: Artur Malabarba + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + +;; Provides question list logic (as used in e.g. `sx-tab-frontpage'). + +;;; Code: +(require 'tabulated-list) +(require 'cl-lib) + +(require 'sx) +(require 'sx-switchto) +(require 'sx-time) +(require 'sx-tag) +(require 'sx-site) +(require 'sx-question) +(require 'sx-question-mode) +(require 'sx-favorites) + +(defgroup sx-question-list nil + "Customization group for sx-question-list." + :prefix "sx-question-list-" + :tag "SX Question List" + :group 'sx) + +(defgroup sx-question-list-faces nil + "Customization group for the faces of `sx-question-list'." + :prefix "sx-question-list-" + :tag "SX Question List Faces" + :group 'sx-question-list) + + +;;; Customization +(defcustom sx-question-list-height 12 + "Height, in lines, of SX's *question-list* buffer." + :type 'integer + :group 'sx-question-list) + +(defcustom sx-question-list-excluded-tags nil + "List of tags (strings) to be excluded from the question list." + :type '(repeat string) + :group 'sx-question-list) + +(defface sx-question-list-parent + '((t :inherit default)) + "" + :group 'sx-question-list-faces) + +(defface sx-question-list-answers + '((((background light)) :foreground "SeaGreen4" + :height 1.0 :inherit sx-question-list-parent) + (((background dark)) :foreground "#D1FA71" + :height 1.0 :inherit sx-question-list-parent) + (t :inherit sx-question-list-parent)) + "" + :group 'sx-question-list-faces) + +(defface sx-question-list-answers-accepted + '((t :box 1 :inherit sx-question-list-answers)) + "" + :group 'sx-question-list-faces) + +(defface sx-question-list-score + '((t :height 1.0 :inherit sx-question-list-parent)) + "" + :group 'sx-question-list-faces) + +(defface sx-question-list-score-upvoted + '((t :weight bold + :inherit sx-question-list-score)) + "" + :group 'sx-question-list-faces) + +(defface sx-question-list-date + '((t :inherit font-lock-comment-face)) + "" + :group 'sx-question-list-faces) + +(defface sx-question-list-read-question + '((t :height 1.0 :inherit sx-question-list-parent)) + "" + :group 'sx-question-list-faces) + +(defface sx-question-list-unread-question + '((t :weight bold :inherit sx-question-list-read-question)) + "" + :group 'sx-question-list-faces) + +(defface sx-question-list-favorite + '((t :inherit sx-question-list-score-upvoted)) + "" + :group 'sx-question-list-faces) + +(defface sx-question-list-bounty + '((t :inherit font-lock-warning-face)) + "" + :group 'sx-question-list-faces) + + +;;; Backend variables + +(defvar sx-question-list--site nil + "Site being displayed in the *question-list* buffer.") +(make-variable-buffer-local 'sx-question-list--site) + +(defvar sx-question-list--order nil + "Order being displayed in the *question-list* buffer. +This is also affected by `sx-question-list--descending'.") +(make-variable-buffer-local 'sx-question-list--order) + +(defvar sx-question-list--descending t + "In which direction should `sx-question-list--order' be sorted. +If non-nil (default), descending. +If nil, ascending.") +(make-variable-buffer-local 'sx-question-list--order) + +(defvar sx-question-list--print-function #'sx-question-list--print-info + "Function to convert a question alist into a tabulated-list entry. +Used by `sx-question-list-mode', the default value is +`sx-question-list--print-info'. + +If this is set to a different value, it may be necessary to +change `tabulated-list-format' accordingly.") +(make-variable-buffer-local 'sx-question-list--print-function) + +(defcustom sx-question-list-ago-string " ago" + "String appended to descriptions of the time since something happened. +Used in the questions list to indicate a question was updated +\"4d ago\"." + :type 'string + :group 'sx-question-list) + +(defun sx-question-list--print-info (question-data) + "Convert `json-read' QUESTION-DATA into tabulated-list format. + +This is the default printer used by `sx-question-list'. It +assumes QUESTION-DATA is an alist containing (at least) the +elements: + `question_id', `site_par', `score', `upvoted', `answer_count', + `title', `bounty_amount', `bounty_amount', `bounty_amount', + `last_activity_date', `tags', `owner'. + +Also see `sx-question-list-refresh'." + (sx-assoc-let question-data + (let ((favorite (if (member .question_id + (assoc .site_par + sx-favorites--user-favorite-list)) + (if (char-displayable-p ?\x2b26) "\x2b26" "*") " "))) + (list + question-data + (vector + (list (int-to-string .score) + 'face (if .upvoted 'sx-question-list-score-upvoted + 'sx-question-list-score)) + (list (int-to-string .answer_count) + 'face (if (sx-question--accepted-answer-id question-data) + '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) + (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) + " " + ;; @TODO: Make this width customizable. (Or maybe just make + ;; the whole thing customizable) + (format "%-40s" (sx-tag--format-tags .tags sx-question-list--site)) + " " + (sx-user--format "%15d %4r" .owner) + (propertize " " 'display "\n"))))))) + +(defvar sx-question-list--pages-so-far 0 + "Number of pages currently being displayed. +This variable gets reset to 0 before every refresh. +It should be used by `sx-question-list--next-page-function'.") +(make-variable-buffer-local 'sx-question-list--pages-so-far) + +(defvar sx-question-list--refresh-function nil + "Function used to refresh the list of questions to be displayed. +Used by `sx-question-list-mode', this is a function, called with +no arguments, which returns a list questions to be displayed, +like the one returned by `sx-question-get-questions'. + +If this is not set, the value of `sx-question-list--dataset' is +used, and the list is simply redisplayed.") +(make-variable-buffer-local 'sx-question-list--refresh-function) + +(defvar sx-question-list--next-page-function nil + "Function used to fetch the next page of questions to be displayed. +Used by `sx-question-list-mode'. This is a function, called with +no arguments, which returns a list questions to be displayed, +like the one returned by `sx-question-get-questions'. + +This function will be called when the user presses \\\\[sx-question-list-next] at the end +of the question list. It should either return nil (indicating +\"no more questions\") or return a list of questions which will +appended to the currently displayed list. + +If this is not set, it's the same as a function which always +returns nil.") +(make-variable-buffer-local 'sx-question-list--next-page-function) + +(defvar sx-question-list--dataset nil + "The logical data behind the displayed list of questions. +This dataset contains even questions that are hidden by the user, +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) + +(defconst sx-question-list--key-definitions + '( + ;; S-down and S-up would collide with `windmove'. + ("" sx-question-list-next) + ("" sx-question-list-previous) + ("RET" sx-display "Display") + ("n" sx-question-list-next "Navigate") + ("p" sx-question-list-previous "Navigate") + ("j" sx-question-list-view-next "Navigate") + ("k" sx-question-list-view-previous "Navigate") + ("N" sx-question-list-next-far) + ("P" sx-question-list-previous-far) + ("J" sx-question-list-next-far) + ("K" sx-question-list-previous-far) + ("g" sx-question-list-refresh) + ("t" sx-tab-switch "tab") + ("a" sx-ask "ask") + ("S" sx-search "Search") + ("s" sx-switchto-map "switch-to") + ("v" sx-visit-externally "visit") + ("u" sx-upvote) + ("d" sx-downvote) + ("h" sx-question-list-hide "hide") + ("m" sx-question-list-mark-read "mark-read") + ("*" sx-favorite) + ) + "List of key definitions for `sx-question-list-mode'. +This list must follow the form described in +`sx--key-definitions-to-header-line'.") + +(defconst sx-question-list--header-line + (sx--key-definitions-to-header-line + sx-question-list--key-definitions) + "Header-line used on the question list.") + +(defvar sx-question-list--order-methods + '(("Recent Activity" . activity) + ("Creation Date" . creation) + ("Most Voted" . votes) + ("Score" . votes)) + "Alist of possible values to be passed to the `sort' keyword.") +(make-variable-buffer-local 'sx-question-list--order-methods) + +(defun sx-question-list--interactive-order-prompt (&optional prompt) + "Interactively prompt for a sorting order. +PROMPT is displayed to the user. If it is omitted, a default one +is used." + (let ((order (sx-completing-read + (or prompt "Order questions by: ") + (mapcar #'car sx-question-list--order-methods)))) + (cdr-safe (assoc-string order sx-question-list--order-methods)))) + +(defun sx-question-list--make-pager (method &optional submethod) + "Return a function suitable for use as a question list pager. +Meant to be used as `sx-question-list--next-page-function'." + (lambda (page) + (sx-method-call method + :keywords `((page . ,page) + ,@(when sx-question-list--order + `((order . ,(if sx-question-list--descending 'desc 'asc)) + (sort . ,sx-question-list--order)))) + :site sx-question-list--site + :auth t + :submethod submethod + :filter sx-browse-filter))) + + +;;; Mode Definition + +(defvar sx-question-list--current-tab "Latest" + ;; @TODO Other values (once we implement them) are "Top Voted", + ;; "Unanswered", etc. + "Variable describing current tab being viewed.") + +(defconst sx-question-list--mode-line-format + '(" " + (:propertize + (:eval (sx--pretty-site-parameter sx-question-list--site)) + face mode-line-buffer-id) + " " mode-name ": " + (:propertize sx-question-list--current-tab + face mode-line-buffer-id) + " [" + "Unread: " + (:propertize + (:eval (sx-question-list--unread-count)) + face mode-line-buffer-id) + ", " + "Total: " + (:propertize + (:eval (int-to-string (length tabulated-list-entries))) + face mode-line-buffer-id) + "] ") + "Mode-line construct to use in question-list buffers.") + +(define-derived-mode sx-question-list-mode + tabulated-list-mode "Question List" + "Major mode for browsing a list of questions from StackExchange. +Letters do not insert themselves; instead, they are commands. + +The recommended way of using this mode is to activate it and then +set `sx-question-list--next-page-function'. The return value of +this function is mapped with `sx-question-list--print-function', +so you may need to customize the latter if the former does not +return a list of questions. + +The full list of variables which can be set is: + 1. `sx-question-list--site' + Set this to the name of the site if that makes sense. If it + doesn't leave it as nil. + 2. `sx-question-list--print-function' + Change this if the data you're dealing with is not strictly a + list of questions (see the doc for details). + 3. `sx-question-list--refresh-function' + This is used to populate the initial list. It is only necessary + if item 4 does not fit your needs. + 4. `sx-question-list--next-page-function' + This is used to fetch further questions. If item 3 is nil, it is + also used to populate the initial list. + 5. `sx-question-list--dataset' + This is only used if both 3 and 4 are nil. It can be used to + display a static list. + 6. `sx-question-list--order' + Set this to the `sort' method that should be used when + requesting the list, if that makes sense. If it doesn't + leave it as nil. +\\ +If none of these is configured, the behaviour is that of a +\"Frontpage\", for the site given by +`sx-question-list--site'. + +Item 2 is mandatory, but it also has a sane default which is +usually enough. + +As long as one of 3, 4, or 5 is provided, the other two are +entirely optional. Populating or refreshing the list of questions +is done in the following way: + - Set `sx-question-list--pages-so-far' to 1. + - Call function 2. + - If function 2 is not given, call function 3 with argument 1. + - If 3 is not given use the value of 4. + +Adding further questions to the bottom of the list is done by: + - Increment `sx-question-list--pages-so-far'. + - Call function 3 with argument `sx-question-list--pages-so-far'. + - If it returns anything, append to the dataset and refresh the + display; otherwise, decrement `sx-question-list--pages-so-far'. + +If `sx-question-list--site' is given, items 3 and 4 should take it +into consideration. The same holds for `sx-question-list--order'. + +\\{sx-question-list-mode-map}" + (hl-line-mode 1) + (setq mode-line-format + sx-question-list--mode-line-format) + (setq sx-question-list--pages-so-far 0) + (setq tabulated-list-format + [(" V" 3 t :right-align t) + (" A" 3 t :right-align t) + ("Title" 0 sx-question-list--date-more-recent-p)]) + (setq tabulated-list-padding 1) + ;; Sorting by title actually sorts by date. It's what we want, but + ;; it's not terribly intuitive. + (setq tabulated-list-sort-key nil) + (add-hook 'tabulated-list-revert-hook + #'sx-question-list-refresh nil t) + ;; This is the default value, but we'll error out if the user has + ;; set it to nil. + (setq tabulated-list-use-header-line t) + (tabulated-list-init-header) + (setq header-line-format sx-question-list--header-line)) + +(defcustom sx-question-list-date-sort-method 'last_activity_date + "Parameter which controls date sorting." + ;; This should be made into a (choice ...) of constants. + :type 'symbol + ;; Add a setter to protect the value. + :group 'sx-question-list) + +(sx--create-comparator sx-question-list--date-more-recent-p + "Non-nil if tabulated-entry A is newer than B." + #'> (lambda (x) + (cdr (assq sx-question-list-date-sort-method (car x))))) + + +;;; Keybinds +;; We need this quote+eval combo because `kbd' was a macro in 24.2. +(mapc (lambda (x) (eval `(define-key sx-question-list-mode-map + (kbd ,(car x)) #',(cadr x)))) + sx-question-list--key-definitions) + +(sx--define-conditional-key sx-question-list-mode-map "O" #'sx-question-list-order-by + (and (boundp 'sx-question-list--order) sx-question-list--order)) + +(defun sx-question-list-hide (data) + "Hide question under point. +Non-interactively, DATA is a question alist." + (interactive + (list (if (derived-mode-p 'sx-question-list-mode) + (tabulated-list-get-id) + (sx-user-error "Not in `sx-question-list-mode'")))) + (sx-question--mark-hidden data) + ;; The current entry will not be present after the list is + ;; redisplayed. To avoid `tabulated-list-mode' getting lost (and + ;; sending us to the top) we move to the next entry before + ;; redisplaying. + (forward-line 1) + (when (called-interactively-p 'any) + (sx-question-list-refresh 'redisplay 'noupdate))) + +(defun sx-question-list-mark-read (data) + "Mark as read question under point. +Non-interactively, DATA is a question alist." + (interactive + (list (if (derived-mode-p 'sx-question-list-mode) + (tabulated-list-get-id) + (sx-user-error "Not in `sx-question-list-mode'")))) + (sx-question--mark-read data) + (sx-question-list-next 1) + (when (called-interactively-p 'any) + (sx-question-list-refresh 'redisplay 'noupdate))) + +(defun sx-question-list--unread-count () + "Number of unread questions in current dataset, as a string." + (int-to-string + (cl-count-if-not + #'sx-question--read-p sx-question-list--dataset))) + +(defun sx-question-list--remove-excluded-tags (question-list) + "Return QUESTION-LIST, with some questions removed. +Removes all questions hidden by the user, as well as those +containing a tag in `sx-question-list-excluded-tags'." + (cl-remove-if (lambda (q) + (or (sx-question--hidden-p q) + (cl-intersection (let-alist q .tags) + sx-question-list-excluded-tags + :test #'string=))) + question-list)) + +(defun sx-question-list-refresh (&optional redisplay no-update) + "Update the list of questions. +If REDISPLAY is non-nil (or if interactive), also call `tabulated-list-print'. +If the prefix argument NO-UPDATE is nil, query StackExchange for +a new list before redisplaying." + (interactive "p\nP") + ;; Reset the mode-line unread count (we rebuild it here). + (unless no-update + (setq sx-question-list--pages-so-far 1)) + (let* ((question-list + (or (and no-update sx-question-list--dataset) + (and (functionp sx-question-list--refresh-function) + (funcall sx-question-list--refresh-function)) + (and (functionp sx-question-list--next-page-function) + (funcall sx-question-list--next-page-function 1)) + sx-question-list--dataset)) + ;; Preserve window positioning. + (window (get-buffer-window (current-buffer))) + (old-start (when window (window-start window)))) + ;; The dataset contains everything. Hiding and filtering is done + ;; on the `tabulated-list-entries' below. + (setq sx-question-list--dataset question-list) + ;; Print the result. + (setq tabulated-list-entries + (mapcar sx-question-list--print-function + (sx-question-list--remove-excluded-tags + sx-question-list--dataset))) + (when redisplay + (tabulated-list-print 'remember)) + (when window + (set-window-start window old-start))) + (sx-message "Done.")) + +(defun sx-question-list-view-previous (n) + "Move cursor up N questions up and display this question. +Displayed in `sx-question-mode--window', replacing any question +that may currently be there." + (interactive "p") + (sx-question-list-view-next (- n))) + +(defun sx-question-list-view-next (n) + "Move cursor down N questions and display this question. +Displayed in `sx-question-mode--window', replacing any question +that may currently be there." + (interactive "p") + (sx-question-list-next n) + (sx-question-mode--display + (tabulated-list-get-id) + (sx-question-list--create-question-window))) + +(defun sx-question-list--create-question-window () + "Create or find a window where a question can be displayed. + +If any current window displays a question, that window is +returned. If none do, a new one is created such that the +question-list window remains `sx-question-list-height' lines +high (if possible)." + (or (sx-question-mode--get-window) + ;; Create a proper window. + (let ((window + (condition-case er + (split-window (selected-window) sx-question-list-height 'below) + (error + ;; If the window is too small to split, use any one. + (if (string-match + "Window # too small for splitting" + (car (cdr-safe er))) + (next-window) + (error (cdr er))))))) + ;; Configure the window to be closed on `q'. + (set-window-prev-buffers window nil) + (set-window-parameter + window 'quit-restore + ;; See (info "(elisp) Window Parameters") + `(window window ,(selected-window) ,sx-question-mode--buffer)) + window))) + +(defvar sx-question-list--last-refresh (current-time) + "Time of the latest refresh.") + +(defun sx-question-list-next (n) + "Move cursor down N questions. +This does not update `sx-question-mode--window'." + (interactive "p") + (if (and (< n 0) (bobp)) + (when (> (time-to-seconds + (time-subtract (current-time) sx-question-list--last-refresh)) + 1) + (sx-question-list-refresh 'redisplay) + (setq sx-question-list--last-refresh (current-time))) + (forward-line n) + ;; If we were trying to move forward, but we hit the end. + (when (eobp) + ;; Try to get more questions. + (sx-question-list-next-page)) + (sx-question-list--ensure-line-good-line-position))) + +(defun sx-question-list--ensure-line-good-line-position () + "Scroll window such that current line is a good place. +Check if we're at least 6 lines from the bottom. Scroll up if +we're not. Do the same for 3 lines from the top." + ;; At least one entry below us. + (let ((lines-to-bottom (count-screen-lines (point) (window-end)))) + (unless (>= lines-to-bottom 6) + (recenter (- 6)))) + ;; At least one entry above us. + (let ((lines-to-top (count-screen-lines (point) (window-start)))) + (unless (>= lines-to-top 3) + (recenter 3)))) + +(defun sx-question-list-next-page () + "Fetch and display the next page of questions." + (interactive) + ;; Stay at the last line. + (goto-char (point-max)) + (forward-line -1) + (when (functionp sx-question-list--next-page-function) + ;; Try to get more questions + (let ((list + (funcall sx-question-list--next-page-function + (1+ sx-question-list--pages-so-far)))) + (if (null list) + (message "No further questions.") + ;; If it worked, increment the variable. + (cl-incf sx-question-list--pages-so-far) + ;; And update the dataset. + ;; @TODO: Check for duplicates. + (setq sx-question-list--dataset + (append sx-question-list--dataset list)) + (sx-question-list-refresh 'redisplay 'no-update) + (forward-line 1))))) + +(defun sx-question-list-previous (n) + "Move cursor up N questions. +This does not update `sx-question-mode--window'." + (interactive "p") + (sx-question-list-next (- n))) + +(defcustom sx-question-list-far-step-size 5 + "How many questions `sx-question-list-next-far' skips." + :type 'integer + :group 'sx-question-list + :package-version '(sx-question-list . "")) + +(defun sx-question-list-next-far (n) + "Move cursor up N*`sx-question-list-far-step-size' questions. +This does not update `sx-question-mode--window'." + (interactive "p") + (sx-question-list-next (* n sx-question-list-far-step-size))) + +(defun sx-question-list-previous-far (n) + "Move cursor up N questions. +This does not update `sx-question-mode--window'." + (interactive "p") + (sx-question-list-next-far (- n))) + +(defun sx-question-list-switch-site (site) + "Switch the current site to SITE and display its questions. +Retrieve completions from `sx-site-get-api-tokens'. +Sets `sx-question-list--site' and then call +`sx-question-list-refresh' with `redisplay'." + (interactive + (list (sx-completing-read + "Switch to site: " (sx-site-get-api-tokens) + (lambda (site) (not (equal site sx-question-list--site))) + t))) + (when (and (stringp site) (> (length site) 0)) + (setq sx-question-list--site site) + (sx-question-list-refresh 'redisplay))) + +(defun sx-question-list-order-by (sort &optional ascend) + "Order questions in the current list by the method SORT. +Sets `sx-question-list--order' and then calls +`sx-question-list-refresh' with `redisplay'. + +With a prefix argument or a non-nil ASCEND, invert the sorting +order." + (interactive + (list (when sx-question-list--order + (sx-question-list--interactive-order-prompt)) + current-prefix-arg)) + (unless sx-question-list--order + (sx-user-error "This list can't be reordered")) + (when (and sort (symbolp sort)) + (setq sx-question-list--order sort) + (setq sx-question-list--descending (not ascend)) + (sx-question-list-refresh 'redisplay))) + +(provide 'sx-question-list) +;;; sx-question-list.el ends here + +;; Local Variables: +;; indent-tabs-mode: nil +;; End: diff --git a/elpa/sx-20160125.1601/sx-question-mode.el b/elpa/sx-20160125.1601/sx-question-mode.el new file mode 100644 index 0000000..4263f6e --- /dev/null +++ b/elpa/sx-20160125.1601/sx-question-mode.el @@ -0,0 +1,309 @@ +;;; sx-question-mode.el --- major-mode for displaying questions -*- lexical-binding: t; -*- + +;; Copyright (C) 2014 Artur Malabarba + +;; Author: Artur Malabarba + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + +;; This file provides a means to print questions with their answers +;; and all comments. See the customizable group `sx-question-mode'. + + +;;; Code: +(eval-when-compile + (require 'rx)) + +(require 'sx) +(require 'sx-switchto) +(require 'sx-question) +(require 'sx-question-print) + + +;;; Displaying a question +(defcustom sx-question-mode-display-buffer-function #'pop-to-buffer + "Function used to display the question buffer. +Called, for instance, when hitting \\`\\[sx-question-list-display-question]' on an entry in the +question list. +This is not used when navigating the question list with `\\[sx-question-list-view-next]. + +Common values for this variable are `pop-to-buffer' and `switch-to-buffer'." + :type 'function + :group 'sx-question-mode) + +(defvar sx-question-mode--buffer nil + "Buffer being used to display questions.") + +(defvar sx-question-mode--data nil + "The data of the question being displayed.") +(make-variable-buffer-local 'sx-question-mode--data) + +(defun sx-question-mode--get-window () + "Return a window displaying a question, or nil." + (car-safe + (cl-member-if + (lambda (x) (with-selected-window x + (derived-mode-p 'sx-question-mode))) + (window-list nil 'never nil)))) + +(defun sx-question-mode--display (data &optional window) + "Display question given by DATA on WINDOW. +If WINDOW is nil, use selected one. + +Returns the question buffer." + (with-current-buffer + (sx-question-mode--display-buffer window) + (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. +Also marks the question as read with `sx-question--mark-read'." + (sx--ensure-site data) + (sx-question--mark-read data) + (let ((inhibit-read-only t)) + (erase-buffer) + (sx-question-mode) + (sx-question-mode--print-question data) + (current-buffer))) + +(defun sx-question-mode--display-buffer (window) + "Display and return the buffer used for displaying a question. +Create `sx-question-mode--buffer' if necessary. +If WINDOW is given, use that to display the buffer." + ;; Create the buffer if necessary. + (unless (buffer-live-p sx-question-mode--buffer) + (setq sx-question-mode--buffer + (generate-new-buffer "*sx-question*"))) + (cond + ;; Window was given, use it. + ((window-live-p window) + (set-window-buffer window sx-question-mode--buffer)) + ;; No window, but the buffer is already being displayed somewhere. + ((get-buffer-window sx-question-mode--buffer 'visible)) + ;; Neither, so we create the window. + (t (funcall sx-question-mode-display-buffer-function + sx-question-mode--buffer))) + sx-question-mode--buffer) + + +;;; Movement commands +;; Sections are headers placed above a question's content or an +;; answer's content, or above the list of comments. They are +;; identified with the `sx-question-mode--section' text property. +;; To move between sections, just search for the property. The value +;; of the text-property is the depth of the section (1 for contents, 2 +;; for comments). +(defcustom sx-question-mode-recenter-line 0 + "Screen line to which we recenter after moving between sections. +This is used as an argument to `recenter', only used if the end +of section is outside the window. + +If nil, no recentering is performed." + :type '(choice (const :tag "Don't recenter" nil) + integer) + :group 'sx-question-mode) + +(defun sx-question-mode-next-section (&optional n) + "Move down to next section (question or answer) of this buffer. +Prefix argument N moves N sections down or up." + (interactive "p") + (let ((count (if n (abs n) 1))) + (while (> count 0) + ;; This will either move us to the next section, or move out of + ;; the current one. + (unless (sx--goto-property-change 'sx-question-mode--section n) + ;; If all we did was move out the current one, then move again + ;; and we're guaranteed to reach the next section. + (sx--goto-property-change 'sx-question-mode--section n)) + (unless (get-char-property (point) 'invisible) + (cl-decf count)))) + (when (equal (selected-window) (get-buffer-window)) + (when sx-question-mode-recenter-line + (let ((ov (sx-question-mode--section-overlays-at (line-end-position)))) + (when (and (overlayp ov) (> (overlay-end ov) (window-end))) + (recenter sx-question-mode-recenter-line)))) + (sx-message-help-echo))) + +(defun sx-question-mode-previous-section (&optional n) + "Move down to previous section (question or answer) of this buffer. +Prefix argument moves N sections up or down." + (interactive "p") + (sx-question-mode-next-section (- (or n 1)))) + +(defun sx-question-mode-hide-show-section (&optional _) + "Hide or show section under point. +Optional argument _ is for `push-button'." + (interactive) + (let ((ov (or (sx-question-mode--section-overlays-at + (line-end-position)) + (sx-question-mode--section-overlays-at (point))))) + (unless (overlayp ov) + (sx-user-error "Not inside a question or answer")) + (goto-char (overlay-start ov)) + (forward-line 0) + (overlay-put + ov 'invisible + (null (overlay-get ov 'invisible))))) + +(defun sx-question-mode--section-overlays-at (pos) + "Return the highest priority section overlay at POS. +A section overlay has a `sx-question-mode--section-content' +property." + (cdr-safe (get-char-property-and-overlay + pos 'sx-question-mode--section-content nil))) + + +;;; Major-mode constants +(defconst sx-question-mode--key-definitions + '( + ("" sx-question-mode-next-section) + ("" sx-question-mode-previous-section) + ("n" sx-question-mode-next-section "Navigate") + ("p" sx-question-mode-previous-section "Navigate") + ("g" sx-question-mode-refresh) + ("v" sx-visit-externally) + ("u" sx-upvote "upvote") + ("d" sx-downvote "downvote") + ("q" quit-window) + ("SPC" scroll-up-command) + ("e" sx-edit "edit") + ("S" sx-search) + ("*" sx-favorite "star") + ("K" sx-delete "Delete") + ("s" sx-switchto-map "switch-to") + ("O" sx-question-mode-order-by "Order") + ("c" sx-comment "comment") + ("a" sx-answer "answer") + ("TAB" forward-button "Navigate") + ("" backward-button) + ("" backward-button) + ("" backward-button)) + "List of key definitions for `sx-question-mode'. +This list must follow the form described in +`sx--key-definitions-to-header-line'.") + +(defconst sx-question-mode--header-line + (sx--key-definitions-to-header-line + sx-question-mode--key-definitions) + "Header-line used on the question list.") + + +;;; Major-mode definition +(defconst sx-question-mode--mode-line + '(" " + ;; `sx-question-mode--data' is guaranteed to have through + ;; `sx--ensure-site' already, so we use `let-alist' instead of + ;; `sx-assoc-let' to improve performance (since the mode-line is + ;; updated a lot). + (:propertize + (:eval (sx--pretty-site-parameter + (let-alist sx-question-mode--data .site_par))) + face mode-line-buffer-id) + " " mode-name + " [" + "Answers: " + (:propertize + (:eval (number-to-string (let-alist sx-question-mode--data .answer_count))) + face mode-line-buffer-id) + ", " + "Stars: " + (:propertize + (:eval (number-to-string (or (let-alist sx-question-mode--data .favorite_count) 0))) + face mode-line-buffer-id) + ", " + "Views: " + (:propertize + (:eval (number-to-string (let-alist sx-question-mode--data .view_count))) + face mode-line-buffer-id) + "] ") + "Mode-line construct to use in `sx-question-mode' buffers.") + +(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. + +Don't activate this mode directly. Instead, to print a question +on the current buffer use +`sx-question-mode--erase-and-print-question'. + +\\ +\\{sx-question-mode}" + (setq header-line-format sx-question-mode--header-line) + (setq mode-line-format sx-question-mode--mode-line) + (buffer-disable-undo (current-buffer)) + (set (make-local-variable 'nobreak-char-display) nil) + ;; Determine how to close this window. + (unless (window-parameter nil 'quit-restore) + (set-window-parameter + nil 'quit-restore + `(other window nil ,(current-buffer)))) + ;; We call font-lock-region manually. See `sx-question-mode--insert-markdown'. + (font-lock-mode -1) + (remove-hook 'after-change-functions 'markdown-check-change-for-wiki-link t) + (remove-hook 'window-configuration-change-hook + 'markdown-fontify-buffer-wiki-links t)) + +;; We need this quote+eval combo because `kbd' was a macro in 24.2. +(mapc (lambda (x) (eval `(define-key sx-question-mode-map + (kbd ,(car x)) #',(cadr x)))) + sx-question-mode--key-definitions) + +(defun sx-question-mode-refresh (&optional no-update) + "Refresh currently displayed question. +Queries the API for any changes to the question or its answers or +comments, and redisplays it. + +With non-nil prefix argument NO-UPDATE, just redisplay, don't +query the api." + (interactive "P") + (sx-question-mode--ensure-mode) + (let ((point (point)) + (line (count-screen-lines + (window-start) (point)))) + (sx-question-mode--erase-and-print-question + (if no-update + sx-question-mode--data + (sx-assoc-let sx-question-mode--data + (sx-question-get-question .site_par .question_id)))) + (goto-char point) + (when (equal (selected-window) + (get-buffer-window (current-buffer))) + (recenter line))) + (sx-message "Done.")) + +(defun sx-question-mode--ensure-mode () + "Ensures we are in question mode, erroring otherwise." + (unless (derived-mode-p 'sx-question-mode) + (error "Not in `sx-question-mode'"))) + +(defun sx-question-mode-order-by (sort) + "Order answers in the current buffer by the method SORT. +Sets `sx-question-list--order' and then calls +`sx-question-list-refresh' with `redisplay'." + (interactive + (list (let ((order (sx-completing-read "Order answers by: " + (mapcar #'car sx-question-mode--sort-methods)))) + (cdr-safe (assoc-string order sx-question-mode--sort-methods))))) + (when (and sort (functionp sort)) + (setq sx-question-mode-answer-sort-function sort) + (sx-question-mode-refresh 'no-update))) + +(provide 'sx-question-mode) +;;; sx-question-mode.el ends here + +;; Local Variables: +;; indent-tabs-mode: nil +;; End: diff --git a/elpa/sx-20160125.1601/sx-question-print.el b/elpa/sx-20160125.1601/sx-question-print.el new file mode 100644 index 0000000..6599532 --- /dev/null +++ b/elpa/sx-20160125.1601/sx-question-print.el @@ -0,0 +1,816 @@ +;;; sx-question-print.el --- populating the question-mode buffer with content -*- lexical-binding: t; -*- + +;; Copyright (C) 2014 Artur Malabarba + +;; Author: Artur Malabarba + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + + +;;; Code: +(require 'markdown-mode) +(require 'sx-button) +(require 'sx) +(require 'sx-question) +(require 'sx-babel) +(require 'sx-user) + +(defvar sx-question-mode--data) + +(defgroup sx-question-mode nil + "Customization group for sx-question-mode." + :prefix "sx-question-mode-" + :tag "SX Question Mode" + :group 'sx) + +(defgroup sx-question-mode-faces '((sx-user custom-group)) + "Customization group for the faces of `sx-question-mode'. +Some faces of this mode might be defined in the `sx-user' group." + :prefix "sx-question-mode-" + :tag "SX Question Mode Faces" + :group 'sx-question-mode) + + +;;; Faces and Variables +(defface sx-question-mode-header + '((t :inherit font-lock-variable-name-face)) + "Face used on the question headers in the question buffer." + :group 'sx-question-mode-faces) + +(defface sx-question-mode-title + '((t :weight bold :inherit default)) + "Face used on the question title in the question buffer." + :group 'sx-question-mode-faces) + +(defface sx-question-mode-title-comments + '((t :inherit sx-question-mode-title)) + "Face used on the question title in the question buffer." + :group 'sx-question-mode-faces) + +(defcustom sx-question-mode-header-title "\n" + "String used before the question title at the header." + :type 'string + :group 'sx-question-mode) + +(defcustom sx-question-mode-header-author-format "\nAuthor: %d %r" + "String used to display the question author at the header. +% constructs have special meaning here. See `sx-user--format'." + :type 'string + :group 'sx-question-mode) + +(defface sx-question-mode-date + '((t :inherit font-lock-string-face)) + "Face used on the question date in the question buffer." + :group 'sx-question-mode-faces) + +(defcustom sx-question-mode-header-date "\nPosted on: " + "String used before the question date at the header." + :type 'string + :group 'sx-question-mode) + +(defface sx-question-mode-score + '((t)) + "Face used for the score in the question buffer." + :group 'sx-question-mode-faces) + +(defface sx-question-mode-score-downvoted + '((t :inherit (font-lock-warning-face sx-question-mode-score))) + "Face used for downvoted score in the question buffer." + :group 'sx-question-mode-faces) + +(defface sx-question-mode-score-upvoted + '((t :weight bold + :inherit (font-lock-function-name-face sx-question-mode-score))) + "Face used for downvoted score in the question buffer." + :group 'sx-question-mode-faces) + +(defcustom sx-question-mode-header-tags "\nTags: " + "String used before the question tags at the header." + :type 'string + :group 'sx-question-mode) + +(defcustom sx-question-mode-header-score "\nScore: " + "String used before the question score at the header." + :type 'string + :group 'sx-question-mode) + +(defface sx-question-mode-content-face + '((((background dark)) :background "#090909") + (((background light)) :background "#f4f4f4")) + "Face used on the question body in the question buffer. +This shouldn't have a foreground, or this will interfere with +font-locking." + :group 'sx-question-mode-faces) + +(defcustom sx-question-mode-last-edit-format " (edited %s ago by %s)" + "Format used to describe last edit date in the header. +First \"%s\" is replaced with the date and the second \"%s\" with +the editor's name." + :type 'string + :group 'sx-question-mode) + +(defcustom sx-question-mode-separator + (concat (propertize (make-string 72 ?\s) + 'face '(underline sx-question-mode-header)) + "\n") + "Separator used between header and body." + :type 'string + :group 'sx-question-mode) + +(defcustom sx-question-mode-answer-title "Answer" + "Title used at the start of \"Answer\" sections." + :type 'string + :group 'sx-question-mode) + +(defface sx-question-mode-accepted + '((((background dark)) :foreground "LimeGreen" + :height 1.3 :inherit sx-question-mode-title) + (((background light)) :foreground "ForestGreen" + :height 1.3 :inherit sx-question-mode-title)) + "Face used for accepted answers in the question buffer." + :group 'sx-question-mode-faces) + +(defface sx-question-mode-closed + '((t :box 2 :inherit font-lock-warning-face)) + "Face used for closed question header in the question buffer." + :group 'sx-question-mode-faces) + +(defface sx-question-mode-closed-reason + `((t :box (:line-width 2 :color ,(face-attribute 'sx-question-mode-closed + :foreground nil t)) + :inherit sx-question-mode-title)) + "Face used for closed question header in the question buffer. +Aesthetically, it's important that the color of this face's :box +attribute match the color of the face `sx-question-mode-closed'." + :group 'sx-question-mode-faces) + +(defcustom sx-question-mode-answer-accepted-title "Accepted Answer" + "Title used at the start of accepted \"Answer\" section." + :type 'string + :group 'sx-question-mode) + +(defcustom sx-question-mode-comments-title " Comments" + "Title used at the start of \"Comments\" sections." + :type 'string + :group 'sx-question-mode) + +(defcustom sx-question-mode-comments-format "%s: %s\n" + "Format used to display comments. +First \"%s\" is replaced with user name. Second \"%s\" is +replaced with the comment." + :type 'string + :group 'sx-question-mode) + +(defcustom sx-question-mode-pretty-links t + "If non-nil, markdown links are displayed in a compact form." + :type 'boolean + :group 'sx-question-mode) + +(defconst sx-question-mode--sort-methods + (let ((methods + '(("Higher-scoring" . sx-answer-higher-score-p) + ("Newer" . sx-answer-newer-p) + ("More active" . sx-answer-more-active-p)))) + (append (mapcar (lambda (x) (cons (concat (car x) " first") (cdr x))) + methods) + (mapcar (lambda (x) (cons (concat (car x) " last") + (sx--invert-predicate (cdr x)))) + methods)))) + +(defcustom sx-question-mode-answer-sort-function + #'sx-answer-higher-score-p + "Function used to sort answers in the question buffer." + :type + (cons 'choice + (mapcar (lambda (x) `(const :tag ,(car x) ,(cdr x))) + sx-question-mode--sort-methods)) + :group 'sx-question-mode) + +(defcustom sx-question-mode-use-images (image-type-available-p 'imagemagick) + "Non-nil if SX should download and display images. +By default, this is `t' if the `imagemagick' image type is +available (checked with `image-type-available-p'). If this image +type is not available, images won't work." + :type 'boolean + :group 'sx-question-mode) + +(defcustom sx-question-mode-image-max-width 550 + "Maximum width, in pixels, of images in the question buffer." + :type 'integer + :group 'sx-question-mode) + + +;;; Functions +;;;; Printing the general structure +(defconst sx-question-mode--closed-mode-line-string + '(:propertize " [CLOSED] " face font-lock-warning-face) + "String indicating closed questions in the mode-line.") + +(defun sx-question-mode--print-question (question) + "Print a buffer describing QUESTION. +QUESTION must be a data structure returned by `json-read'." + (when (sx--deleted-p question) + (sx-user-error "This is a deleted question")) + (setq sx-question-mode--data question) + ;; Clear the overlays + (mapc #'delete-overlay sx--overlays) + (setq sx--overlays nil) + ;; Print everything + (sx-assoc-let question + (when .closed_reason + (add-to-list 'mode-line-format sx-question-mode--closed-mode-line-string) + (sx-question-mode--print-close-reason .closed_reason .closed_date .closed_details)) + (sx-question-mode--print-section question) + (mapc #'sx-question-mode--print-section + (cl-remove-if + #'sx--deleted-p + (cl-sort .answers sx-question-mode-answer-sort-function)))) + (insert "\n\n ") + (insert-text-button "Write an Answer" :type 'sx-button-answer) + ;; Go up + (goto-char (point-min)) + (sx-question-mode-next-section)) + +(defun sx-question-mode--print-close-reason (reason date &optional details) + "Print a header explaining REASON and DATE. +DATE is an integer. + +DETAILS, when given is an alist further describing the close." + (let ((l (point))) + (let-alist details + (insert "\n " + (propertize (format " %s as %s, %s ago. " + (if .on_hold "Put on hold" "Closed") + reason + (sx-time-since date)) + 'face 'sx-question-mode-closed) + "\n") + (when .description + (insert (replace-regexp-in-string "<[^>]+>" "" .description) + "\n"))) + (save-excursion + (goto-char l) + (search-forward " as " nil 'noerror) + (setq l (point)) + (skip-chars-forward "^,") + (let ((ov (make-overlay l (point)))) + (overlay-put ov 'face 'sx-question-mode-closed-reason) + (push ov sx--overlays))))) + +(defun sx-question-mode--maybe-print-accept-button () + "Print accept button if you own this question." + (when (sx-assoc-let sx-question-mode--data + (ignore-errors + (= .owner.user_id + (cdr (assq 'user_id (sx-network-user .site_par)))))) + (insert " ") + (insert-text-button "Accept" :type 'sx-button-accept))) + +(defun sx-question-mode--print-section (data) + "Print a section corresponding to DATA. +DATA can represent a question or an answer." + ;; This makes `data' accessible through `sx--data-here'. + (sx--wrap-in-overlay + (list 'sx--data-here data) + (sx-assoc-let data + (insert sx-question-mode-header-title) + (insert-text-button + ;; Questions have title, Answers don't + (cond (.title) + (.is_accepted sx-question-mode-answer-accepted-title) + (t sx-question-mode-answer-title)) + ;; Section level + 'sx-question-mode--section (if .title 1 2) + 'sx-button-copy .share_link + 'face (if .is_accepted 'sx-question-mode-accepted + 'sx-question-mode-title) + :type 'sx-question-mode-title) + (when (not (or .title .is_accepted)) + (sx-question-mode--maybe-print-accept-button)) + + ;; Sections can be hidden with overlays + (sx--wrap-in-overlay + '(sx-question-mode--section-content t) + + ;; Author + (insert + (sx-user--format + (propertize sx-question-mode-header-author-format + 'face 'sx-question-mode-header) + .owner)) + + ;; Date + (sx-question-mode--insert-header + sx-question-mode-header-date + (concat + (sx-time-seconds-to-date .creation_date) + (when .last_edit_date + (format sx-question-mode-last-edit-format + (sx-time-since .last_edit_date) + (sx-user--format "%d" .last_editor)))) + 'sx-question-mode-date) + + ;; Score and upvoted/downvoted status. + (sx-question-mode--insert-header + sx-question-mode-header-score + (format "%s%s" .score + (cond (.upvoted "↑") (.downvoted "↓") (t ""))) + (cond (.upvoted 'sx-question-mode-score-upvoted) + (.downvoted 'sx-question-mode-score-downvoted) + (t 'sx-question-mode-score))) + + ;; Tags + (when .title + ;; Tags + (sx-question-mode--insert-header + sx-question-mode-header-tags + (sx-tag--format-tags .tags .site_par) + nil)) + ;; Body + (insert "\n" sx-question-mode-separator) + (sx--wrap-in-overlay + '(face sx-question-mode-content-face) + (insert "\n") + (sx-question-mode--insert-markdown .body_markdown) + (insert "\n" sx-question-mode-separator)) + ;; Clean up commments manually deleted. The `append' call is + ;; to ensure `comments' is a list and not a vector. + (let ((comments (cl-remove-if #'sx--deleted-p .comments))) + (when comments + (insert "\n") + (insert-text-button + sx-question-mode-comments-title + 'face 'sx-question-mode-title-comments + 'sx-question-mode--section 3 + 'sx-button-copy .share_link + :type 'sx-question-mode-title) + (sx--wrap-in-overlay + '(sx-question-mode--section-content t) + (insert "\n") + (sx--wrap-in-overlay + '(face sx-question-mode-content-face) + ;; Comments have their own `sx--data-here' property (so they can + ;; be upvoted too). + (mapc #'sx-question-mode--print-comment comments)) + ;; If there are comments, we want part of this margin to go + ;; inside them, so the button get's placed beside the + ;; "Comments" header when you hide them. + (insert " "))) + ;; If there are no comments, we have to add this margin here. + (unless comments + (insert " "))) + (insert " ") + ;; This is where the "add a comment" button is printed. + (insert-text-button "Add a Comment" + :type 'sx-button-comment) + (insert "\n"))))) + +(defun sx-question-mode--print-comment (comment-data) + "Print the comment described by alist COMMENT-DATA. +The comment is indented, filled, and then printed according to +`sx-question-mode-comments-format'." + (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 .upvoted "^" "") + " ")) + (insert + (format sx-question-mode-comments-format + (sx-user--format "%d" .owner) + (substring + ;; We use temp buffer, so that image overlays don't get + ;; inserted with the comment. + (with-temp-buffer + ;; We fill with three spaces at the start, so the comment is + ;; slightly indented. + (sx-question-mode--insert-markdown (concat " " (sx--squash-whitespace .body_markdown))) + (buffer-string)) + ;; 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. +ARGS is a list of repeating values -- `header', `value', and +`face'. `header' is given `sx-question-mode-header' as a face, +where `value' is given `face' as its face. + +\(fn HEADER VALUE FACE [HEADER VALUE FACE] [HEADER VALUE FACE] ...)" + (while args + (insert + (propertize (pop args) 'face 'sx-question-mode-header) + (let ((header (pop args)) + (face (pop args))) + (if face (propertize header 'face face) + header))))) + + +;;;; Printing and Font-locking the content (body) +(defvar sx-question-mode-bullet-appearance + (propertize (if (char-displayable-p ?•) "•" "*") + 'face 'markdown-list-face) + "String to be displayed as the bullet of markdown list items.") + +(defconst sx-question-mode--reference-regexp + (rx line-start (0+ blank) "[%s]:" (0+ blank) + (group-n 1 (1+ (not (any blank "\n\r"))))) + "Regexp used to find the url of labeled links. +E.g.: + [1]: https://...") + +(defconst sx-question-mode--link-regexp + ;; Done at compile time. + (rx (or (and "[" (optional (group-n 6 "meta-")) "tag:" + (group-n 5 (+ (not (any " ]")))) "]") + (and (opt "!") "[" (group-n 1 (1+ (not (any "[]")))) "]" + (or (and "(" (group-n 2 (1+ (not (any ")")))) ")") + (and "[" (group-n 3 (1+ (not (any "]")))) "]"))) + (group-n 4 (and "http" (opt "s") "://" + (>= 2 (any lower numeric "_%")) + "." + (>= 2 (any lower numeric "_%")) + (* (any lower numeric "-/._%&#?=;")))))) + "Regexp matching markdown links.") + +(defun sx-question-mode--process-line-breaks (beg end-marker) + "Process Markdown line breaks between BEG and END-MARKER. +Double space at the end of a line becomes an invisible \"\\n\". +Consecutive blank lines beyond the first are consensed. +Assumes `marker-insertion-type' of END-MARKER is t." + (goto-char beg) + (while (search-forward-regexp + (rx line-start (* blank) "\n" + (group-n 1 (+ (any blank "\n")))) + end-marker 'noerror) + ;; An invisible newline ensures the previous text + ;; will get filled as a separate paragraph. + (replace-match "" nil nil nil 1)) + (goto-char beg) + (while (search-forward-regexp " $" end-marker 'noerror) + ;; An invisible newline ensures the previous text + ;; will get filled as a separate paragraph. + (replace-match (propertize "\n" 'invisible t)))) + +(defun sx-question-mode--process-markdown-in-region (beg end) + "Process Markdown text between BEG and END. +This does not do Markdown font-locking. Instead, it fills text, +propertizes links, inserts images, cleans up html comments, and +font-locks code-blocks according to mode." + ;; Paragraph filling + (let ((paragraph-start + "\f\\|[ \t]*$\\|[ \t]*[*+-] \\|[ \t]*[0-9]+\\.[ \t]\\|[ \t]*: ") + (paragraph-separate "\\(?:[ \t\f]*\\|.* \\)$") + (adaptive-fill-first-line-regexp "\\`[ \t]*>[ \t]*?\\'") + (adaptive-fill-function #'markdown-adaptive-fill-function)) + (save-restriction + (narrow-to-region beg end) + ;; html tags can span many paragraphs, so we handle them + ;; globally first. + (sx-question-mode--process-html-tags (point-min) (copy-marker (point-max))) + ;; And now the filling and other handlings. + (goto-char (point-min)) + (while (null (eobp)) + ;; Don't fill pre blocks. + (unless (sx-question-mode--dont-fill-here) + (let ((beg (point))) + (skip-chars-forward "\r\n[:blank:]") + (forward-paragraph) + (let ((end (point-marker))) + (set-marker-insertion-type end t) + ;; Turn markdown linebreaks into their final form + (sx-question-mode--process-line-breaks beg end) + ;; Compactify links by paragraph, so we don't linkify + ;; inside code-blocks. This will still linkify inside + ;; code tags, unfortunately. + (sx-question-mode--process-links beg end) + ;; Filling is done after all of the above, since those + ;; steps change the length of text. + (fill-region beg end) + (goto-char end))))) + (goto-char (point-max))))) + +(defconst sx-question-mode-hr + (propertize (make-string 72 ?―) + 'face 'markdown-header-rule-face)) + +(defun sx-question-mode--insert-markdown (text) + "Return TEXT fontified according to `markdown-mode'." + (let ((beg (point))) + (insert + ;; Font-locking needs to be done in a temp buffer, because it + ;; affects the entire buffer even if we narrow. + (with-temp-buffer + (insert text) + ;; Trim whitespace + (goto-char (point-max)) + (skip-chars-backward "\r\n[:blank:]") + (delete-region (point) (point-max)) + (goto-char (point-min)) + (skip-chars-forward "\r\n[:blank:]") + (forward-line 0) + (delete-region (point-min) (point)) + ;; Font lock + (delay-mode-hooks (markdown-mode)) + (font-lock-mode -1) + (when sx-question-mode-bullet-appearance + (font-lock-add-keywords ;; Bullet items. + nil + `((,(rx line-start (0+ blank) (group-n 1 (any "*+-")) blank) + 1 '(face nil display ,sx-question-mode-bullet-appearance) prepend)))) + (font-lock-add-keywords ;; Highlight usernames. + nil + `((,(rx (or blank line-start) + (group-n 1 (and "@" (1+ (not space)))) + symbol-end) + 1 font-lock-builtin-face) + ("^---+$" 0 '(face nil display ,sx-question-mode-hr)))) + ;; Everything. + (font-lock-fontify-region (point-min) (point-max)) + (replace-regexp-in-string "[[:blank:]]+\\'" "" (buffer-string)))) + ;; This part can and should be done in place, this way it can + ;; create overlays. + (sx-question-mode--process-markdown-in-region beg (point)))) + + +;;; HTML tags +(defconst sx-question-mode--html-tag-regexp + (rx "<" (group-n 1 "%s") (* (not (any ">"))) ">")) + +(defface sx-question-mode-sub-sup-tag + '((t :height 0.7)) + "Face used on and tags." + :group 'sx-question-mode-faces) + +(defface sx-question-mode-kbd-tag + '((((background dark)) + :height 0.9 + :weight semi-bold + :box (:line-width 3 :style released-button :color "gray30")) + (((background light)) + :height 0.9 + :weight semi-bold + :box (:line-width 3 :style released-button :color "gray70"))) + "Face used on tags." + :group 'sx-question-mode-faces) + +(defun sx-question-mode--inside-code-p () + "Return non-nil if point is inside code. +This can be inline Markdown code or a Markdown code-block." + (save-match-data + (or (markdown-code-at-point-p) + (save-excursion + (sx-question-mode--skip-and-fontify-pre 'dont-fontify))))) + +(defun sx-question-mode--standalone-tag-p (string) + "Return non-nil if STRING ends in \"/>\"." + (string-match "/[[:blank:]]*>\\'" string)) + +(defun sx-question-mode--next-tag (tag &optional closing end) + "Move point to the next occurrence of html TAG, or return nil. +Don't move past END. +If CLOSING is non-nil, find a closing tag." + (search-forward-regexp + (format sx-question-mode--html-tag-regexp + (if closing + (concat "/[[:blank:]]*" tag) + tag)) + end 'noerror)) + +(defun sx-question-mode--process-html-tags (beg end-marker) + "Hide all html tags between BEG and END and possibly interpret them. +END-MARKER should be a marker." + ;; This code understands nested html, but not if the same tag is + ;; nested in itself (e.g., ). + (set-marker-insertion-type end-marker t) + (goto-char beg) + (while (sx-question-mode--next-tag "[[:alpha:]]+" nil end-marker) + (unless (sx-question-mode--inside-code-p) + (let ((tag (match-string 1)) + (full (match-string 0)) + (l (match-beginning 0))) + (replace-match "") + (pcase tag + (`"hr" + (unless (looking-at-p "^") (insert "\n")) + (insert (propertize "---" 'display sx-question-mode-hr)) + (unless (eq (char-after) ?\n) (insert "\n"))) + (`"br" (insert "\n "))) + (when (and (not (sx-question-mode--standalone-tag-p full)) + (sx-question-mode--next-tag tag 'closing)) + (let ((r (copy-marker (match-beginning 0)))) + ;; The code tag is special, because it quotes everything inside. + (if (string= tag "code") + (progn (replace-match "`") + (save-excursion (goto-char l) (insert "`"))) + (replace-match "") + ;; Handle stuff between the two tags. + (save-match-data (sx-question-mode--process-html-tags l r)) + (pcase tag + (`"kbd" + (add-text-properties l r '(face sx-question-mode-kbd-tag)) + (when (looking-at-p + (format sx-question-mode--html-tag-regexp "kbd")) + (insert " "))) + (`"sub" + (add-text-properties + l r '(face sx-question-mode-sub-sup-tag display (raise -0.3)))) + (`"sup" + (add-text-properties + l r '(face sx-question-mode-sub-sup-tag display (raise +0.3)))))))))))) + + +;;; Handling links +(defun sx-question-mode--process-links (beg end-marker) + "Turn all markdown links between BEG and ENG into compact format. +Image links are downloaded and displayed, if +`sx-question-mode-use-images' is non-nil. +Assumes `marker-insertion-type' of END-MARKER is t." + (goto-char beg) + (while (search-forward-regexp sx-question-mode--link-regexp end-marker t) + ;; Tags are tag-buttons. + (let ((tag (match-string-no-properties 5))) + (if (and tag (> (length tag) 0)) + (progn (replace-match "") + (sx-tag--insert tag)) + ;; Other links are link-buttons. + (let* ((text (match-string-no-properties 1)) + (url (or (match-string-no-properties 2) + (match-string-no-properties 4) + (sx-question-mode-find-reference + (match-string-no-properties 3) + text))) + (full-text (match-string-no-properties 0)) + (image-p (and sx-question-mode-use-images + (eq ?! (elt full-text 0))))) + (when (stringp url) + (replace-match "") + (sx-question-mode--insert-link + (cond (image-p (sx-question-mode--create-image url)) + ((and sx-question-mode-pretty-links text)) + ((not text) (sx--shorten-url url)) + (t full-text)) + url))))))) + +(defun sx-question-mode--create-image (url) + "Get and create an image from URL and insert it at POINT. +The image will take the place of the character at POINT. +Its size is bound by `sx-question-mode-image-max-width' and +`window-body-width'." + (let* ((ov (make-overlay (point) (point) (current-buffer) t nil)) + (callback + (lambda (data) + (let* ((image (create-image data 'imagemagick t)) + (image-width (car (image-size image 'pixels)))) + (overlay-put + ov 'display + (append image + (list :width (min sx-question-mode-image-max-width + (window-body-width nil 'pixel) + image-width)))))))) + (sx-request-get-url url callback) + (overlay-put ov 'face 'default) + ov)) + +(defun sx-question-mode--insert-link (text url) + "Return a link propertized version of TEXT-OR-IMAGE. +URL is used as 'help-echo and 'url properties." + ;; Try to handle an image/link inside another link. + (when (eq (char-before) ?\[) + (insert "a") + (forward-char -2) + (if (looking-at sx-question-mode--link-regexp) + (progn (setq url (or (match-string-no-properties 2) + (match-string-no-properties 4) + (sx-question-mode-find-reference + (match-string-no-properties 3) + (if (stringp text) text "¶")) + url)) + (replace-match "")) + (forward-char 1) + (delete-char 1))) + (unless (stringp text) + ;; Images need to be at the start of a line. + (unless (looking-at-p "^") (insert "\n")) + ;; And need an empty line above so they don't get wrapped into + ;; text when we do filling. + (insert (propertize "\n" 'display ""))) + ;; Insert the link button. + (insert-text-button (if (stringp text) text "¶") + ;; Mouse-over + 'help-echo + (format sx-button--link-help-echo + ;; If TEXT is a shortened url, we don't shorten URL. + (propertize (if (and (stringp text) + (string-match "^https?:" text)) + url (sx--shorten-url url)) + 'face 'font-lock-function-name-face)) + ;; For visiting and stuff. + 'sx-button-url url + 'sx-button-copy url + :type 'sx-button-link) + ;; Images need to be at the end of a line too. + (unless (stringp text) + (move-overlay text (1- (point)) (point) (current-buffer)) + (insert (propertize "\n\n" 'display "\n")))) + +(defun sx-question-mode-find-reference (id &optional fallback-id) + "Find url identified by reference ID in current buffer. +If ID is nil, use FALLBACK-ID instead." + (save-excursion + (save-match-data + (goto-char (point-min)) + (when (search-forward-regexp + (format sx-question-mode--reference-regexp + (or id fallback-id)) + 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 (&optional dont-fontify) + "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. + +If DONT-FONTIFY is non-nil, just return the result and possibly +move point, don't create the code-block button." + (let ((beg (line-beginning-position))) + ;; To identify code-blocks we need to be at start of line. + (goto-char beg) + (when (fboundp 'markdown-syntax-propertize) + (markdown-syntax-propertize (point) (point-max))) + (when (markdown-match-pre-blocks (line-end-position)) + (unless dont-fontify + (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." + (let ((end (save-excursion + (when (markdown-match-comments (line-end-position)) + (point))))) + (when end + (delete-region (point) end) + (skip-chars-backward "[:blank:]") + (when (looking-at "^[:blank:]*\n") + (replace-match "")) + t))) + +(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." + (forward-line 0) + (when (looking-at-p (format sx-question-mode--reference-regexp ".+")) + ;; Returns non-nil + (forward-paragraph 1) + t)) + +(provide 'sx-question-print) +;;; sx-question-print.el ends here + +;; Local Variables: +;; indent-tabs-mode: nil +;; End: diff --git a/elpa/sx-20160125.1601/sx-question.el b/elpa/sx-20160125.1601/sx-question.el new file mode 100644 index 0000000..7c2b1e9 --- /dev/null +++ b/elpa/sx-20160125.1601/sx-question.el @@ -0,0 +1,236 @@ +;;; sx-question.el --- question logic -*- lexical-binding: t; -*- + +;; Copyright (C) 2014 Sean Allred + +;; Author: Sean Allred + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + +;; This file provides an API for retrieving questions and defines +;; additional logic for marking questions as read or hidden. + + +;;; Code: + +(require 'sx) +(require 'sx-filter) +(require 'sx-method) + +(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) +property. + +KEYWORDS are added to the method call along with PAGE. + +`sx-method-call' is used with `sx-browse-filter'." + (sx-method-call 'questions + :keywords `((page . ,page) ,@keywords) + :site site + :auth t + :submethod submethod + :filter sx-browse-filter)) + +(defun sx-question-get-question (site question-id) + "Query SITE for a QUESTION-ID and return it. +If QUESTION-ID doesn't exist on SITE, raise an error." + (let ((res (sx-method-call 'questions + :id question-id + :site site + :auth t + :filter sx-browse-filter))) + (if res (elt res 0) + (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 res (elt res 0) + (error "Couldn't find answer %S in %S" + answer-id site)))) + +(defun sx-question-get-from-comment (site comment-id) + "Get question from SITE to which COMMENT-ID belongs. +If COMMENT-ID doesn't exist on SITE, raise an error. + +Note this requires two API requests. One for the comment and one +for the post." + (let ((res (sx-method-call 'comments + :id comment-id + :site site + :auth t + :filter sx-browse-filter))) + (unless res + (error "Couldn't find comment %S in %S" comment-id site)) + (sx-assoc-let (elt res 0) + (funcall (if (string= .post_type "answer") + #'sx-question-get-from-answer + #'sx-question-get-question) + .site_par + .post_id)))) + + +;;; Question Properties + +;;;; Read/unread +(defvar sx-question--user-read-list nil + "Alist of questions read by the user. + +Each element has the form + + (SITE . QUESTION-LIST) + +where each element in QUESTION-LIST has the form + + (QUESTION_ID . LAST-VIEWED-DATE).") + +(defun sx-question--ensure-read-list (site) + "Ensure `sx-question--user-read-list' has been read from cache. +If no cache exists for it, initialize one with SITE." + (unless sx-question--user-read-list + (setq sx-question--user-read-list + (sx-cache-get 'read-questions `'((,site)))))) + +(defun sx-question--read-p (question) + "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_par) + (let ((ql (cdr (assoc .site_par sx-question--user-read-list)))) + (and ql + (>= (or (cdr (assoc .question_id ql)) 0) + .last_activity_date))))) + +(defmacro sx-sorted-insert-skip-first (newelt list &optional predicate) + "Inserted NEWELT into LIST sorted by PREDICATE. +This is designed for the (site id id ...) lists. So the first car +is intentionally skipped." + `(let ((tail ,list) + (x ,newelt)) + (while (and ;; We're not at the end. + (cdr-safe tail) + ;; We're not at the right place. + (funcall (or #',predicate #'<) x (cadr tail))) + (setq tail (cdr tail))) + (setcdr tail (cons x (cdr tail))))) + +(defun sx-question--mark-read (question) + "Mark QUESTION as being read until it is updated again. +Returns nil if question (in its current state) was already marked +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_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_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 (or (not (numberp (cdr cell))) + (> .last_activity_date (cdr cell))) + (setcdr cell .last_activity_date))) + ;; Question wasn't present. + (t + (sx-sorted-insert-skip-first + q-cell site-cell + (lambda (x y) (> (or (car x) -1) (or (car y) -1)))))))) + ;; Save the results. + ;; @TODO This causes a small lag on `j' and `k' as the list gets + ;; large. Should we do this on a timer? + (sx-cache-set 'read-questions sx-question--user-read-list))) + + +;;;; Hidden +(defvar sx-question--user-hidden-list nil + "Alist of questions hidden by the user. + +Each element has the form + + (SITE QUESTION_ID QUESTION_ID ...)") + +(defun sx-question--ensure-hidden-list (site) + "Ensure the `sx-question--user-hidden-list' has been read from cache. + +If no cache exists for it, initialize one with SITE." + (unless sx-question--user-hidden-list + (setq sx-question--user-hidden-list + (sx-cache-get 'hidden-questions `'((,site)))))) + +(defun sx-question--hidden-p (question) + "Non-nil if QUESTION has been hidden." + (sx-assoc-let question + (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_par sx-question--user-hidden-list))) + ;; If question already hidden, do nothing. + (unless (memq .question_id site-cell) + (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))))) + + +;;;; Other data +(defun sx-question--accepted-answer-id (question) + "Return accepted answer in QUESTION or nil if none exists." + (sx-assoc-let question + (and (integerp .accepted_answer_id) + .accepted_answer_id))) + + +;;; Question Mode Answer-Sorting Functions +(sx--create-comparator sx-answer-higher-score-p + "Return t if answer A has a higher score than answer B." + #'> (lambda (x) (cdr (assq 'score x)))) + +(sx--create-comparator sx-answer-newer-p + "Return t if answer A was posted later than answer B." + #'> (lambda (x) (cdr (assq 'creation_date x)))) + +(sx--create-comparator sx-answer-more-active-p + "Return t if answer A was updated after answer B." + #'> (lambda (x) (cdr (assq 'last_activity_date x)))) + +(provide 'sx-question) +;;; sx-question.el ends here + +;; Local Variables: +;; indent-tabs-mode: nil +;; End: diff --git a/elpa/sx-20160125.1601/sx-request.el b/elpa/sx-20160125.1601/sx-request.el new file mode 100644 index 0000000..10bec4a --- /dev/null +++ b/elpa/sx-20160125.1601/sx-request.el @@ -0,0 +1,338 @@ +;;; sx-request.el --- requests and url manipulation -*- lexical-binding: t; -*- + +;; Copyright (C) 2014 Sean Allred + +;; Author: Sean Allred + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + +;; API requests are handled on three separate tiers: +;; +;; `sx-method-call': +;; +;; This is the function that should be used most often, since it +;; runs necessary checks (authentication) and provides basic +;; processing of the result for consistency. +;; +;; `sx-request-make': +;; +;; This is the fundamental function for interacting with the API. +;; It makes no provisions for 'common' usage, but it does ensure +;; data is retrieved successfully or an appropriate signal is +;; thrown. +;; +;; `url.el' and `json.el': +;; +;; The whole solution is built upon `url-retrieve-synchronously' +;; for making the request and `json-read-from-string' for parsing +;; it into a properly symbolic data structure. +;; +;; When at all possible, use `sx-method-call'. There are specialized +;; cases for the use of `sx-request-make' outside of sx-method.el, but +;; these must be well-documented inline with the code. + +;;; Code: + +(require 'url) +(require 'json) + +(require 'sx) +(require 'sx-encoding) + + +;;; Variables + +(defconst sx-request-api-key + "0TE6s1tveCpP9K5r5JNDNQ((" + "When passed, this key provides a higher request quota.") + +(defconst sx-request-api-version + "2.2" + "The current version of the API.") + +(defconst sx-request-api-root + (format "https://api.stackexchange.com/%s/" sx-request-api-version) + "The base URL to make requests from.") + +(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 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) + +(defvar sx-request-remaining-api-requests + nil + "The number of API requests remaining. +Set by `sx-request-make'.") + +(defcustom sx-request-remaining-api-requests-message-threshold + 50 + "Lower bound for printed warnings of API usage limits. +After `sx-request-remaining-api-requests' drops below this +number, `sx-request-make' will begin printing out the +number of requests left every time it finishes a call." + :group 'sx + :type 'integer) + +(defvar sx-request-all-items-delay 0 + "Delay in seconds with each `sx-request-all-items' iteration. +It is good to use a reasonable delay to avoid rate-limiting.") + + +;;; Making Requests +(defvar sx--backoff-time nil) + +(defun sx-request--wait-while-backoff () + (when sx--backoff-time + (message "Waiting for backoff time: %s" sx--backoff-time) + (let ((time (cadr (current-time)))) + (if (> (- sx--backoff-time time) 1000) + ;; If backoff-time is more than 1000 seconds in the future, + ;; we've likely just looped around the "least significant" + ;; bits of `current-time'. + (setq sx--backoff-time time) + (when (< time sx--backoff-time) + (message "Backoff detected, waiting %s seconds" (- sx--backoff-time time)) + (sleep-for (+ 0.3 (- sx--backoff-time time)))))))) + +(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 nil) + (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)) + (let-alist response + (setq current-page (1+ current-page) + return-value + (nconc return-value .items))) + (sleep-for sx-request-all-items-delay) + (setq response + (sx-request-make method `((page . ,current-page) ,@args) + request-method process-function))) + (nconc return-value + (cdr (assoc 'items response))))) + +;;; NOTE: Whenever this is arglist changes, `sx-request-fallback' must +;;; also change. +(defun sx-request-make (method &optional args request-method process-function) + "Make a request to the API, executing METHOD with ARGS. +You should almost certainly be using `sx-method-call' instead of +this function. REQUEST-METHOD is one of `get' (default) or `post'. + +Returns 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 +`sx-request-api-key' to receive a higher quota. It will also +include user's `access_token` if it is avaialble. This call is +then resolved with `url-retrieve-synchronously' to a temporary +buffer that it returns. The headers are then stripped using a +search a blank line (\"\\n\\n\"). The main body of the response +is then tested with `sx-encoding-gzipped-buffer-p' for +compression. If it is compressed, `sx-request-unzip-program' is +called to uncompress the response. The uncompressed respons is +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)) + (sx-request--wait-while-backoff) + (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 (and request-method (upcase (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 + ;; 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" + (let ((json-false nil) + (json-array-type 'list) + (json-null :null)) + (json-read-from-string data))))) + (kill-buffer response-buffer) + (when (not response) + (error "Invalid response to the url request: %s" data)) + ;; 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 .backoff + (message "Backoff received %s" .backoff) + (setq sx--backoff-time (+ (cadr (current-time)) .backoff))) + (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 _process-function) + "Fallback method when authentication is not available. +This is for UI generation when the associated API call would +require authentication. + +Currently returns nil." + '(())) + + +;;; Our own generated data +(defconst sx-request--data-url-format + "https://raw.githubusercontent.com/vermiculus/sx.el/data/data/%s.el" + "Url of the \"data\" directory inside the SX `data' branch.") + +(defun sx-request--read-buffer-data () + "Return the buffer contents after any url headers. +Error if url headers are absent or if they indicate something +went wrong." + (goto-char (point-min)) + (unless (string-match "200" (thing-at-point 'line)) + (error "Page not found.")) + (if (not (search-forward "\n\n" nil t)) + (error "Headers missing; response corrupt") + (prog1 (buffer-substring (point) (point-max)) + (kill-buffer (current-buffer))))) + +(defun sx-request-get-url (url &optional callback) + "Fetch and return data stored online at URL. +If CALLBACK is nil, fetching is done synchronously and the +data (buffer contents sans headers) is returned as a string. + +Otherwise CALLBACK must be a function of a single argument. Then +`url-retrieve' is called asynchronously and CALLBACK is passed +the retrieved data." + (let* ((url-automatic-caching t) + (url-inhibit-uncompression t) + (url-request-method "GET") + (url-request-extra-headers + '(("Content-Type" . "application/x-www-form-urlencoded"))) + (callback-internal + (when callback + ;; @TODO: Error check in STATUS. + (lambda (_status) + (funcall callback (sx-request--read-buffer-data))))) + (response-buffer + (if callback (url-retrieve url callback-internal nil 'silent) + (url-retrieve-synchronously url)))) + (unless callback + (if (not response-buffer) + (error "Something went wrong in `url-retrieve-synchronously'") + (with-current-buffer response-buffer + (sx-request--read-buffer-data)))))) + +(defun sx-request-get-data (file) + "Fetch and return data stored online by SX. +FILE is a string or symbol, the name of the file which holds the +desired data, relative to `sx-request--data-url-format'. For +instance, `tags/emacs' returns the list of tags on Emacs.SE." + (read (sx-request-get-url + (format sx-request--data-url-format file)))) + + +;;; Support Functions +(defun sx-request--build-keyword-arguments (alist &optional kv-sep) + "Format ALIST as a key-value list joined with KV-SEP. +If authentication is needed, include it also or error if it is +not available. + +Build a \"key=value&key=value&...\"-style string with the elements +of ALIST. If any value in the alist is nil, that pair will not +be included in the return. If you wish to pass a notion of +false, use the symbol `false'. Each element is processed with +`sx--thing-as-string'." + ;; Add API key to list of arguments, this allows for increased quota + ;; automatically. + (let ((api-key (cons "key" sx-request-api-key)) + (auth (car (sx-cache-get 'auth)))) + (push api-key alist) + (when auth + (push auth alist)) + (mapconcat + (lambda (pair) + (concat + (sx--thing-as-string (car pair)) + "=" + (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) + (not (cdr (assoc 'has_more response))))) + +(provide 'sx-request) +;;; sx-request.el ends here + +;; Local Variables: +;; indent-tabs-mode: nil +;; End: diff --git a/elpa/sx-20160125.1601/sx-search.el b/elpa/sx-20160125.1601/sx-search.el new file mode 100644 index 0000000..885cb53 --- /dev/null +++ b/elpa/sx-20160125.1601/sx-search.el @@ -0,0 +1,153 @@ +;;; sx-search.el --- searching for questions -*- lexical-binding: t; -*- + +;; Copyright (C) 2014 Artur Malabarba + +;; Author: Artur Malabarba + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + +;; Implements search 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) +(require 'sx-question-mode) +(require 'sx-tag) +(require 'sx-interaction) + +(defvar sx-search--query-history nil + "Query history for interactive prompts.") + + +;;; Basic function +(defun sx-search-get-questions (site page query + &optional tags excluded-tags + &rest 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/advanced + :keywords `((page . ,page) + (q . ,query) + (tagged . ,tags) + (nottagged . ,excluded-tags) + ,@keywords) + :site site + :auth t + :filter sx-browse-filter)) + +(defconst sx-search--order-methods + (cons '("Relevance" . relevance) + (default-value 'sx-question-list--order-methods)) + "Alist of possible values to be passed to the `sort' keyword.") + +(defcustom sx-search-default-order 'activity + "Default ordering method used on new searches. +Possible values are the cdrs of `sx-search--order-methods'." + :type (cons 'choice + (mapcar (lambda (c) `(const :tag ,(car c) ,(cdr c))) + (cl-remove-duplicates + sx-search--order-methods + :key #'cdr))) + :group 'sx-question-list) + + +;;;###autoload +(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-tag-multiple-read + site (concat "Tags" (when query " (optional)")))) + (unless (or query tags) + (sx-user-error "Must supply either QUERY or TAGS")) + (setq excluded-tags + (sx-tag-multiple-read site "Excluded tags (optional)"))) + (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 + (cons 'order (if sx-question-list--descending 'desc 'asc)) + (cons 'sort sx-question-list--order)))) + (setq sx-question-list--site site) + (setq sx-question-list--order sx-search-default-order) + (setq sx-question-list--order-methods sx-search--order-methods) + (sx-question-list-refresh 'redisplay) + (switch-to-buffer (current-buffer)))) + + +;;; Tag +;;;###autoload +(defun sx-search-tag-at-point (&optional pos) + "Follow tag under position POS or point." + (interactive) + (let ((tag (save-excursion + (when pos (goto-char pos)) + (or (get-text-property (point) 'sx-tag) + (thing-at-point 'symbol)))) + (meta (save-excursion + (when pos (goto-char pos)) + (get-text-property (point) 'sx-tag-meta))) + (site (replace-regexp-in-string + (rx string-start "meta.") "" + (or sx-question-list--site + (sx-assoc-let sx-question-mode--data .site_par))))) + (sx-search (concat (when meta "meta.") site) + nil tag))) + +(provide 'sx-search) +;;; sx-search.el ends here + +;; Local Variables: +;; indent-tabs-mode: nil +;; End: diff --git a/elpa/sx-20160125.1601/sx-site.el b/elpa/sx-20160125.1601/sx-site.el new file mode 100644 index 0000000..4dac8e6 --- /dev/null +++ b/elpa/sx-20160125.1601/sx-site.el @@ -0,0 +1,68 @@ +;;; sx-site.el --- browsing sites -*- lexical-binding: t; -*- + +;; Copyright (C) 2014 Sean Allred + +;; Author: Sean Allred + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + +;; This file provides various pieces of site logic, such as retrieving +;; the list of sites and the list of a user's favorited questions. + +;;; Code: + +(require 'sx-method) +(require 'sx-cache) +(require 'sx-filter) + +(defconst sx-site-browse-filter + (sx-filter-from-nil + ((site site_type + name + api_site_parameter + site_url + related_sites) + (related_site api_site_parameter + relation))) + "Filter for browsing sites.") + +(defun sx-site--get-site-list () + "Return all sites with `sx-site-browse-filter'." + (sx-cache-get + 'site-list + '(sx-method-call 'sites + :pagesize 999 + :filter sx-site-browse-filter))) + +(defcustom sx-site-favorites + nil + "List of favorite sites. +Each entry is a string corresponding to a single site's +api_site_parameter." + :group 'sx) + +(defun sx-site-get-api-tokens () + "Return a list of all known site tokens." + (mapcar + (lambda (site) (cdr (assoc 'api_site_parameter site))) + (sx-site--get-site-list))) + +(provide 'sx-site) +;;; sx-site.el ends here + +;; Local Variables: +;; indent-tabs-mode: nil +;; End: diff --git a/elpa/sx-20160125.1601/sx-switchto.el b/elpa/sx-20160125.1601/sx-switchto.el new file mode 100644 index 0000000..718a941 --- /dev/null +++ b/elpa/sx-20160125.1601/sx-switchto.el @@ -0,0 +1,63 @@ +;;; sx-switchto.el --- keymap for navigating between pages -*- lexical-binding: t; -*- + +;; Copyright (C) 2014 Artur Malabarba + +;; Author: Artur Malabarba + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + +;;; Code: + +(require 'sx) + + +;;; Keybinds +;;;###autoload +(define-prefix-command 'sx-switchto-map) + +(mapc (lambda (x) (define-key sx-switchto-map (car x) (cadr x))) + '( + ;; These imitate 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. +(defvar sx-question-list--site) +(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: diff --git a/elpa/sx-20160125.1601/sx-tab.el b/elpa/sx-20160125.1601/sx-tab.el new file mode 100644 index 0000000..3b7a9aa --- /dev/null +++ b/elpa/sx-20160125.1601/sx-tab.el @@ -0,0 +1,253 @@ +;;; sx-tab.el --- functions for viewing different tabs -*- lexical-binding: t; -*- + +;; Copyright (C) 2014 Artur Malabarba + +;; Author: Artur Malabarba + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + +;; This file provides a single macro to define 'tabs' to view lists of +;; questions. + +;;; Tabs: + +;; - `sx-tab-all-questions' :: All questions. +;; - `sx-tab-unanswered' :: Unanswered questions. +;; - `sx-tab-unanswered-my-tags' :: Unanswered questions in your followed tags. +;; - `sx-tab-featured' :: Featured questions. +;; - `sx-tab-starred' :: Starred questions. + +;;; Code: + +(require 'sx) +(require 'sx-question-list) +(require 'sx-interaction) + +(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 (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))))) + +(defconst sx-tab--order-methods + `(,@(default-value 'sx-question-list--order-methods) + ("Hottest Now" . hot) + ("Weekly Hottest" . week) + ("Monthly Hottest" . month)) + "Alist of possible values to be passed to the `sort' keyword.") + +(defcustom sx-tab-default-order 'activity + "Default ordering method used on `sx-tab-questions' and the likes. +Possible values are the cdrs of `sx-tab--order-methods'." + :type (cons 'choice + (mapcar (lambda (c) `(const :tag ,(car c) ,(cdr c))) + (cl-remove-duplicates + sx-tab--order-methods + :key #'cdr))) + :group 'sx-question-list) + +(eval-and-compile + (defconst sx-tab--docstring-format + "Display a list of %s questions for SITE. +The variable `sx-tab-default-order' can be used to customize the +sorting of the resulting list. + +NO-UPDATE (the prefix arg) is passed to `sx-question-list-refresh'. +If SITE is nil, use `sx-default-site'." + "Format used on the docstring of `sx-tab-*' commands.")) + + +;;; The main macro +(defmacro sx-tab--define (tab pager &optional printer refresher obsolete + &rest body) + "Define a StackExchange tab called TAB. +TAB is a capitalized string. + +This defines a command `sx-tab-TAB' for displaying the tab, +and a variable `sx-tab--TAB-buffer' for holding the bufer. + +The arguments PAGER, PRINTER, and REFRESHER, if non-nil, are +respectively used to set the value of the variables +`sx-question-list--print-function', +`sx-question-list--refresh-function', and +`sx-question-list--next-page-function'. + +If OBSOLETE is non-nil, it should be a string indicating the tab +to use instead of this one. + +BODY is evaluated after activating the mode and setting these +variables, but before refreshing the display." + (declare (indent 1) (debug t)) + (let* ((name (downcase tab)) + (buffer-variable + (intern (format "sx-tab--%s-buffer" + (if obsolete (downcase obsolete) + name)))) + (function-name + (intern (concat "sx-tab-" name))) + (use-instead + (when obsolete (intern (concat "sx-tab-" (downcase obsolete)))))) + `(progn + ,(unless obsolete + `(defvar ,buffer-variable nil + ,(format "Buffer where the %s questions are displayed." tab))) + (defun ,function-name (&optional no-update site) + ,(format sx-tab--docstring-format tab) + (interactive + (list current-prefix-arg + (sx--interactive-site-prompt))) + (sx-initialize) + (unless site (setq site sx-default-site)) + ;; Create the buffer + (unless (buffer-live-p ,buffer-variable) + (setq ,buffer-variable + (generate-new-buffer + ,(format "*question-list: %s *" (or obsolete tab))))) + ;; Fill the buffer with content. + (with-current-buffer ,buffer-variable + (sx-question-list-mode) + (when ,printer (setq sx-question-list--print-function ,printer)) + (when ,refresher (setq sx-question-list--refresh-function ,refresher)) + (setq sx-question-list--next-page-function ,pager) + (setq sx-question-list--site site) + (setq sx-question-list--order 'activity) + (setq sx-question-list--current-tab ,(or obsolete tab)) + ,@body + (sx-question-list-refresh 'redisplay no-update)) + (switch-to-buffer ,buffer-variable)) + ,(when obsolete + `(make-obsolete ',function-name ',use-instead nil)) + ;; Add this tab to the list of existing tabs. So we can prompt + ;; the user with completion and stuff. + (unless ,obsolete + (add-to-list 'sx-tab--list ,tab))))) + + +;;; Entry commands +(sx-tab--define "All-Questions" + (sx-question-list--make-pager 'questions) + nil nil nil + (setq sx-question-list--order-methods + sx-tab--order-methods)) +;;;###autoload +(autoload 'sx-tab-all-questions "sx-tab" nil t) + +(sx-tab--define "Unanswered" + (sx-question-list--make-pager 'questions 'unanswered)) +;;;###autoload +(autoload 'sx-tab-unanswered "sx-tab" nil t) + +(sx-tab--define "Unanswered-My-Tags" + (sx-question-list--make-pager 'questions 'unanswered/my-tags)) +;;;###autoload +(autoload 'sx-tab-unanswered-my-tags "sx-tab" nil t) + +(sx-tab--define "Featured" + (sx-question-list--make-pager 'questions 'featured)) +;;;###autoload +(autoload 'sx-tab-featured "sx-tab" nil t) + +(sx-tab--define "Starred" + (sx-question-list--make-pager 'me 'favorites)) +;;;###autoload +(autoload 'sx-tab-starred "sx-tab" 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-all-questions nil (sx--site (sx--data-here 'question))))) + + +;;; Obsolete tabs +(defconst sx-tab--basic-question-pager + (sx-question-list--make-pager 'questions)) + +(sx-tab--define "FrontPage" + sx-tab--basic-question-pager + nil nil "All-Questions" + (setq sx-question-list--order 'activity) + (setq sx-question-list--order-methods + sx-tab--order-methods)) +;;;###autoload +(autoload 'sx-tab-frontpage "sx-tab" nil t) + +(sx-tab--define "Newest" + sx-tab--basic-question-pager + nil nil "All-Questions" + (setq sx-question-list--order 'creation) + (setq sx-question-list--order-methods + sx-tab--order-methods)) +;;;###autoload +(autoload 'sx-tab-newest "sx-tab" nil t) + +(sx-tab--define "TopVoted" + sx-tab--basic-question-pager + nil nil "All-Questions" + (setq sx-question-list--order 'votes) + (setq sx-question-list--order-methods + sx-tab--order-methods)) +;;;###autoload +(autoload 'sx-tab-topvoted "sx-tab" nil t) + +(sx-tab--define "Hot" + sx-tab--basic-question-pager + nil nil "All-Questions" + (setq sx-question-list--order 'hot) + (setq sx-question-list--order-methods + sx-tab--order-methods)) +;;;###autoload +(autoload 'sx-tab-hot "sx-tab" nil t) + +(sx-tab--define "Week" + sx-tab--basic-question-pager + nil nil "All-Questions" + (setq sx-question-list--order 'week) + (setq sx-question-list--order-methods + sx-tab--order-methods)) +;;;###autoload +(autoload 'sx-tab-week "sx-tab" nil t) + +(sx-tab--define "Month" + sx-tab--basic-question-pager + nil nil "All-Questions" + (setq sx-question-list--order 'month) + (setq sx-question-list--order-methods + sx-tab--order-methods)) +;;;###autoload +(autoload 'sx-tab-month "sx-tab" nil t) + +(provide 'sx-tab) +;;; sx-tab.el ends here + +;; Local Variables: +;; indent-tabs-mode: nil +;; End: diff --git a/elpa/sx-20160125.1601/sx-tag.el b/elpa/sx-20160125.1601/sx-tag.el new file mode 100644 index 0000000..3c00ae2 --- /dev/null +++ b/elpa/sx-20160125.1601/sx-tag.el @@ -0,0 +1,179 @@ +;;; 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 . + +;;; Commentary: + + + +;;; Code: +(eval-when-compile + '(require 'cl-lib)) + +(require 'sx) +(require 'sx-method) +(require 'sx-button) + +(defface sx-tag + '((t :underline nil :inherit font-lock-function-name-face)) + "Face used on the question tags in the question buffer." + :group 'sx-question-mode-faces + :group 'sx-question-list-faces) + + +;;; Getting the list from a site +(defconst 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))) + + +;;; Getting tags from our data branch. Without the API. +;;;; @TODO: Once the cache is finished, this can probably be made into +;;;; a cache variasble with 1 day expiration time. +(defvar sx-tag-list-alist nil + "Alist where the tag list for each site is stored. +Elements are of the type (SITE . TAG-LIST).") + +(defun sx-tag-list--get (site) + "Retrieve all tags from SITE in a single request. +This does not access the API. Instead, it uses +`sx-request-get-data', which accesses SX's tag cache." + (or (cdr (assoc site sx-tag-list-alist)) + (let ((list (sx-request-get-data (concat "tags/" site)))) + (push (cons site list) sx-tag-list-alist) + list))) + + +;;; 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))) + + +;;; Prompt the user for tags. +(defvar sx-tag-history nil + "Tags history for interactive prompts.") + +;;; @TODO: Make it so that hitting BACKSPACE with an empty input +;;; deletes a previously submitted tag. +(defun sx-tag-multiple-read (site prompt &optional initial-value) + "Interactively read a list of tags for SITE. +Call `sx-completing-read' multiple times, until input is empty, +with completion options given by the tag list of SITE. +Return a list of tags given by the user. + +PROMPT is a string displayed to the user and should not end with +a space nor a colon. INITIAL-VALUE is a list of already-selected +tags." + (let ((completion-list (sx-tag-list--get site)) + (list (reverse initial-value)) + (empty-string + (propertize "--\x000-some-string-representing-empty-\x000--" + 'display "DONE")) + input) + (while (not (string= + empty-string + (setq input (sx-completing-read + (concat prompt " [" + (mapconcat #'identity (reverse list) ",") + "]: ") + completion-list + nil 'require-match nil 'sx-tag-history + empty-string)))) + (push input list)) + (reverse list))) + + +;;; Printing +(defun sx-tag--format (tag &optional meta) + "Format and return TAG for display. +If META is non-nil, the tag is for the meta site." + (with-temp-buffer + (sx-tag--insert tag meta) + (buffer-string))) + +(defun sx-tag--insert (tag &optional meta) + "Insert TAG button. +If META is non-nil, the tag is for the meta site." + (insert-text-button (concat "[" tag "]") + 'sx-button-copy tag + 'sx-tag tag + 'sx-tag-meta meta + :type 'sx-button-tag)) + +(defun sx-tag--format-tags (tags &optional site) + "Format and concatenate a sequence of TAGS. +Returns a string of all tags in TAGS, separated by a space. + +SITE is the site to which the tags refer, it is only used to +decide whether they are main or meta tags. SITE can also be t or +nil, which respectively indicate meta and main." + (let ((is-meta + (if (stringp site) (string-match (rx string-start "meta.") site) + site))) + (mapconcat (lambda (tag) (sx-tag--format tag is-meta)) + tags " "))) + +(provide 'sx-tag) +;;; sx-tag.el ends here + +;; Local Variables: +;; indent-tabs-mode: nil +;; End: diff --git a/elpa/sx-20160125.1601/sx-time.el b/elpa/sx-20160125.1601/sx-time.el new file mode 100644 index 0000000..9fa0037 --- /dev/null +++ b/elpa/sx-20160125.1601/sx-time.el @@ -0,0 +1,84 @@ +;;; sx-time.el --- time -*- lexical-binding: t; -*- + +;; Copyright (C) 2014 Sean Allred + +;; Author: Sean Allred + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + +;; This file provides functions for manipulating and displaying +;; timestamps. + +;;; Code: + +(require 'time-date) + +(defconst sx-time-seconds-to-string + ;; (LIMIT NAME VALUE) + ;; We use an entry if the number of seconds in question is less than + ;; LIMIT, but more than the previous entry's LIMIT. + ;; For instance, if time is less than 100 sec, we write it in seconds; + ;; if it is between 100 and 6000 sec, we use minutes. + ;; VALUE is the actual number of seconds which NAME represents. + '((100 "s" 1) + (6000 "m" 60.0) + (108000 "h" 3600.0) + (3456000 "d" 86400.0) + (31622400 "mo" 2628000.0) + (nil "y" 31557600.0)) + "Auxiliary variable used by `sx-time-since'.") + +(defun sx-time-since (time) + "Convert the time interval since TIME (in seconds) to a short string." + (let ((delay (- (float-time) time))) + (concat + (if (> 0 delay) "-" "") + (if (= 0 delay) "0s" + (setq delay (abs delay)) + (let ((sts sx-time-seconds-to-string) here) + (while (and (car (setq here (pop sts))) + (<= (car here) delay))) + (concat (format "%.0f" (/ delay (car (cddr here)))) + (cadr here))))))) + +(defcustom sx-time-date-format-year "%H:%M %e %b %Y" + "Format used for dates on a past year. +See also `sx-time-date-format'." + :type 'string + :group 'sx) + +(defcustom sx-time-date-format "%H:%M - %d %b" + "Format used for dates on this year. +See also `sx-time-date-format-year'." + :type 'string + :group 'sx) + +(defun sx-time-seconds-to-date (seconds) + "Return the integer SECONDS as a date string." + (let ((time (seconds-to-time seconds))) + (format-time-string + (if (string= (format-time-string "%Y") + (format-time-string "%Y" time)) + sx-time-date-format + sx-time-date-format-year) + time))) + +(provide 'sx-time) +;;; sx-time.el ends here + +;; Local Variables: +;; indent-tabs-mode: nil +;; End: diff --git a/elpa/sx-20160125.1601/sx-user.el b/elpa/sx-20160125.1601/sx-user.el new file mode 100644 index 0000000..e00ca2d --- /dev/null +++ b/elpa/sx-20160125.1601/sx-user.el @@ -0,0 +1,203 @@ +;;; sx-user.el --- handling and printing user information -*- lexical-binding: t; -*- + +;; Copyright (C) 2014 Artur Malabarba + +;; Author: Artur Malabarba + +;; This program is free software; you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + + +;;; Code: +(require 'sx) +(require 'sx-button) + +(defgroup sx-user nil + "How users are displayed by SX." + :prefix "sx-user-" + :tag "SX User" + :group 'sx) + +(defcustom sx-question-mode-fallback-user + '( + (about_me . "") + (accept_rate . -1) + (account_id . -1) + (age . -1) + (answer_count . -1) + (badge_counts . ((bronze . -1) (silver . -1) (gold . -1))) + (creation_date . -1) + (display_name . "(unknown user)") + (down_vote_count . -1) + (is_employee . nil) + (last_access_date . -1) + (last_modified_date . -1) + (link . "") + (location . "") + (profile_image . ":(") + (question_count . -1) + (reputation . -1) + (reputation_change_day . -1) + (reputation_change_month . -1) + (reputation_change_quarter . -1) + (reputation_change_week . -1) + (reputation_change_year . -1) + (timed_penalty_date . -1) + (up_vote_count . -1) + (user_id . -1) + (user_type . does_not_exist) + (view_count . -1) + (website_url . "") + ) + "The structure used to represent missing user information. +NOOTE: SX relies on this variable containing all necessary user +information. You may edit any of its fields, but you'll run into +errors if you remove them." + :type '(alist :options ((about_me string) + (accept_rate integer) + (account_id integer) + (age integer) + (answer_count integer) + (badge_counts alist) + (creation_date integer) + (display_name string) + (down_vote_count integer) + (is_employee boolean) + (last_access_date integer) + (last_modified_date integer) + (link string) + (location string) + (profile_image string) + (question_count integer) + (reputation integer) + (reputation_change_day integer) + (reputation_change_month integer) + (reputation_change_quarter integer) + (reputation_change_week integer) + (reputation_change_year integer) + (timed_penalty_date integer) + (up_vote_count integer) + (user_id integer) + (user_type symbol) + (view_count integer) + (website_url string))) + :group 'sx-user) + + +;;; Text properties +(defface sx-user-name + '((t :inherit font-lock-builtin-face)) + "Face used for user names." + :group 'sx-user) + +(defface sx-user-reputation + '((t :inherit font-lock-comment-face)) + "Face used for user reputations." + :group 'sx-user) + +(defface sx-user-accept-rate + '((t)) + "Face used for user accept-rates." + :group 'sx-user) + +(defvar sx-user--format-property-alist + `((?d button ,(list t) category ,(button-category-symbol 'sx-button-user) face sx-user-name) + (?n button ,(list t) category ,(button-category-symbol 'sx-button-user) face sx-user-name) + (?@ button ,(list t) category ,(button-category-symbol 'sx-button-user) face sx-user-name) + (?r face sx-user-reputation) + (?a face sx-user-accept-rate)) + "Alist relating % constructs with text properties. +See `sx-user--format'.") + + +;;; Formatting function +(defun sx-user--format (format-string user) + "Use FORMAT-STRING to format the user object USER. +The value is a copy of FORMAT-STRING, but with certain constructs +replaced by text that describes the specified USER: + +%d is the display name. +%@ is the display name in a format suitable for @mentions. +%l is the link to the profile. +%r is the reputation. +%a is the accept rate. + +The string replaced in each of these construct is also given the +text-properties specified in `sx-user--format-property-alist'. +Specially, %d and %@ are turned into buttons with the +`sx-button-user' category." + (sx-assoc-let (append user sx-question-mode-fallback-user) + (let* ((text (sx-format-replacements + format-string + `((?d . ,\.display_name) + (?n . ,\.display_name) + (?l . ,\.link) + (?r . ,\.reputation) + (?a . ,\.accept_rate) + (?@ . ,(when (string-match "%@" format-string) + (sx-user--@name .display_name))) + ) + sx-user--format-property-alist))) + (if (< 0 (string-width .link)) + (propertize text + ;; For visiting and stuff. + 'sx-button-url .link + 'sx-button-copy .link) + text)))) + + +;;; @name conversion +(defconst sx-user--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 (display-name) + "Convert DISPLAY-NAME into an @mention. +In order to correctly @mention the user, all whitespace is +removed from DISPLAY-NAME and a series of unicode conversions are +performed before it is returned. +See `sx-user--ascii-replacement-list'. + +If all you need is the @name, this is very slightly faster than +using `sx-user--format', but it doesn't do any sanity checking." + (concat "@" (sx--recursive-replace + sx-user--ascii-replacement-list display-name))) + +(provide 'sx-user) +;;; sx-user.el ends here + +;; Local Variables: +;; indent-tabs-mode: nil +;; End: diff --git a/elpa/sx-20160125.1601/sx.el b/elpa/sx-20160125.1601/sx.el new file mode 100644 index 0000000..ea5311c --- /dev/null +++ b/elpa/sx-20160125.1601/sx.el @@ -0,0 +1,505 @@ +;;; sx.el --- StackExchange client. Ask and answer questions on Stack Overflow, Super User, and the likes -*- lexical-binding: t; -*- + +;; Copyright (C) 2014 Sean Allred + +;; Author: Sean Allred +;; URL: https://github.com/vermiculus/sx.el/ +;; Version: 0.3 +;; Keywords: help, hypermedia, tools +;; 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 +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. + +;; This program is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. + +;; You should have received a copy of the GNU General Public License +;; along with this program. If not, see . + +;;; Commentary: + +;; This file defines basic commands used by all other parts of SX. + +;;; Code: +(require 'tabulated-list) + +(defconst sx-version "0.3" "Version of the `sx' package.") + +(defgroup sx nil + "Customization group for the `sx' package." + :prefix "sx-" + :tag "SX" + :group 'applications) + + +;;; User commands +(defun sx-version () + "Print and return the version of the `sx' package." + (interactive) + (message "%s: %s" 'sx-version sx-version) + sx-version) + +;;;###autoload +(defun sx-bug-report () + "File a bug report about the `sx' package." + (interactive) + (browse-url "https://github.com/vermiculus/sx.el/issues/new")) + + +;;; Site +(defun sx--site (data) + "Get the site in which DATA belongs. +DATA can be a question, answer, comment, or user (or any object +with a `link' property). +DATA can also be the link itself." + (let ((link (if (stringp data) data + (cdr (assoc 'link data))))) + (when (stringp link) + (replace-regexp-in-string + (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_par (sx--site link))))) + ;; Try to strip a question or answer ID + (when (cond ;; Comment + ((or ;; If there's a #commentNUMBER_NUMBER at the end, we + ;; know it's a comment with that ID. + (string-match (rx "#comment" (group-n 1 (+ digit)) + "_" (+ digit) string-end) + link) + ;; From inbox items + (string-match (rx "/posts/comments/" + ;; Comment ID + (group-n 1 (+ digit)) + ;; Optional stuff at the end + (or (and (any "?#") (* any)) "") + string-end) + link)) + (push '(type . comment) result)) + ;; Answer + ((or ;; If there's a #NUMBER at the end, we know it's an + ;; answer with that ID. + (string-match (rx "#" (group-n 1 (+ digit)) string-end) link) + ;; From 'Share' button + (string-match (rx "/a/" + ;; Answer ID + (group-n 1 (+ digit)) "/" + ;; User ID + (+ digit) + ;; Garbage at the end + (optional (and (any "?#") (* any))) + string-end) + link) + ;; From URL + (string-match (rx "/questions/" (+ digit) "/" + ;; Question title + (+ (not (any "/"))) "/" + ;; Answer ID. If this is absent, we match on + ;; Question clause below. + (group-n 1 (+ digit)) + (opt "/") + ;; Garbage at the end + (optional (and (any "?#") (* any))) + string-end) + link)) + (push '(type . answer) result)) + ;; Question + ((or ;; From 'Share' button + (string-match (rx "/q/" + ;; Question ID + (group-n 1 (+ digit)) + ;; User ID + (optional "/" (+ digit)) + ;; Garbage at the end + (optional (and (any "?#") (* any))) + string-end) + link) + ;; From URL + (string-match (rx "/questions/" + ;; Question ID + (group-n 1 (+ 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)))) + +(defun sx--pretty-site-parameter (site) + "Returned a pretty and capitalized version of string SITE." + (mapconcat #'capitalize + (split-string site "\\.") + " ")) + + +;;; Utility Functions +(defun sx--split-string (string &optional separators) + "Split STRING into substrings bounded by matches for SEPARATORS." + (mapcar (lambda (s) (replace-regexp-in-string "\\` +\\| +\\'" "" s)) + (split-string string separators 'omit-nulls))) + +(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-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'." + (message "[sx] %s" (apply #'format format-string args))) + +(defun sx-message-help-echo () + "If there's a 'help-echo property under point, message it." + (let ((echo (get-text-property (point) 'help-echo))) + (when echo (message "%s" echo)))) + +(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. 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. +Paths after the domain are replaced with \"...\". +Anything before the (sub)domain is removed." + (replace-regexp-in-string + ;; Remove anything after domain. + (rx (group-n 1 (and (1+ (any word ".")) "/")) + (1+ anything) string-end) + (eval-when-compile + (concat "\\1" (if (char-displayable-p ?…) "…" "..."))) + ;; Remove anything before subdomain. + (replace-regexp-in-string + (rx string-start (or (and (0+ word) (optional ":") "//"))) + "" url))) + +(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 \"disappears\" +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))))) + +(defun sx--goto-property-change (prop &optional direction) + "Move forward to the next change of text-property PROP. +Return the new value of PROP at point. + +If DIRECTION is negative, move backwards instead." + (let ((func (if (and (numberp direction) + (< direction 0)) + #'previous-single-property-change + #'next-single-property-change)) + (limit (if (and (numberp direction) + (< direction 0)) + (point-min) (point-max)))) + (goto-char (funcall func (point) prop nil limit)) + (get-text-property (point) prop))) + +(defun sx--find-in-buffer (type id) + "Move point to an object of TYPE and ID. +That is, move forward from beginning of buffer until +`sx--data-here' is an object of type TYPE with the respective id +ID. If point is left at the of a line, move over the line break. + +TYPE is either question, answer, or comment. +ID is an integer." + (let* ((id-symbol (cl-case type + (answer 'answer_id) + (comment 'comment_id) + (question 'question_id))) + (pos + (save-excursion + (goto-char (point-min)) + (while (not (or (eobp) + (let ((data (sx--data-here type t))) + (and data + (= id (or (cdr (assq id-symbol data)))))))) + (forward-char 1)) + (point)))) + (if (equal pos (point-max)) + (sx-message "Can't find the specified %s" type) + (goto-char pos) + (when (looking-at-p "$") + (forward-char 1))))) + +(defmacro sx--create-comparator (name doc compare-func get-func) + "Define a new comparator called NAME with documentation DOC. +COMPARE-FUNC is a function that takes the return value of +GET-FUNC and performs the actual comparison." + (declare (indent 1) (doc-string 2)) + `(defun ,name (a b) + ,doc + (funcall ,compare-func + (funcall ,get-func a) + (funcall ,get-func b)))) + +(defun sx--squash-whitespace (string) + "Return STRING with consecutive whitespace squashed together." + (replace-regexp-in-string "[ \r\n]+" " " string)) + +(defun sx--deleted-p (data) + "Return non-nil if DATA represents a deleted object." + (eq (car data) 'deleted)) + +(defun sx--invert-predicate (predicate) + "Return PREDICATE function with arguments inverted. +For instance (sx--invert-predicate #'<) is the same as #'>. +Note this is not the same as negating PREDICATE." + (lambda (&rest args) (apply predicate (reverse args)))) + + +;;; 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 + "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) + +(defmacro sx--wrap-in-overlay (properties &rest body) + "Start a scope with overlay PROPERTIES and execute BODY. +Overlay is pushed on the buffer-local variable `sx--overlays' and +given PROPERTIES. + +Return the result of BODY." + (declare (indent 1) + (debug t)) + `(let ((p (point-marker)) + (result (progn ,@body)) + ;; The first overlay is the shallowest. Any overlays created + ;; while the first one is still being created go deeper and + ;; deeper. + (sx--overlay-printing-depth (1+ sx--overlay-printing-depth))) + (let ((ov (make-overlay p (point))) + (props ,properties)) + (while props + (overlay-put ov (pop props) (pop props))) + ;; Let's multiply by 10 just in case we ever want to put + ;; something in the middle. + (overlay-put ov 'priority (* 10 sx--overlay-printing-depth)) + (push ov sx--overlays)) + result)) + +(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)) + +(defun sx-format-replacements (format alist &optional property-alist) + "Use FORMAT-STRING to format the values in ALIST. +ALIST is a list with elements of the form (CHAR . STRING). +The value is a copy of FORMAT-STRING, but with certain constructs +replaced by text as given by ALIST. + +The construct is a `%' character followed by any other character. +The replacement is the STRING corresponding to CHAR in ALIST. In +addition, if CHAR is also the car of an element in +PROPERTY-ALIST, the cdr of that element should be a list of text +properties which will be applied on the replacement. + +The %% construct is special, it is replaced with a single %, even +if ALIST contains a different string at the ?% entry." + (let ((alist (cons '(?% . "%") alist))) + (with-temp-buffer + (insert format) + (goto-char (point-min)) + (while (search-forward-regexp + (rx "%" (group-n 1 (* (any "-+ #0-9.")))) nil 'noerror) + (let* ((char (char-after)) + ;; Understand flags + (flag (match-string 1)) + (val (cdr-safe (assq char alist)))) + (unless val + (error "Invalid format character: `%%%c'" char)) + ;; Insert first, to preserve text properties. + (insert-and-inherit (format (concat "%" flag "s") val)) + (when property-alist + (add-text-properties (match-end 0) (point) + (cdr-safe (assq char property-alist)))) + ;; Delete the specifier body. + (delete-region (match-beginning 0) + (match-end 0)) + ;; Delete `char-after'. + (delete-char 1))) + (buffer-string)))) + + +;;; Key definitions +(defun sx--key-definitions-to-header-line (definitions) + "Return a `header-line-format' from DEFINITIONS. +DEFINITIONS is a list where each element has one of the following two forms + (KEY COMMAND) + (KEY COMMAND DESCRIPTION) + +The latter are used to build the return value, the former are +ignored." + (let ((ptize (lambda (x) `(:propertize ,x face mode-line-buffer-id))) + alist out) + (dolist (it definitions) + (when (> (length it) 2) + (let* ((key (car it)) + (desc (elt it 2)) + (cell (assoc desc alist))) + (if cell (push key (cdr cell)) + (push (cons desc (list key)) alist))))) + (dolist (it alist out) + (let ((desc (car it)) + (keys (cdr it))) + (push (list " " + (cons (funcall ptize (car keys)) + (mapcar (lambda (k) `("," ,(funcall ptize k))) (cdr keys))) + (let ((match + (and (= 1 (length keys)) + (string-match (regexp-quote (car keys)) desc)))) + (if (and (numberp match) (= 0 match)) + (substring desc (length (car keys))) + (concat ":" desc)))) + out))))) + + +(defcustom sx-init-hook nil + "Hook run when SX initializes. +Run after `sx-init--internal-hook'." + :group 'sx + :type 'hook) + +(defvar sx-init--internal-hook nil + "Hook run when SX initializes. +This is used internally to set initial values for variables such +as filters.") + +(defmacro sx-init-variable (variable value &optional setter) + "Set VARIABLE to VALUE using SETTER. +SETTER should be a function of two arguments. If SETTER is nil, +`set' is used." + (eval + `(add-hook + 'sx-init--internal-hook + (lambda () + (,(or setter #'setq) ,variable ,value)))) + nil) + +(defvar sx-initialized nil + "Nil if sx hasn't been initialized yet. +If it has, holds the time at which initialization happened.") + +(defun sx-initialize (&optional force) + "Run initialization hooks if they haven't been run yet. +These are `sx-init--internal-hook' and `sx-init-hook'. + +If FORCE is non-nil, run them even if they've already been run." + (when (or force (not sx-initialized)) + (prog1 + (run-hooks 'sx-init--internal-hook + 'sx-init-hook) + (setq sx-initialized (current-time))))) + +(provide 'sx) +;;; sx.el ends here + +;; Local Variables: +;; indent-tabs-mode: nil +;; End: