From 26177eb415f1bc4cf8bfa52e5f027ca38378786c Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Fri, 7 Nov 2014 14:03:04 +0000 Subject: Renamed all files. Still a lot to be done inside them. --- Cask | 2 +- stack-auth.el | 70 ---------- stack-core.el | 369 ------------------------------------------------- stack-filter.el | 103 -------------- stack-lto.el | 106 -------------- stack-network.el | 33 ----- stack-question-list.el | 299 --------------------------------------- stack-question.el | 121 ---------------- sx-auth.el | 69 +++++++++ sx-filter.el | 102 ++++++++++++++ sx-lto.el | 104 ++++++++++++++ sx-network.el | 32 +++++ sx-question-list.el | 297 +++++++++++++++++++++++++++++++++++++++ sx-question.el | 120 ++++++++++++++++ sx.el | 367 ++++++++++++++++++++++++++++++++++++++++++++++++ 15 files changed, 1092 insertions(+), 1102 deletions(-) delete mode 100644 stack-auth.el delete mode 100644 stack-core.el delete mode 100644 stack-filter.el delete mode 100644 stack-lto.el delete mode 100644 stack-network.el delete mode 100644 stack-question-list.el delete mode 100644 stack-question.el create mode 100644 sx-auth.el create mode 100644 sx-filter.el create mode 100644 sx-lto.el create mode 100644 sx-network.el create mode 100644 sx-question-list.el create mode 100644 sx-question.el create mode 100644 sx.el diff --git a/Cask b/Cask index 4633bb6..3e939ef 100644 --- a/Cask +++ b/Cask @@ -3,7 +3,7 @@ (source gnu) (source melpa-stable) -(files "stack-*.el") +(files "sx*.el") (depends-on "json" "1.4") (depends-on "url") diff --git a/stack-auth.el b/stack-auth.el deleted file mode 100644 index e55fae1..0000000 --- a/stack-auth.el +++ /dev/null @@ -1,70 +0,0 @@ -;;; stack-auth.el --- user authentication for stack-mode -*- lexical-binding: t; -*- - -;; Copyright (C) 2014 Sean Allred - -;; Author: Sean Allred -;; Keywords: help, hypermedia, mail, news, tools - -;; 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 'stack-core) - -(defconst stack-auth-root - "https://stackexchange.com/oauth/dialog") -(defconst stack-auth--redirect-uri - "http://vermiculus.github.io/stack-mode/auth/auth.htm") -(defconst stack-auth--client-id - "3291") -(defvar stack-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!") - -(defun stack-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)." - (interactive) - (setq - stack-auth-access-token - (when (browse-url - (let ((stack-core-api-root stack-auth-root) - (stack-core-api-batch-request-separator ",")) - (stack-core-build-request - nil - `((client_id . ,stack-auth--client-id) - (scope . (read_inbox - no_expiry - write_access)) - (redirect_uri . ,(url-hexify-string - stack-auth--redirect-uri)))))) - (read-string "Enter the access token displayed on the webpage: "))) - (if (string-equal "" stack-auth-access-token) - (progn (setq stack-auth-access-token nil) - (error "You must enter this code to use this client fully")) - (stack-cache-set "auth.el" `((access-token . ,stack-auth-access-token))))) - -(provide 'stack-auth) -;;; stack-auth.el ends here diff --git a/stack-core.el b/stack-core.el deleted file mode 100644 index 496533e..0000000 --- a/stack-core.el +++ /dev/null @@ -1,369 +0,0 @@ -;;; stack-core.el --- core functions for stack-mode -*- lexical-binding: t; -*- - -;; Copyright (C) 2014 Sean Allred - -;; Author: Sean Allred -;; Keywords: help, hypermedia, mail, news, tools - - -;; 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 -;; StackMode. Currently, there are sections that are pretty wildly -;; different from each other (e.g. `Filters' and `Questions'. These -;; will eventually be migrated to their own files with related functions -;; of their ilk -- for now, it is more convenient to keep them handy. - -;;; Code: - - -;;; Requirements -(require 'json) -(require 'url) -(require 'time-date) - - -;;; Package Logging - -(defun stack-message (format-string &rest args) - "Display a message" - (message "[stack] %s" (apply #'format format-string args))) - - -;;; Constants and Customizable Options - -(defcustom stack-cache-directory - (expand-file-name ".stackmode" user-emacs-directory) - "Directory containined cached files and precompiled filters.") - -(defconst stack-core-api-version - "2.2" - "The current version of the API.") - -(defconst stack-core-api-root - (format "http://api.stackexchange.com/%s/" stack-core-api-version) - "The base URL to make requests from.") - -(defvar stack-core-api-batch-request-separator - ";" - "The separator character to use when making batch requests. - -Do not change this unless you know what you are doing!") - -(defconst stack-core-api-key - "0TE6s1tveCpP9K5r5JNDNQ((" - "When passed, this key provides a higher request quota.") - -(defcustom stack-core-default-keyword-arguments-alist - '(("filters/create") - ("sites") - ("questions" (site . emacs)) - (t nil)) - "Keywords to use as the default for a given method. - -The first element of each list is the method call the keywords -apply to. The remaining cons cells (and they must be conses) are -the values for each keyword. - -For each list, if no keywords are provided, the method's -arguments are forced to the default as determined by the API. - -For each cons cell, if the cdr is `nil', then the keyword will be -forced to the default as determined by the API. - -See `stack-core-get-default-keyword-arguments' and -`stack-core-build-keyword-arguments'. -") - -(defcustom stack-core-cache-requests - t - "Cache requests made to the StackExchange API.") - -(defcustom stack-core-unzip-program - "gunzip" - "program used to unzip the response") - -(defvar stack-core-remaining-api-requests - nil - "The number of API requests remaining according to the most -recent call. Set by `stack-core-make-request'.") - -(defcustom stack-core-remaining-api-requests-message-threshold - 50 - "After `stack-core-remaining-api-requests' drops below this -number, `stack-core-make-request' will begin printing out the -number of requests left every time it finishes a call.") - -(defcustom stack-core-silent-requests - t - "When `t', requests default to being silent.") - - -;;; Keyword Arguments - -(defun stack-core-thing-as-string (thing) - "Return a string representation of THING. If THING is already -a string, just return it." - (cond - ((stringp thing) thing) - ((symbolp thing) (symbol-name thing)) - ((numberp thing) (number-to-string thing)) - ((sequencep thing) - (mapconcat #'stack-core-thing-as-string - thing stack-core-api-batch-request-separator)))) - -(defun stack-core-get-default-keyword-arguments (method) - "Gets the correct keyword arguments for METHOD." - (let ((entry (assoc method stack-core-default-keyword-arguments-alist))) - (cdr (or entry (assoc t stack-core-default-keyword-arguments-alist))))) - -;;; @todo stack-core-change-default-keyword-arguments -;;; (method new-keyword-arguments) -;;; @todo stack-core-change-default-keyword-arguments-for-key -;;; (method key new-value) - -(defun stack-core-build-keyword-arguments (alist) - "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 -`stack-core-thing-as-string'." - (mapconcat - (lambda (pair) - (concat - (stack-core-thing-as-string (car pair)) - "=" - (stack-core-thing-as-string (cdr pair)))) - (delq nil (mapcar - (lambda (pair) - (when (cdr pair) pair)) - alist)) - "&")) - - -;;; Making Requests of StackExchange - -(defun stack-core-build-request (method keyword-arguments) - "Build the request string that will be used to process REQUEST -with the given KEYWORD-ARGUMENTS." - (let ((base (concat stack-core-api-root method)) - (args (stack-core-build-keyword-arguments keyword-arguments))) - (if (string-equal "" args) - base - (concat base "?" args)))) - -(defun stack-core-make-request - (method &optional keyword-arguments filter silent) - "Make a request to the StackExchange API using METHOD and -optional KEYWORD-ARGUMENTS. If no KEYWORD-ARGUMENTS are given, -`stack-core-default-keyword-arguments-alist' is used. Return the -entire response as a complex alist." - (let ((url-automatic-caching stack-core-cache-requests) - (url-inhibit-uncompression t) - (silent (or silent stack-core-silent-requests)) - (call - (stack-core-build-request - method - (append `((filter . ,(cond (filter filter) - ((boundp 'stack-filter) stack-filter))) - (key . ,stack-core-api-key)) - (if keyword-arguments keyword-arguments - (stack-core-get-default-keyword-arguments method)))))) - ;; TODO: url-retrieve-synchronously can return nil if the call is - ;; unsuccessful should handle this case - (unless silent (stack-message "Request: %S" call)) - (let ((response-buffer (cond - ((= emacs-minor-version 4) - (url-retrieve-synchronously call silent)) - (t (url-retrieve-synchronously call))))) - (if (not response-buffer) - (error "Something went wrong in `url-retrieve-synchronously'") - (with-current-buffer response-buffer - (let* ((data (progn - (goto-char (point-min)) - (if (not (search-forward "\n\n" nil t)) - (error "Response headers missing") - (delete-region (point-min) (point)) - (buffer-string)))) - (response (ignore-errors - (json-read-from-string data)))) - ;; if response isn't nil, the response was in plain text - (unless response - ;; try to decompress the response - (setq response - (with-demoted-errors "JSON Error: %s" - (shell-command-on-region - (point-min) (point-max) - stack-core-unzip-program - nil t) - (json-read-from-string - (buffer-substring - (point-min) (point-max))))) - ;; If it still fails, error out - (unless response - (stack-message "Unable to parse response") - (stack-message "Printing response as message") - (message "%S" response) - (error "Response could not be read by json-read-string"))) - ;; At this point, either response is a valid data structure - ;; or we have already thrown an error - (when (assoc 'error_id response) - (error "Request failed: (%s) [%i %s] %s" - method - (cdr (assoc 'error_id response)) - (cdr (assoc 'error_name response)) - (cdr (assoc 'error_message response)))) - (when (< (setq stack-core-remaining-api-requests - (cdr (assoc 'quota_remaining response))) - stack-core-remaining-api-requests-message-threshold) - (stack-message "%d API requests remaining" - stack-core-remaining-api-requests)) - (cdr (assoc 'items response)))))))) - -(defun stack-core-filter-data (data desired-tree) - "Filters DATA and returns the DESIRED-TREE" - (if (vectorp data) - (apply #'vector - (mapcar (lambda (entry) - (stack-core-filter-data - entry desired-tree)) - data)) - (delq - nil - (mapcar (lambda (cons-cell) - ;; TODO the resolution of `f' is O(2n) in the worst - ;; case. It may be faster to implement the same - ;; functionality as a `while' loop to stop looking the - ;; list once it has found a match. Do speed tests. - ;; See edfab4443ec3d376c31a38bef12d305838d3fa2e. - (let ((f (or (memq (car cons-cell) desired-tree) - (assoc (car cons-cell) desired-tree)))) - (when f - (if (and (sequencep (cdr cons-cell)) - (sequencep (elt (cdr cons-cell) 0))) - (cons (car cons-cell) - (stack-core-filter-data - (cdr cons-cell) (cdr f))) - cons-cell)))) - data)))) - -(defun stack-cache-get-file-name (filename) - "Expands FILENAME in the context of `stack-cache-directory'." - (expand-file-name filename stack-cache-directory)) - -(defun stack-cache-get (cache) - "Return the data within CACHE. - -As with `stack-cache-set', CACHE is a file name within the -context of `stack-cache-directory'." - (unless (file-exists-p stack-cache-directory) - (mkdir stack-cache-directory)) - (let ((file (stack-cache-get-file-name cache))) - (when (file-exists-p file) - (with-temp-buffer - (insert-file-contents (stack-cache-get-file-name cache)) - (read (buffer-string)))))) - -(defun stack-cache-set (cache data) - "Set the content of CACHE to DATA. - -As with `stack-cache-get', CACHE is a file name within the -context of `stack-cache-directory'. - -DATA will be written as returned by `prin1'." - (unless (file-exists-p stack-cache-directory) - (mkdir stack-cache-directory)) - (write-region (prin1-to-string data) nil - (stack-cache-get-file-name cache)) - data) - -(defvar stack-core--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. - '((100 "s" 1) - (6000 "m" 60.0) - (108000 "h" 3600.0) - (34560000 "d" 86400.0) - (nil "y" 31557600.0)) - "Auxiliary variable used by `stack--time-since'.") - -(defun stack--time-since (time) - "Convert the time interval since TIME (in seconds) to a short string." - (let ((delay (- (time-to-seconds) time))) - (concat - (if (> 0 delay) "-" "") - (if (= 0 delay) "0s" - (setq delay (abs delay)) - (let ((sts stack-core--seconds-to-string) here) - (while (and (car (setq here (pop sts))) - (<= (car here) delay))) - (concat (format "%.0f" (/ delay (car (cddr here)))) - (cadr here))))))) - -(defcustom stack-core-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 to replace when displaying question titles and other text." - :type '(repeat (choice symbol string)) - :group 'stack-core) - -(defun stack-core--decode-entities (string) - (let* ((plist stack-core-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 ' - (format "%c" (string-to-int - (substring ss 1)))))))) - (replace-regexp-in-string "&[^; ]*;" get-function string))) - -(provide 'stack-core) -;;; stack-core.el ends here diff --git a/stack-filter.el b/stack-filter.el deleted file mode 100644 index 4210549..0000000 --- a/stack-filter.el +++ /dev/null @@ -1,103 +0,0 @@ -;;; stack-filter.el --- filters for stack-mode -*- lexical-binding: t; -*- - -;; Copyright (C) 2014 Sean Allred - -;; Author: Sean Allred -;; Keywords: help, hypermedia, mail, news, tools - -;; 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: - - -;;; Dependencies - -(require 'stack-core) - - -;;; Customizations - -(defconst stack-filter-cache-file - "filters.el") - -(defvar stack-filter - 'default - "The current filter. -To customize the filter for the next call -to `stack-core-make-request', let-bind this variable to the -output of a call to `stack-core-compile-filter'. Be careful! If -you're going to be using this new filter a lot, create a variable -for it. Creation requests count against -`stack-core-remaining-api-requests'!") - - -;;; Compilation - -;;; TODO allow BASE to be a precompiled filter name -(defun stack-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 -or string." - (let ((keyword-arguments - `((include . ,(if include (mapconcat - #'stack-core-thing-as-string - include ";"))) - (exclude . ,(if exclude (mapconcat - #'stack-core-thing-as-string - exclude ";"))) - (base . ,(if base base))))) - (let ((response (stack-core-make-request - "filter/create" - keyword-arguments))) - (url-hexify-string - (cdr (assoc 'filter - (elt response 0))))))) - - -;;; Storage and Retrieval - -(defun stack-filter-get (filter) - "Retrieve named FILTER from `stack-filter-cache-file'." - (cdr (assoc filter (stack-cache-get stack-filter-cache-file)))) - -(defun stack-filter-store (name &optional filter) - "Store NAME as FILTER in `stack-filter-cache-file'. - -NAME should be a symbol and FILTER is a string as compiled by -`stack-filter-compile'. - -If NAME is a cons cell, (car NAME) is taken to be the actual NAME -and (cdr NAME) is taken to be the actual FILTER. In this case, -the second argument is simply ignored." - (let ((name (if (consp name) (car name) name)) - (filter (if (consp name) (cdr name) filter))) - (unless (symbolp name) - (error "Name must be a symbol: %S" name)) - (let* ((dict (stack-cache-get stack-filter-cache-file)) - (entry (assoc name dict))) - (if entry (setcdr entry filter) - (setq dict (cons (cons name filter) dict))) - - (stack-cache-set stack-filter-cache-file dict)))) - -(defun stack-filter-store-all (name-filter-alist) - (mapc #'stack-filter-store name-filter-alist)) - -(provide 'stack-filter) -;;; stack-filter.el ends here diff --git a/stack-lto.el b/stack-lto.el deleted file mode 100644 index af1be9f..0000000 --- a/stack-lto.el +++ /dev/null @@ -1,106 +0,0 @@ -;;; stack-core.el --- lisp-to-org conversion functions for stack-mode -*- lexical-binding: t; -*- - -;; Copyright (C) 2014 Artur Malabarba - -;; Author: Artur Malabarba -;; Keywords: help, hypermedia, mail, news, tools - - -;; 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: - - -;;; Requirements -(require 'stack-core) -(require 'json) -(require 'org) - -(defun stack-lto--question (data) - "Return question DATA in a format acceptable by `org-element-interpret-data'. -DATA is a list of cons cells representing a question, as received -by the API and read by `json-read'." - `(headline (:title ,(cdr (assoc 'title data)) - :level 1 - :tags ,(mapcar #'identity (cdr (assoc 'tags data)))) - ,(stack-lto--question-answer data) - ,@(mapcar #'stack-lto--answer (cdr (assoc 'answers data))))) - -(defun stack-lto--answer (data) - "Return answer DATA in a format acceptable by `org-element-interpret-data'. -DATA is a list of cons cells representing a question, as received -by the API and read by `json-read'." - ;; Right now this doesn't do anything special. But it should check - ;; whether the answer is accepted. How do we display that? - `(headline (:title "Answer" :level 2) - ,(stack-lto--question-answer data))) - -(defun stack-lto--question-answer (data) - "Process and return the elements of DATA which questions and answers have in common." - (let ((comments - (mapcar #'stack-lto--comment (cdr (assoc 'comments data))))) - `(;; Body as a src block (really NOT nice). - (src-block (:value ,(stack-lto--body data) - . ,stack-lto--body-src-block)) - ;; Comments as descriptive lists. If there are no comments, an - ;; empty list would throw an error. - ,@(when comments `((plain-list (:type descriptive) ,comments)))))) - - -;;; Body rendering -(defvar stack-lto--body-src-block - '(:language "markdown" :switches nil :parameters nil :hiddenp nil) - "Properties used on the markdown src-block which represents the body.") - -(defface stack-lto-body - '((((background light)) :background "Grey90") - (((background dark)) :background "Grey10")) - "Face used on the body content of questions and answers." - :group 'stack-mode-faces) - -;;; This is not used ATM since we got rid of HTML. But it can be used -;;; once we start extending markdown mode. -(defcustom stack-lto-bullet (if (char-displayable-p ?•) " •" " -") - "Bullet used on the display of lists." - :type 'string - :group 'stack-mode) - -(defun stack-lto--body (data) - "Get and cleanup `body_markdown' from DATA." - (concat - (replace-regexp-in-string - "\r\n" "\n" (cdr (assoc 'body_markdown data))) - "\n")) - -;; We need to add padding in case the body contains a * at column 1 -;; (which would break org-mode). -(defvar stack-lto--padding - (propertize "  " 'display " ") - "Left-padding added to each line of a body.") - -(defvar stack-lto-comment-item - '(:bullet "- " :checkbox nil :counter nil :hiddenp nil) - "Properties used on the items which represent comments.") - -(defun stack-lto--comment (data) - "" - (let* ((owner (cdr (assoc 'owner data))) - (owner-name (cdr (assoc 'display_name owner)))) - `(item (:tag ,owner-name . ,stack-lto-comment-item) - (paragraph () ,(cdr (assoc 'body_markdown data)))))) - -(provide 'stack-lto) -;;; stack-core.el ends here diff --git a/stack-network.el b/stack-network.el deleted file mode 100644 index e7e333c..0000000 --- a/stack-network.el +++ /dev/null @@ -1,33 +0,0 @@ -;;; stack-network.el --- network functions for stack-mode -*- lexical-binding: t; -*- - -;; Copyright (C) 2014 Sean Allred - -;; Author: Sean Allred -;; Keywords: help, hypermedia, mail, news, tools - -;; 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 'stack-core) - -(defun stack-network-get-networks () - (stack-core-make-request "sites")) - -(provide 'stack-network) -;;; stack-network.el ends here diff --git a/stack-question-list.el b/stack-question-list.el deleted file mode 100644 index 924e90e..0000000 --- a/stack-question-list.el +++ /dev/null @@ -1,299 +0,0 @@ -;;; stack-question-list.el --- Major-mode for navigating questions list. -*- lexical-binding: t; -*- - -;; Copyright (C) 2014 Artur Malabarba - -;; Author: Artur Malabarba -;; Keywords: help, hypermedia, mail, news, tools - - -;; 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 'stack-question) -(require 'tabulated-list) -(require 'cl-lib) - - -;;; Customization -(defcustom stack-question-list-height 12 - "Height, in lines, of stack-mode's *question-list* buffer." - :type 'integer - :group 'stack-question-list) - -(defface stack-question-list-parent - '((t :inherit default)) - "" - :group 'stack-question-list-faces) - -(defface stack-question-list-answers - '((((background light)) :foreground "SeaGreen4" - :height 1.0 :inherit stack-question-list-parent) - (((background dark)) :foreground "#D1FA71" - :height 1.0 :inherit stack-question-list-parent) - (t :inherit stack-question-list-parent)) - "" - :group 'stack-question-list-faces) - -(defface stack-question-list-answers-accepted - '((((background light)) :background "YellowGreen" - :inherit stack-question-list-answers) - (((background dark)) :background "DarkOliveGreen" - :inherit stack-question-list-answers) - (t :inherit stack-question-list-answers)) - "" - :group 'stack-question-list-faces) - -(defface stack-question-list-score - '((t :height 1.0 :inherit stack-question-list-parent)) - "" - :group 'stack-question-list-faces) - -(defface stack-question-list-score-upvoted - '((t :weight bold - :inherit stack-question-list-score)) - "" - :group 'stack-question-list-faces) - -(defface stack-question-list-tags - '((t :inherit font-lock-function-name-face)) - "" - :group 'stack-question-list-faces) - -(defface stack-question-list-date - '((t :inherit font-lock-comment-face)) - "" - :group 'stack-question-list-faces) - -(defface stack-question-list-read-question - '((t :height 1.0 :inherit stack-question-list-parent)) - "" - :group 'stack-question-list-faces) - -(defface stack-question-list-unread-question - '((t :weight bold :inherit stack-question-list-read-question)) - "" - :group 'stack-question-list-faces) - - -;;; Mode Definition -(define-derived-mode stack-question-list-mode tabulated-list-mode "Question List" - "Major mode for browsing a list of questions from stack-exchange. -Letters do not insert themselves; instead, they are commands. -\\ -\\{stack-question-list}" - (hl-line-mode 1) - (stack-question-list--update-mode-line) - (setq tabulated-list-format - [(" V" 3 t :right-align t) - (" A" 3 t :right-align t) - ("Title" 0 stack-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 '("Title" . nil)) - (add-hook 'tabulated-list-revert-hook - #'stack-question-list-refresh nil t) - (add-hook 'tabulated-list-revert-hook - #'stack-question-list--update-mode-line nil t) - (tabulated-list-init-header)) - -(defcustom stack-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 'stack-question-list) - -(defun stack-question-list--date-more-recent-p (x y) - "Non-nil if tabulated-entry X is newer than Y." - (stack-question--< - stack-question-list-date-sort-method - (car x) (car y) #'>)) - -(mapc - (lambda (x) (define-key stack-question-list-mode-map - (car x) (cadr x))) - '(("n" stack-question-list-next) - ("p" stack-question-list-previous) - ("j" stack-question-list-view-next) - ("k" stack-question-list-view-previous) - ("g" stack-question-list-refresh) - ([?\r] stack-question-list-display-question))) - -(defvar stack-question-list--current-page "Latest" - ;; Other values (once we implement them) are "Top Voted", - ;; "Unanswered", etc. - "Variable describing current page being viewed.") - -(defvar stack-question-list--unread-count 0 - "Holds the number of unread questions in the current buffer.") -(make-variable-buffer-local 'stack-question-list--unread-count) - -(defvar stack-question-list--total-count 0 - "Holds the total number of questions in the current buffer.") -(make-variable-buffer-local 'stack-question-list--total-count) - -(defconst stack-question-list--mode-line-format - '(" " - mode-name - " " - (:propertize stack-question-list--current-page - face mode-line-buffer-id) - " [" - "Unread: " - (:propertize - (:eval (int-to-string stack-question-list--unread-count)) - face mode-line-buffer-id) - ", " - "Total: " - (:propertize - (:eval (int-to-string stack-question-list--total-count)) - face mode-line-buffer-id) - "] ") - "Mode-line construct to use in question-list buffers.") - -(defun stack-question-list--update-mode-line () - "Fill the mode-line with useful information." - ;; All the data we need is right in the buffer. - (when (derived-mode-p 'stack-question-list-mode) - (setq mode-line-format - stack-question-list--mode-line-format) - (setq stack-question-list--total-count - (length tabulated-list-entries)))) - -(defvar stack-question-list--current-site "emacs" - "Site being displayed in the *question-list* buffer.") - -(defun stack-question-list-refresh (&optional redisplay no-update) - "Update the list of questions. -If REDISPLAY is non-nil, also call `tabulated-list-print'. -If the prefix argument NO-UPDATE is nil, query stack-exchange for -a new list before redisplaying." - (interactive "pP") - ;; Reset the mode-line unread count (we rebuild it here). - (setq stack-question-list--unread-count 0) - (let ((question-list (stack-question-get-questions - stack-question-list--current-site))) - ;; Print the result. - (setq tabulated-list-entries - (mapcar #'stack-question-list--print-info question-list))) - (when redisplay (tabulated-list-print 'remember))) - -(defcustom stack-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 'stack-question-list) - -(defun stack-question-list--print-info (data) - "Convert `json-read' DATA into tabulated-list format." - (list - data - (vector - (list (int-to-string (cdr (assoc 'score data))) - 'face - (if (cdr (assoc 'upvoted data)) 'stack-question-list-score-upvoted - 'stack-question-list-score)) - (list (int-to-string (cdr (assoc 'answer_count data))) - 'face - (if (stack-question--accepted-answer data) - 'stack-question-list-answers-accepted - 'stack-question-list-answers)) - (concat - (propertize - (cdr (assoc 'title data)) - 'face - (if (stack-question--read-p data) - 'stack-question-list-read-question - ;; Increment `stack-question-list--unread-count' for the mode-line. - (cl-incf stack-question-list--unread-count) - 'stack-question-list-unread-question)) - (propertize " " 'display "\n ") - (propertize (concat (stack--time-since (cdr (assoc 'last_activity_date data))) - stack-question-list-ago-string) - 'face 'stack-question-list-date) - (propertize (concat " [" (mapconcat #'identity (cdr (assoc 'tags data)) "] [") "]") - 'face 'stack-question-list-tags) - (propertize " " 'display "\n"))))) - -(defun stack-question-list-view-previous (n) - "Hide this question, move to previous one, display it." - (interactive "p") - (stack-question-list-view-next (- n))) - -(defun stack-question-list-view-next (n) - "Hide this question, move to next one, display it." - (interactive "p") - (stack-question-list-next n) - (stack-question-list-display-question)) - -(defun stack-question-list-next (n) - "Move to the next entry." - (interactive "p") - (forward-line n)) - -(defun stack-question-list-previous (n) - "Move to the previous entry." - (interactive "p") - (stack-question-list-next (- n))) - -(defun stack-question-list-display-question (&optional data focus) - "Display question given by DATA. -If called interactively (or with DATA being nil), display -question under point. -Also when called interactively (or when FOCUS is non-nil), also -focus the relevant window." - (interactive '(nil t)) - (unless data (setq data (tabulated-list-get-id))) - (unless data (error "No question here!")) - (when (stack-question--read-p data) - (cl-decf stack-question-list--unread-count) - (stack-question--mark-read data)) - (unless (window-live-p stack-question--window) - (setq stack-question--window - (condition-case er - (split-window-below stack-question-list-height) - (error - ;; If the window is too small to split, use current one. - (if (string-match - "Window # too small for splitting" - (car (cdr-safe er))) - nil - (error (cdr er))))))) - (stack-question--display data stack-question--window) - (when focus - (if stack-question--window - (select-window stack-question--window) - (switch-to-buffer stack-question--buffer)))) - -(defvar stack-question-list--buffer nil - "Buffer where the list of questions is displayed.") - -(defun list-questions (no-update) - "Display a list of stack-exchange questions." - (interactive "P") - (unless (buffer-live-p stack-question-list--buffer) - (setq stack-question-list--buffer - (generate-new-buffer "*question-list*"))) - (with-current-buffer stack-question-list--buffer - (stack-question-list-mode) - (stack-question-list-refresh 'redisplay no-update)) - (switch-to-buffer stack-question-list--buffer)) - -(defalias 'stack-list-questions #'list-questions) - -(provide 'stack-question-list) -;;; stack-question-list.el ends here diff --git a/stack-question.el b/stack-question.el deleted file mode 100644 index 9fd5fcc..0000000 --- a/stack-question.el +++ /dev/null @@ -1,121 +0,0 @@ -;;; stack-question.el --- question logic for stack-mode -*- lexical-binding: t; -*- - -;; Copyright (C) 2014 Sean Allred - -;; Author: Sean Allred -;; Keywords: help, hypermedia, mail, news, tools - -;; 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 'stack-core) -(require 'stack-filter) -(require 'stack-lto) - -;; I don't know why this is here, but it was causing an API request on require. -(defvar stack-question-browse-filter nil - ;; (stack-filter-compile - ;; nil - ;; '(user.profile_image shallow_user.profile_image)) - ) - -;; (stack-filter-store 'question-browse stack-question-browse-filter) - -(defun stack-question-get-questions (site &optional page) - "Get the page PAGE of questions from SITE." - (stack-core-make-request - "questions" - `((site . ,site) - (page . ,page)) - stack-question-browse-filter)) - - -;;; Question Properties -(defun stack-question--read-p (question) - "Non-nil if QUESTION has been read since last updated." - ;; @TODO: - (cl-evenp (random))) - -(defun stack-question--accepted-answer (question) - "Return accepted answer in QUESTION, or nil if none." - ;; @TODO: - (cl-evenp (random))) - -(defun stack-question--mark-read (question) - "Mark QUESTION as being read, until it is updated again." - nil) - -(defun stack-question--< (property x y &optional pred) - "Non-nil if PROPERTY attribute of question X is less than that of Y. -With optional argument predicate, use it instead of `<'." - (funcall (or pred #'<) - (cdr (assoc property x)) - (cdr (assoc property y)))) - -;;; Displaying a question -(defvar stack-question--window nil - "Window where the content of questions is displayed.") - -(defvar stack-question--buffer nil - "Buffer being used to display questions.") - -(defcustom stack-question-use-html t - "If nil, markdown is used for the body." - :type 'boolean - :group 'stack-question) - -(defun stack-question--display (data &optional window) - "Display question given by DATA on WINDOW. -If WINDOW is nil, use selected one." - (let ((stack-lto--body-src-block - (if stack-question-use-html nil - stack-lto--body-src-block)) - (inhibit-read-only t)) - (with-current-buffer - (stack-question--display-buffer window) - (erase-buffer) - (insert - (org-element-interpret-data - (stack-lto--question data))) - (org-mode) - (show-all) - (view-mode) - (current-buffer)))) - -(defun stack-question--display-buffer (window) - "Display and return the buffer used for displaying a question. -Create the buffer if necessary. -If WINDOW is given, use that to display the buffer." - ;; Create the buffer if necessary. - (unless (buffer-live-p stack-question--buffer) - (setq stack-question--buffer - (generate-new-buffer "*stack-question*"))) - (cond - ;; Window was given, use it. - ((window-live-p window) - (set-window-buffer window stack-question--buffer)) - ;; No window, but the buffer is already being displayed somewhere. - ((get-buffer-window stack-question--buffer 'visible)) - ;; Neither, so we create the window. - (t (switch-to-buffer stack-question--buffer))) - stack-question--buffer) - -(provide 'stack-question) -;;; stack-question.el ends here diff --git a/sx-auth.el b/sx-auth.el new file mode 100644 index 0000000..0da2f4c --- /dev/null +++ b/sx-auth.el @@ -0,0 +1,69 @@ +;;; stack-auth.el --- user authentication for stack-mode -*- 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: + +;; + +;;; Code: + +(require 'stack-core) + +(defconst stack-auth-root + "https://stackexchange.com/oauth/dialog") +(defconst stack-auth--redirect-uri + "http://vermiculus.github.io/stack-mode/auth/auth.htm") +(defconst stack-auth--client-id + "3291") +(defvar stack-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!") + +(defun stack-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)." + (interactive) + (setq + stack-auth-access-token + (when (browse-url + (let ((stack-core-api-root stack-auth-root) + (stack-core-api-batch-request-separator ",")) + (stack-core-build-request + nil + `((client_id . ,stack-auth--client-id) + (scope . (read_inbox + no_expiry + write_access)) + (redirect_uri . ,(url-hexify-string + stack-auth--redirect-uri)))))) + (read-string "Enter the access token displayed on the webpage: "))) + (if (string-equal "" stack-auth-access-token) + (progn (setq stack-auth-access-token nil) + (error "You must enter this code to use this client fully")) + (stack-cache-set "auth.el" `((access-token . ,stack-auth-access-token))))) + +(provide 'stack-auth) +;;; stack-auth.el ends here diff --git a/sx-filter.el b/sx-filter.el new file mode 100644 index 0000000..6b56001 --- /dev/null +++ b/sx-filter.el @@ -0,0 +1,102 @@ +;;; stack-filter.el --- filters for stack-mode -*- 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: + +;; + +;;; Code: + + +;;; Dependencies + +(require 'stack-core) + + +;;; Customizations + +(defconst stack-filter-cache-file + "filters.el") + +(defvar stack-filter + 'default + "The current filter. +To customize the filter for the next call +to `stack-core-make-request', let-bind this variable to the +output of a call to `stack-core-compile-filter'. Be careful! If +you're going to be using this new filter a lot, create a variable +for it. Creation requests count against +`stack-core-remaining-api-requests'!") + + +;;; Compilation + +;;; TODO allow BASE to be a precompiled filter name +(defun stack-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 +or string." + (let ((keyword-arguments + `((include . ,(if include (mapconcat + #'stack-core-thing-as-string + include ";"))) + (exclude . ,(if exclude (mapconcat + #'stack-core-thing-as-string + exclude ";"))) + (base . ,(if base base))))) + (let ((response (stack-core-make-request + "filter/create" + keyword-arguments))) + (url-hexify-string + (cdr (assoc 'filter + (elt response 0))))))) + + +;;; Storage and Retrieval + +(defun stack-filter-get (filter) + "Retrieve named FILTER from `stack-filter-cache-file'." + (cdr (assoc filter (stack-cache-get stack-filter-cache-file)))) + +(defun stack-filter-store (name &optional filter) + "Store NAME as FILTER in `stack-filter-cache-file'. + +NAME should be a symbol and FILTER is a string as compiled by +`stack-filter-compile'. + +If NAME is a cons cell, (car NAME) is taken to be the actual NAME +and (cdr NAME) is taken to be the actual FILTER. In this case, +the second argument is simply ignored." + (let ((name (if (consp name) (car name) name)) + (filter (if (consp name) (cdr name) filter))) + (unless (symbolp name) + (error "Name must be a symbol: %S" name)) + (let* ((dict (stack-cache-get stack-filter-cache-file)) + (entry (assoc name dict))) + (if entry (setcdr entry filter) + (setq dict (cons (cons name filter) dict))) + + (stack-cache-set stack-filter-cache-file dict)))) + +(defun stack-filter-store-all (name-filter-alist) + (mapc #'stack-filter-store name-filter-alist)) + +(provide 'stack-filter) +;;; stack-filter.el ends here diff --git a/sx-lto.el b/sx-lto.el new file mode 100644 index 0000000..65b57b2 --- /dev/null +++ b/sx-lto.el @@ -0,0 +1,104 @@ +;;; stack-core.el --- lisp-to-org conversion functions for stack-mode -*- 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: + + +;;; Requirements +(require 'stack-core) +(require 'json) +(require 'org) + +(defun stack-lto--question (data) + "Return question DATA in a format acceptable by `org-element-interpret-data'. +DATA is a list of cons cells representing a question, as received +by the API and read by `json-read'." + `(headline (:title ,(cdr (assoc 'title data)) + :level 1 + :tags ,(mapcar #'identity (cdr (assoc 'tags data)))) + ,(stack-lto--question-answer data) + ,@(mapcar #'stack-lto--answer (cdr (assoc 'answers data))))) + +(defun stack-lto--answer (data) + "Return answer DATA in a format acceptable by `org-element-interpret-data'. +DATA is a list of cons cells representing a question, as received +by the API and read by `json-read'." + ;; Right now this doesn't do anything special. But it should check + ;; whether the answer is accepted. How do we display that? + `(headline (:title "Answer" :level 2) + ,(stack-lto--question-answer data))) + +(defun stack-lto--question-answer (data) + "Process and return the elements of DATA which questions and answers have in common." + (let ((comments + (mapcar #'stack-lto--comment (cdr (assoc 'comments data))))) + `(;; Body as a src block (really NOT nice). + (src-block (:value ,(stack-lto--body data) + . ,stack-lto--body-src-block)) + ;; Comments as descriptive lists. If there are no comments, an + ;; empty list would throw an error. + ,@(when comments `((plain-list (:type descriptive) ,comments)))))) + + +;;; Body rendering +(defvar stack-lto--body-src-block + '(:language "markdown" :switches nil :parameters nil :hiddenp nil) + "Properties used on the markdown src-block which represents the body.") + +(defface stack-lto-body + '((((background light)) :background "Grey90") + (((background dark)) :background "Grey10")) + "Face used on the body content of questions and answers." + :group 'stack-mode-faces) + +;;; This is not used ATM since we got rid of HTML. But it can be used +;;; once we start extending markdown mode. +(defcustom stack-lto-bullet (if (char-displayable-p ?•) " •" " -") + "Bullet used on the display of lists." + :type 'string + :group 'stack-mode) + +(defun stack-lto--body (data) + "Get and cleanup `body_markdown' from DATA." + (concat + (replace-regexp-in-string + "\r\n" "\n" (cdr (assoc 'body_markdown data))) + "\n")) + +;; We need to add padding in case the body contains a * at column 1 +;; (which would break org-mode). +(defvar stack-lto--padding + (propertize "  " 'display " ") + "Left-padding added to each line of a body.") + +(defvar stack-lto-comment-item + '(:bullet "- " :checkbox nil :counter nil :hiddenp nil) + "Properties used on the items which represent comments.") + +(defun stack-lto--comment (data) + "" + (let* ((owner (cdr (assoc 'owner data))) + (owner-name (cdr (assoc 'display_name owner)))) + `(item (:tag ,owner-name . ,stack-lto-comment-item) + (paragraph () ,(cdr (assoc 'body_markdown data)))))) + +(provide 'stack-lto) +;;; stack-core.el ends here diff --git a/sx-network.el b/sx-network.el new file mode 100644 index 0000000..1d3af0a --- /dev/null +++ b/sx-network.el @@ -0,0 +1,32 @@ +;;; stack-network.el --- network functions for stack-mode -*- 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: + +;; + +;;; Code: + +(require 'stack-core) + +(defun stack-network-get-networks () + (stack-core-make-request "sites")) + +(provide 'stack-network) +;;; stack-network.el ends here diff --git a/sx-question-list.el b/sx-question-list.el new file mode 100644 index 0000000..81d7cd5 --- /dev/null +++ b/sx-question-list.el @@ -0,0 +1,297 @@ +;;; stack-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: + +;;; Code: +(require 'stack-question) +(require 'tabulated-list) +(require 'cl-lib) + + +;;; Customization +(defcustom stack-question-list-height 12 + "Height, in lines, of stack-mode's *question-list* buffer." + :type 'integer + :group 'stack-question-list) + +(defface stack-question-list-parent + '((t :inherit default)) + "" + :group 'stack-question-list-faces) + +(defface stack-question-list-answers + '((((background light)) :foreground "SeaGreen4" + :height 1.0 :inherit stack-question-list-parent) + (((background dark)) :foreground "#D1FA71" + :height 1.0 :inherit stack-question-list-parent) + (t :inherit stack-question-list-parent)) + "" + :group 'stack-question-list-faces) + +(defface stack-question-list-answers-accepted + '((((background light)) :background "YellowGreen" + :inherit stack-question-list-answers) + (((background dark)) :background "DarkOliveGreen" + :inherit stack-question-list-answers) + (t :inherit stack-question-list-answers)) + "" + :group 'stack-question-list-faces) + +(defface stack-question-list-score + '((t :height 1.0 :inherit stack-question-list-parent)) + "" + :group 'stack-question-list-faces) + +(defface stack-question-list-score-upvoted + '((t :weight bold + :inherit stack-question-list-score)) + "" + :group 'stack-question-list-faces) + +(defface stack-question-list-tags + '((t :inherit font-lock-function-name-face)) + "" + :group 'stack-question-list-faces) + +(defface stack-question-list-date + '((t :inherit font-lock-comment-face)) + "" + :group 'stack-question-list-faces) + +(defface stack-question-list-read-question + '((t :height 1.0 :inherit stack-question-list-parent)) + "" + :group 'stack-question-list-faces) + +(defface stack-question-list-unread-question + '((t :weight bold :inherit stack-question-list-read-question)) + "" + :group 'stack-question-list-faces) + + +;;; Mode Definition +(define-derived-mode stack-question-list-mode tabulated-list-mode "Question List" + "Major mode for browsing a list of questions from stack-exchange. +Letters do not insert themselves; instead, they are commands. +\\ +\\{stack-question-list}" + (hl-line-mode 1) + (stack-question-list--update-mode-line) + (setq tabulated-list-format + [(" V" 3 t :right-align t) + (" A" 3 t :right-align t) + ("Title" 0 stack-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 '("Title" . nil)) + (add-hook 'tabulated-list-revert-hook + #'stack-question-list-refresh nil t) + (add-hook 'tabulated-list-revert-hook + #'stack-question-list--update-mode-line nil t) + (tabulated-list-init-header)) + +(defcustom stack-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 'stack-question-list) + +(defun stack-question-list--date-more-recent-p (x y) + "Non-nil if tabulated-entry X is newer than Y." + (stack-question--< + stack-question-list-date-sort-method + (car x) (car y) #'>)) + +(mapc + (lambda (x) (define-key stack-question-list-mode-map + (car x) (cadr x))) + '(("n" stack-question-list-next) + ("p" stack-question-list-previous) + ("j" stack-question-list-view-next) + ("k" stack-question-list-view-previous) + ("g" stack-question-list-refresh) + ([?\r] stack-question-list-display-question))) + +(defvar stack-question-list--current-page "Latest" + ;; Other values (once we implement them) are "Top Voted", + ;; "Unanswered", etc. + "Variable describing current page being viewed.") + +(defvar stack-question-list--unread-count 0 + "Holds the number of unread questions in the current buffer.") +(make-variable-buffer-local 'stack-question-list--unread-count) + +(defvar stack-question-list--total-count 0 + "Holds the total number of questions in the current buffer.") +(make-variable-buffer-local 'stack-question-list--total-count) + +(defconst stack-question-list--mode-line-format + '(" " + mode-name + " " + (:propertize stack-question-list--current-page + face mode-line-buffer-id) + " [" + "Unread: " + (:propertize + (:eval (int-to-string stack-question-list--unread-count)) + face mode-line-buffer-id) + ", " + "Total: " + (:propertize + (:eval (int-to-string stack-question-list--total-count)) + face mode-line-buffer-id) + "] ") + "Mode-line construct to use in question-list buffers.") + +(defun stack-question-list--update-mode-line () + "Fill the mode-line with useful information." + ;; All the data we need is right in the buffer. + (when (derived-mode-p 'stack-question-list-mode) + (setq mode-line-format + stack-question-list--mode-line-format) + (setq stack-question-list--total-count + (length tabulated-list-entries)))) + +(defvar stack-question-list--current-site "emacs" + "Site being displayed in the *question-list* buffer.") + +(defun stack-question-list-refresh (&optional redisplay no-update) + "Update the list of questions. +If REDISPLAY is non-nil, also call `tabulated-list-print'. +If the prefix argument NO-UPDATE is nil, query stack-exchange for +a new list before redisplaying." + (interactive "pP") + ;; Reset the mode-line unread count (we rebuild it here). + (setq stack-question-list--unread-count 0) + (let ((question-list (stack-question-get-questions + stack-question-list--current-site))) + ;; Print the result. + (setq tabulated-list-entries + (mapcar #'stack-question-list--print-info question-list))) + (when redisplay (tabulated-list-print 'remember))) + +(defcustom stack-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 'stack-question-list) + +(defun stack-question-list--print-info (data) + "Convert `json-read' DATA into tabulated-list format." + (list + data + (vector + (list (int-to-string (cdr (assoc 'score data))) + 'face + (if (cdr (assoc 'upvoted data)) 'stack-question-list-score-upvoted + 'stack-question-list-score)) + (list (int-to-string (cdr (assoc 'answer_count data))) + 'face + (if (stack-question--accepted-answer data) + 'stack-question-list-answers-accepted + 'stack-question-list-answers)) + (concat + (propertize + (cdr (assoc 'title data)) + 'face + (if (stack-question--read-p data) + 'stack-question-list-read-question + ;; Increment `stack-question-list--unread-count' for the mode-line. + (cl-incf stack-question-list--unread-count) + 'stack-question-list-unread-question)) + (propertize " " 'display "\n ") + (propertize (concat (stack--time-since (cdr (assoc 'last_activity_date data))) + stack-question-list-ago-string) + 'face 'stack-question-list-date) + (propertize (concat " [" (mapconcat #'identity (cdr (assoc 'tags data)) "] [") "]") + 'face 'stack-question-list-tags) + (propertize " " 'display "\n"))))) + +(defun stack-question-list-view-previous (n) + "Hide this question, move to previous one, display it." + (interactive "p") + (stack-question-list-view-next (- n))) + +(defun stack-question-list-view-next (n) + "Hide this question, move to next one, display it." + (interactive "p") + (stack-question-list-next n) + (stack-question-list-display-question)) + +(defun stack-question-list-next (n) + "Move to the next entry." + (interactive "p") + (forward-line n)) + +(defun stack-question-list-previous (n) + "Move to the previous entry." + (interactive "p") + (stack-question-list-next (- n))) + +(defun stack-question-list-display-question (&optional data focus) + "Display question given by DATA. +If called interactively (or with DATA being nil), display +question under point. +Also when called interactively (or when FOCUS is non-nil), also +focus the relevant window." + (interactive '(nil t)) + (unless data (setq data (tabulated-list-get-id))) + (unless data (error "No question here!")) + (when (stack-question--read-p data) + (cl-decf stack-question-list--unread-count) + (stack-question--mark-read data)) + (unless (window-live-p stack-question--window) + (setq stack-question--window + (condition-case er + (split-window-below stack-question-list-height) + (error + ;; If the window is too small to split, use current one. + (if (string-match + "Window # too small for splitting" + (car (cdr-safe er))) + nil + (error (cdr er))))))) + (stack-question--display data stack-question--window) + (when focus + (if stack-question--window + (select-window stack-question--window) + (switch-to-buffer stack-question--buffer)))) + +(defvar stack-question-list--buffer nil + "Buffer where the list of questions is displayed.") + +(defun list-questions (no-update) + "Display a list of stack-exchange questions." + (interactive "P") + (unless (buffer-live-p stack-question-list--buffer) + (setq stack-question-list--buffer + (generate-new-buffer "*question-list*"))) + (with-current-buffer stack-question-list--buffer + (stack-question-list-mode) + (stack-question-list-refresh 'redisplay no-update)) + (switch-to-buffer stack-question-list--buffer)) + +(defalias 'stack-list-questions #'list-questions) + +(provide 'stack-question-list) +;;; stack-question-list.el ends here diff --git a/sx-question.el b/sx-question.el new file mode 100644 index 0000000..80d772f --- /dev/null +++ b/sx-question.el @@ -0,0 +1,120 @@ +;;; stack-question.el --- question logic for stack-mode -*- 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: + +;; + + +;;; Code: + +(require 'stack-core) +(require 'stack-filter) +(require 'stack-lto) + +;; I don't know why this is here, but it was causing an API request on require. +(defvar stack-question-browse-filter nil + ;; (stack-filter-compile + ;; nil + ;; '(user.profile_image shallow_user.profile_image)) + ) + +;; (stack-filter-store 'question-browse stack-question-browse-filter) + +(defun stack-question-get-questions (site &optional page) + "Get the page PAGE of questions from SITE." + (stack-core-make-request + "questions" + `((site . ,site) + (page . ,page)) + stack-question-browse-filter)) + + +;;; Question Properties +(defun stack-question--read-p (question) + "Non-nil if QUESTION has been read since last updated." + ;; @TODO: + (cl-evenp (random))) + +(defun stack-question--accepted-answer (question) + "Return accepted answer in QUESTION, or nil if none." + ;; @TODO: + (cl-evenp (random))) + +(defun stack-question--mark-read (question) + "Mark QUESTION as being read, until it is updated again." + nil) + +(defun stack-question--< (property x y &optional pred) + "Non-nil if PROPERTY attribute of question X is less than that of Y. +With optional argument predicate, use it instead of `<'." + (funcall (or pred #'<) + (cdr (assoc property x)) + (cdr (assoc property y)))) + +;;; Displaying a question +(defvar stack-question--window nil + "Window where the content of questions is displayed.") + +(defvar stack-question--buffer nil + "Buffer being used to display questions.") + +(defcustom stack-question-use-html t + "If nil, markdown is used for the body." + :type 'boolean + :group 'stack-question) + +(defun stack-question--display (data &optional window) + "Display question given by DATA on WINDOW. +If WINDOW is nil, use selected one." + (let ((stack-lto--body-src-block + (if stack-question-use-html nil + stack-lto--body-src-block)) + (inhibit-read-only t)) + (with-current-buffer + (stack-question--display-buffer window) + (erase-buffer) + (insert + (org-element-interpret-data + (stack-lto--question data))) + (org-mode) + (show-all) + (view-mode) + (current-buffer)))) + +(defun stack-question--display-buffer (window) + "Display and return the buffer used for displaying a question. +Create the buffer if necessary. +If WINDOW is given, use that to display the buffer." + ;; Create the buffer if necessary. + (unless (buffer-live-p stack-question--buffer) + (setq stack-question--buffer + (generate-new-buffer "*stack-question*"))) + (cond + ;; Window was given, use it. + ((window-live-p window) + (set-window-buffer window stack-question--buffer)) + ;; No window, but the buffer is already being displayed somewhere. + ((get-buffer-window stack-question--buffer 'visible)) + ;; Neither, so we create the window. + (t (switch-to-buffer stack-question--buffer))) + stack-question--buffer) + +(provide 'stack-question) +;;; stack-question.el ends here diff --git a/sx.el b/sx.el new file mode 100644 index 0000000..05a50fb --- /dev/null +++ b/sx.el @@ -0,0 +1,367 @@ +;;; stack-core.el --- core functions for stack-mode -*- 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 defines basic commands used by all other parts of +;; StackMode. Currently, there are sections that are pretty wildly +;; different from each other (e.g. `Filters' and `Questions'. These +;; will eventually be migrated to their own files with related functions +;; of their ilk -- for now, it is more convenient to keep them handy. + +;;; Code: + + +;;; Requirements +(require 'json) +(require 'url) +(require 'time-date) + + +;;; Package Logging + +(defun stack-message (format-string &rest args) + "Display a message" + (message "[stack] %s" (apply #'format format-string args))) + + +;;; Constants and Customizable Options + +(defcustom stack-cache-directory + (expand-file-name ".stackmode" user-emacs-directory) + "Directory containined cached files and precompiled filters.") + +(defconst stack-core-api-version + "2.2" + "The current version of the API.") + +(defconst stack-core-api-root + (format "http://api.stackexchange.com/%s/" stack-core-api-version) + "The base URL to make requests from.") + +(defvar stack-core-api-batch-request-separator + ";" + "The separator character to use when making batch requests. + +Do not change this unless you know what you are doing!") + +(defconst stack-core-api-key + "0TE6s1tveCpP9K5r5JNDNQ((" + "When passed, this key provides a higher request quota.") + +(defcustom stack-core-default-keyword-arguments-alist + '(("filters/create") + ("sites") + ("questions" (site . emacs)) + (t nil)) + "Keywords to use as the default for a given method. + +The first element of each list is the method call the keywords +apply to. The remaining cons cells (and they must be conses) are +the values for each keyword. + +For each list, if no keywords are provided, the method's +arguments are forced to the default as determined by the API. + +For each cons cell, if the cdr is `nil', then the keyword will be +forced to the default as determined by the API. + +See `stack-core-get-default-keyword-arguments' and +`stack-core-build-keyword-arguments'. +") + +(defcustom stack-core-cache-requests + t + "Cache requests made to the StackExchange API.") + +(defcustom stack-core-unzip-program + "gunzip" + "program used to unzip the response") + +(defvar stack-core-remaining-api-requests + nil + "The number of API requests remaining according to the most +recent call. Set by `stack-core-make-request'.") + +(defcustom stack-core-remaining-api-requests-message-threshold + 50 + "After `stack-core-remaining-api-requests' drops below this +number, `stack-core-make-request' will begin printing out the +number of requests left every time it finishes a call.") + +(defcustom stack-core-silent-requests + t + "When `t', requests default to being silent.") + + +;;; Keyword Arguments + +(defun stack-core-thing-as-string (thing) + "Return a string representation of THING. If THING is already +a string, just return it." + (cond + ((stringp thing) thing) + ((symbolp thing) (symbol-name thing)) + ((numberp thing) (number-to-string thing)) + ((sequencep thing) + (mapconcat #'stack-core-thing-as-string + thing stack-core-api-batch-request-separator)))) + +(defun stack-core-get-default-keyword-arguments (method) + "Gets the correct keyword arguments for METHOD." + (let ((entry (assoc method stack-core-default-keyword-arguments-alist))) + (cdr (or entry (assoc t stack-core-default-keyword-arguments-alist))))) + +;;; @todo stack-core-change-default-keyword-arguments +;;; (method new-keyword-arguments) +;;; @todo stack-core-change-default-keyword-arguments-for-key +;;; (method key new-value) + +(defun stack-core-build-keyword-arguments (alist) + "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 +`stack-core-thing-as-string'." + (mapconcat + (lambda (pair) + (concat + (stack-core-thing-as-string (car pair)) + "=" + (stack-core-thing-as-string (cdr pair)))) + (delq nil (mapcar + (lambda (pair) + (when (cdr pair) pair)) + alist)) + "&")) + + +;;; Making Requests of StackExchange + +(defun stack-core-build-request (method keyword-arguments) + "Build the request string that will be used to process REQUEST +with the given KEYWORD-ARGUMENTS." + (let ((base (concat stack-core-api-root method)) + (args (stack-core-build-keyword-arguments keyword-arguments))) + (if (string-equal "" args) + base + (concat base "?" args)))) + +(defun stack-core-make-request + (method &optional keyword-arguments filter silent) + "Make a request to the StackExchange API using METHOD and +optional KEYWORD-ARGUMENTS. If no KEYWORD-ARGUMENTS are given, +`stack-core-default-keyword-arguments-alist' is used. Return the +entire response as a complex alist." + (let ((url-automatic-caching stack-core-cache-requests) + (url-inhibit-uncompression t) + (silent (or silent stack-core-silent-requests)) + (call + (stack-core-build-request + method + (append `((filter . ,(cond (filter filter) + ((boundp 'stack-filter) stack-filter))) + (key . ,stack-core-api-key)) + (if keyword-arguments keyword-arguments + (stack-core-get-default-keyword-arguments method)))))) + ;; TODO: url-retrieve-synchronously can return nil if the call is + ;; unsuccessful should handle this case + (unless silent (stack-message "Request: %S" call)) + (let ((response-buffer (cond + ((= emacs-minor-version 4) + (url-retrieve-synchronously call silent)) + (t (url-retrieve-synchronously call))))) + (if (not response-buffer) + (error "Something went wrong in `url-retrieve-synchronously'") + (with-current-buffer response-buffer + (let* ((data (progn + (goto-char (point-min)) + (if (not (search-forward "\n\n" nil t)) + (error "Response headers missing") + (delete-region (point-min) (point)) + (buffer-string)))) + (response (ignore-errors + (json-read-from-string data)))) + ;; if response isn't nil, the response was in plain text + (unless response + ;; try to decompress the response + (setq response + (with-demoted-errors "JSON Error: %s" + (shell-command-on-region + (point-min) (point-max) + stack-core-unzip-program + nil t) + (json-read-from-string + (buffer-substring + (point-min) (point-max))))) + ;; If it still fails, error out + (unless response + (stack-message "Unable to parse response") + (stack-message "Printing response as message") + (message "%S" response) + (error "Response could not be read by json-read-string"))) + ;; At this point, either response is a valid data structure + ;; or we have already thrown an error + (when (assoc 'error_id response) + (error "Request failed: (%s) [%i %s] %s" + method + (cdr (assoc 'error_id response)) + (cdr (assoc 'error_name response)) + (cdr (assoc 'error_message response)))) + (when (< (setq stack-core-remaining-api-requests + (cdr (assoc 'quota_remaining response))) + stack-core-remaining-api-requests-message-threshold) + (stack-message "%d API requests remaining" + stack-core-remaining-api-requests)) + (cdr (assoc 'items response)))))))) + +(defun stack-core-filter-data (data desired-tree) + "Filters DATA and returns the DESIRED-TREE" + (if (vectorp data) + (apply #'vector + (mapcar (lambda (entry) + (stack-core-filter-data + entry desired-tree)) + data)) + (delq + nil + (mapcar (lambda (cons-cell) + ;; TODO the resolution of `f' is O(2n) in the worst + ;; case. It may be faster to implement the same + ;; functionality as a `while' loop to stop looking the + ;; list once it has found a match. Do speed tests. + ;; See edfab4443ec3d376c31a38bef12d305838d3fa2e. + (let ((f (or (memq (car cons-cell) desired-tree) + (assoc (car cons-cell) desired-tree)))) + (when f + (if (and (sequencep (cdr cons-cell)) + (sequencep (elt (cdr cons-cell) 0))) + (cons (car cons-cell) + (stack-core-filter-data + (cdr cons-cell) (cdr f))) + cons-cell)))) + data)))) + +(defun stack-cache-get-file-name (filename) + "Expands FILENAME in the context of `stack-cache-directory'." + (expand-file-name filename stack-cache-directory)) + +(defun stack-cache-get (cache) + "Return the data within CACHE. + +As with `stack-cache-set', CACHE is a file name within the +context of `stack-cache-directory'." + (unless (file-exists-p stack-cache-directory) + (mkdir stack-cache-directory)) + (let ((file (stack-cache-get-file-name cache))) + (when (file-exists-p file) + (with-temp-buffer + (insert-file-contents (stack-cache-get-file-name cache)) + (read (buffer-string)))))) + +(defun stack-cache-set (cache data) + "Set the content of CACHE to DATA. + +As with `stack-cache-get', CACHE is a file name within the +context of `stack-cache-directory'. + +DATA will be written as returned by `prin1'." + (unless (file-exists-p stack-cache-directory) + (mkdir stack-cache-directory)) + (write-region (prin1-to-string data) nil + (stack-cache-get-file-name cache)) + data) + +(defvar stack-core--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. + '((100 "s" 1) + (6000 "m" 60.0) + (108000 "h" 3600.0) + (34560000 "d" 86400.0) + (nil "y" 31557600.0)) + "Auxiliary variable used by `stack--time-since'.") + +(defun stack--time-since (time) + "Convert the time interval since TIME (in seconds) to a short string." + (let ((delay (- (time-to-seconds) time))) + (concat + (if (> 0 delay) "-" "") + (if (= 0 delay) "0s" + (setq delay (abs delay)) + (let ((sts stack-core--seconds-to-string) here) + (while (and (car (setq here (pop sts))) + (<= (car here) delay))) + (concat (format "%.0f" (/ delay (car (cddr here)))) + (cadr here))))))) + +(defcustom stack-core-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 to replace when displaying question titles and other text." + :type '(repeat (choice symbol string)) + :group 'stack-core) + +(defun stack-core--decode-entities (string) + (let* ((plist stack-core-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 ' + (format "%c" (string-to-int + (substring ss 1)))))))) + (replace-regexp-in-string "&[^; ]*;" get-function string))) + +(provide 'stack-core) +;;; stack-core.el ends here -- cgit v1.2.3