diff options
Diffstat (limited to 'sx.el')
| -rw-r--r-- | sx.el | 359 |
1 files changed, 34 insertions, 325 deletions
@@ -1,4 +1,4 @@ -;;; stack-core.el --- core functions for stack-mode -*- lexical-binding: t; -*- +;;; sx.el --- core functions -*- lexical-binding: t; -*- ;; Copyright (C) 2014 Sean Allred @@ -20,99 +20,17 @@ ;;; 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. +;; StackMode. ;;; Code: ;;; Requirements -(require 'json) -(require 'url) -(require 'time-date) - - -;;; Package Logging - -(defun stack-message (format-string &rest args) +(defun sx-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) +(defun sx--thing-as-string (thing &optional sequence-sep) "Return a string representation of THING. If THING is already a string, just return it." (cond @@ -120,248 +38,39 @@ a string, just return it." ((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)) - "&")) + (mapconcat #'sx--thing-as-string + thing (if sequence-sep sequence-sep ";"))))) - -;;; 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) +(defun sx--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)) + (apply #'vector + (mapcar (lambda (entry) + (sx--filter-data + entry desired-tree)) + data)) (delq nil (mapcar (lambda (cons-cell) - ;; TODO the resolution of `f' is O(2n) in the worst - ;; case. It may be faster to implement the same - ;; functionality as a `while' loop to stop looking the - ;; list once it has found a match. Do speed tests. - ;; See edfab4443ec3d376c31a38bef12d305838d3fa2e. - (let ((f (or (memq (car cons-cell) desired-tree) - (assoc (car cons-cell) desired-tree)))) - (when f - (if (and (sequencep (cdr cons-cell)) - (sequencep (elt (cdr cons-cell) 0))) - (cons (car cons-cell) - (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 + ;; TODO the resolution of `f' is O(2n) in the worst + ;; case. It may be faster to implement the same + ;; functionality as a `while' loop to stop looking the + ;; list once it has found a match. Do speed tests. + ;; See edfab4443ec3d376c31a38bef12d305838d3fa2e. + (let ((f (or (memq (car cons-cell) desired-tree) + (assoc (car cons-cell) desired-tree)))) + (when f + (if (and (sequencep (cdr cons-cell)) + (sequencep (elt (cdr cons-cell) 0))) + (cons (car cons-cell) + (sx-filter-data + (cdr cons-cell) (cdr f))) + cons-cell)))) + data)))) + +(provide 'sx) +;;; sx.el ends here + +;; Local Variables: +;; indent-tabs-mode: nil +;; End: |