diff options
| -rw-r--r-- | bot/sx-bot.el | 31 | ||||
| -rwxr-xr-x | bot/sx-bot.sh | 20 | ||||
| -rw-r--r-- | sx-auth.el | 2 | ||||
| -rw-r--r-- | sx-button.el | 6 | ||||
| -rw-r--r-- | sx-filter.el | 4 | ||||
| -rw-r--r-- | sx-interaction.el | 14 | ||||
| -rw-r--r-- | sx-question-mode.el | 1 | ||||
| -rw-r--r-- | sx-question-print.el | 129 | ||||
| -rw-r--r-- | sx-request.el | 30 | ||||
| -rw-r--r-- | sx-search.el | 4 | ||||
| -rw-r--r-- | sx-tab.el | 55 |
11 files changed, 169 insertions, 127 deletions
diff --git a/bot/sx-bot.el b/bot/sx-bot.el index b32a69c..1a8bceb 100644 --- a/bot/sx-bot.el +++ b/bot/sx-bot.el @@ -48,12 +48,11 @@ File is savedd in `sx-bot-out-dir'." (with-temp-file file-name (let* (print-length (repr (prin1-to-string - (sort (cdr data) - #'string-lessp)))) + (sort (cdr data) #'string-lessp)))) (insert repr "\n") (goto-char (point-min)) (while (search-forward "\" \"" nil t) - (replace-match "\"\n \"" nil t)))) + (replace-match "\"\n\"" nil t)))) (message "Wrote %S" file-name) file-name)) @@ -61,19 +60,27 @@ File is savedd in `sx-bot-out-dir'." "Get a list of all tags of all sites and save to disk." (make-directory sx-bot-out-dir t) (let* ((url-show-status nil) - (site-tokens (sx-site-get-api-tokens)) + (site-tokens (mapcar (lambda (site) ;Fix bad sites + (pcase site + ("metamunitybuilding" "meta.communitybuilding") + ((or "gamification" "meta.gamification") nil) + (_ site))) + (sx-site-get-api-tokens))) (number-of-sites (length site-tokens)) (current-site-number 0) - (sx-request-all-items-delay 0.25)) + (sx-request-remaining-api-requests-message-threshold 4000) + (sx-request-all-items-delay 0)) (mapcar (lambda (site) - (message "[%d/%d] Working on %S" - (cl-incf current-site-number) - number-of-sites - site) - (sx-bot-write-to-file - (cons (concat site ".el") - (sx-tag--get-all site)))) + (when site + (message "[%d/%d] Working on %S" + (cl-incf current-site-number) + number-of-sites + site) + (with-demoted-errors (concat "Failed to get " site ": %S") + (sx-bot-write-to-file + (cons (concat site ".el") + (sx-tag--get-all site)))))) site-tokens))) diff --git a/bot/sx-bot.sh b/bot/sx-bot.sh index 22c7284..32f6123 100755 --- a/bot/sx-bot.sh +++ b/bot/sx-bot.sh @@ -1,6 +1,9 @@ -#!/usr/bin/bash +#!/usr/bin/env bash + +[[ -z "$EMACS" ]] && EMACS="emacs"; DESTINATION_BRANCH=data +CURRENT_BRANCH=$(git rev-parse --abbrev-ref HEAD) function notify-done { local title @@ -20,17 +23,20 @@ function notify-done { } function generate-tags { - emacs -Q --batch \ - -L "./" -L "./bot/" -l sx-bot \ - -f sx-bot-fetch-and-write-tags - ret = $? + $EMACS -Q --batch \ + -L "./" -L "./bot/" -l sx-bot \ + -f sx-bot-fetch-and-write-tags + ret=$? notify-done return ${ret} } -git branch ${DESTINATION_BRANCH} && +git checkout ${DESTINATION_BRANCH} && git pull && generate-tags && git stage data/ && git commit -m "Update tag data" && - echo 'Ready for "git push"' + git push && + echo 'Bot finished.' + +git checkout ${CURRENT_BRANCH} @@ -35,7 +35,7 @@ (defconst sx-auth-root "https://stackexchange.com/oauth/dialog") (defconst sx-auth-redirect-uri - "http://vermiculus.github.io/sx.el/auth/auth.htm") + "http://seanallred.com/sx.el/auth/auth.htm") (defconst sx-auth-client-id "3291") (defvar sx-auth-access-token diff --git a/sx-button.el b/sx-button.el index 05ebadb..a4fcb76 100644 --- a/sx-button.el +++ b/sx-button.el @@ -45,6 +45,12 @@ (require 'sx) (require 'sx-question) +(declare-function sx-accept "sx-interaction") +(declare-function sx-answer "sx-interaction") +(declare-function sx-comment "sx-interaction") +(declare-function sx-open-link "sx-interaction") +(declare-function sx-question-mode-hide-show-section "sx-question-mode") + ;;; Face (defface sx-custom-button diff --git a/sx-filter.el b/sx-filter.el index 5848e34..31e0470 100644 --- a/sx-filter.el +++ b/sx-filter.el @@ -36,7 +36,7 @@ ;;; Customizations (defvar sx--filter-alist - (sx-cache-get 'filter) + nil "An alist of known filters. See `sx-filter-compile'. Structure: @@ -96,6 +96,8 @@ be returned. Otherwise, compile INCLUDE, EXCLUDE, and BASE into a filter with `sx-filter-compile' and push the association onto `sx--filter-alist'. Re-cache the alist with `sx-cache-set' and return the compiled filter." + (unless sx--filter-alist + (setq sx--filter-alist (sx-cache-get 'filter))) (or (cdr (assoc (list include exclude base) sx--filter-alist)) (let ((filter (sx-filter-compile include exclude base))) (when filter diff --git a/sx-interaction.el b/sx-interaction.el index ec11710..5d1039e 100644 --- a/sx-interaction.el +++ b/sx-interaction.el @@ -215,9 +215,21 @@ Element can be a question, answer, or comment." (sx-display-question (sx-question-get-question .site_par .id) 'focus)) (t (error "Don't know how to open this link, please file a bug report: %s" - link) + link) nil)))))) +;;;###autoload +(defun sx-org-get-link () + "Add a link to this post to Org's memory." + (when (memq major-mode '(sx-question-mode sx-question-list-mode)) + (sx-assoc-let (sx--data-here) + (when .link + (org-store-link-props :type 'http + :link .link + :description .title))))) +(eval-after-load "org" + '(add-to-list 'org-store-link-functions #'sx-org-get-link)) + ;;; Displaying (defun sx-display (&optional data) diff --git a/sx-question-mode.el b/sx-question-mode.el index 9276381..4263f6e 100644 --- a/sx-question-mode.el +++ b/sx-question-mode.el @@ -243,6 +243,7 @@ on the current buffer use \\{sx-question-mode}" (setq header-line-format sx-question-mode--header-line) (setq mode-line-format sx-question-mode--mode-line) + (buffer-disable-undo (current-buffer)) (set (make-local-variable 'nobreak-char-display) nil) ;; Determine how to close this window. (unless (window-parameter nil 'quit-restore) diff --git a/sx-question-print.el b/sx-question-print.el index 5b5ef4f..6599532 100644 --- a/sx-question-print.el +++ b/sx-question-print.el @@ -185,10 +185,10 @@ replaced with the comment." ("Newer" . sx-answer-newer-p) ("More active" . sx-answer-more-active-p)))) (append (mapcar (lambda (x) (cons (concat (car x) " first") (cdr x))) - methods) + methods) (mapcar (lambda (x) (cons (concat (car x) " last") - (sx--invert-predicate (cdr x)))) - methods)))) + (sx--invert-predicate (cdr x)))) + methods)))) (defcustom sx-question-mode-answer-sort-function #'sx-answer-higher-score-p @@ -196,12 +196,10 @@ replaced with the comment." :type (cons 'choice (mapcar (lambda (x) `(const :tag ,(car x) ,(cdr x))) - sx-question-mode--sort-methods)) + sx-question-mode--sort-methods)) :group 'sx-question-mode) -(defcustom sx-question-mode-use-images - (eval-when-compile - (image-type-available-p 'imagemagick)) +(defcustom sx-question-mode-use-images (image-type-available-p 'imagemagick) "Non-nil if SX should download and display images. By default, this is `t' if the `imagemagick' image type is available (checked with `image-type-available-p'). If this image @@ -237,9 +235,9 @@ QUESTION must be a data structure returned by `json-read'." (sx-question-mode--print-close-reason .closed_reason .closed_date .closed_details)) (sx-question-mode--print-section question) (mapc #'sx-question-mode--print-section - (cl-remove-if - #'sx--deleted-p - (cl-sort .answers sx-question-mode-answer-sort-function)))) + (cl-remove-if + #'sx--deleted-p + (cl-sort .answers sx-question-mode-answer-sort-function)))) (insert "\n\n ") (insert-text-button "Write an Answer" :type 'sx-button-answer) ;; Go up @@ -255,9 +253,9 @@ DETAILS, when given is an alist further describing the close." (let-alist details (insert "\n " (propertize (format " %s as %s, %s ago. " - (if .on_hold "Put on hold" "Closed") - reason - (sx-time-since date)) + (if .on_hold "Put on hold" "Closed") + reason + (sx-time-since date)) 'face 'sx-question-mode-closed) "\n") (when .description @@ -321,8 +319,8 @@ DATA can represent a question or an answer." (sx-time-seconds-to-date .creation_date) (when .last_edit_date (format sx-question-mode-last-edit-format - (sx-time-since .last_edit_date) - (sx-user--format "%d" .last_editor)))) + (sx-time-since .last_edit_date) + (sx-user--format "%d" .last_editor)))) 'sx-question-mode-date) ;; Score and upvoted/downvoted status. @@ -393,18 +391,18 @@ The comment is indented, filled, and then printed according to " ")) (insert (format sx-question-mode-comments-format - (sx-user--format "%d" .owner) - (substring - ;; We use temp buffer, so that image overlays don't get - ;; inserted with the comment. - (with-temp-buffer - ;; We fill with three spaces at the start, so the comment is - ;; slightly indented. - (sx-question-mode--insert-markdown (concat " " (sx--squash-whitespace .body_markdown))) - (buffer-string)) - ;; Then we remove the spaces from the first line, since we'll - ;; add the username there anyway. - 3)))))) + (sx-user--format "%d" .owner) + (substring + ;; We use temp buffer, so that image overlays don't get + ;; inserted with the comment. + (with-temp-buffer + ;; We fill with three spaces at the start, so the comment is + ;; slightly indented. + (sx-question-mode--insert-markdown (concat " " (sx--squash-whitespace .body_markdown))) + (buffer-string)) + ;; Then we remove the spaces from the first line, since we'll + ;; add the username there anyway. + 3)))))) (defun sx-question-mode--insert-header (&rest args) "Insert propertized ARGS. @@ -506,6 +504,10 @@ font-locks code-blocks according to mode." (goto-char end))))) (goto-char (point-max))))) +(defconst sx-question-mode-hr + (propertize (make-string 72 ?―) + 'face 'markdown-header-rule-face)) + (defun sx-question-mode--insert-markdown (text) "Return TEXT fontified according to `markdown-mode'." (let ((beg (point))) @@ -535,7 +537,8 @@ font-locks code-blocks according to mode." `((,(rx (or blank line-start) (group-n 1 (and "@" (1+ (not space)))) symbol-end) - 1 font-lock-builtin-face))) + 1 font-lock-builtin-face) + ("^---+$" 0 '(face nil display ,sx-question-mode-hr)))) ;; Everything. (font-lock-fontify-region (point-min) (point-max)) (replace-regexp-in-string "[[:blank:]]+\\'" "" (buffer-string)))) @@ -573,6 +576,21 @@ This can be inline Markdown code or a Markdown code-block." (save-excursion (sx-question-mode--skip-and-fontify-pre 'dont-fontify))))) +(defun sx-question-mode--standalone-tag-p (string) + "Return non-nil if STRING ends in \"/>\"." + (string-match "/[[:blank:]]*>\\'" string)) + +(defun sx-question-mode--next-tag (tag &optional closing end) + "Move point to the next occurrence of html TAG, or return nil. +Don't move past END. +If CLOSING is non-nil, find a closing tag." + (search-forward-regexp + (format sx-question-mode--html-tag-regexp + (if closing + (concat "/[[:blank:]]*" tag) + tag)) + end 'noerror)) + (defun sx-question-mode--process-html-tags (beg end-marker) "Hide all html tags between BEG and END and possibly interpret them. END-MARKER should be a marker." @@ -580,17 +598,20 @@ END-MARKER should be a marker." ;; nested in itself (e.g., <kbd><kbd></kbd></kbd>). (set-marker-insertion-type end-marker t) (goto-char beg) - (while (search-forward-regexp - (format sx-question-mode--html-tag-regexp "[[:alpha:]]+") - end-marker 'noerror) + (while (sx-question-mode--next-tag "[[:alpha:]]+" nil end-marker) (unless (sx-question-mode--inside-code-p) (let ((tag (match-string 1)) + (full (match-string 0)) (l (match-beginning 0))) (replace-match "") - (when (search-forward-regexp - (format sx-question-mode--html-tag-regexp (concat "/" tag)) - ;; Searching for a match has no bounds. - end-marker 'noerror) + (pcase tag + (`"hr" + (unless (looking-at-p "^") (insert "\n")) + (insert (propertize "---" 'display sx-question-mode-hr)) + (unless (eq (char-after) ?\n) (insert "\n"))) + (`"br" (insert "\n "))) + (when (and (not (sx-question-mode--standalone-tag-p full)) + (sx-question-mode--next-tag tag 'closing)) (let ((r (copy-marker (match-beginning 0)))) ;; The code tag is special, because it quotes everything inside. (if (string= tag "code") @@ -599,18 +620,18 @@ END-MARKER should be a marker." (replace-match "") ;; Handle stuff between the two tags. (save-match-data (sx-question-mode--process-html-tags l r)) - (cond - ((string= tag "kbd") - (add-text-properties l r '(face sx-question-mode-kbd-tag)) - (when (looking-at-p - (format sx-question-mode--html-tag-regexp "kbd")) - (insert " "))) - ((string= tag "sub") - (add-text-properties - l r '(face sx-question-mode-sub-sup-tag display (raise -0.3)))) - ((string= tag "sup") - (add-text-properties - l r '(face sx-question-mode-sub-sup-tag display (raise +0.3)))))))))))) + (pcase tag + (`"kbd" + (add-text-properties l r '(face sx-question-mode-kbd-tag)) + (when (looking-at-p + (format sx-question-mode--html-tag-regexp "kbd")) + (insert " "))) + (`"sub" + (add-text-properties + l r '(face sx-question-mode-sub-sup-tag display (raise -0.3)))) + (`"sup" + (add-text-properties + l r '(face sx-question-mode-sub-sup-tag display (raise +0.3)))))))))))) ;;; Handling links @@ -693,11 +714,11 @@ URL is used as 'help-echo and 'url properties." ;; Mouse-over 'help-echo (format sx-button--link-help-echo - ;; If TEXT is a shortened url, we don't shorten URL. - (propertize (if (and (stringp text) - (string-match "^https?:" text)) - url (sx--shorten-url url)) - 'face 'font-lock-function-name-face)) + ;; If TEXT is a shortened url, we don't shorten URL. + (propertize (if (and (stringp text) + (string-match "^https?:" text)) + url (sx--shorten-url url)) + 'face 'font-lock-function-name-face)) ;; For visiting and stuff. 'sx-button-url url 'sx-button-copy url @@ -715,7 +736,7 @@ If ID is nil, use FALLBACK-ID instead." (goto-char (point-min)) (when (search-forward-regexp (format sx-question-mode--reference-regexp - (or id fallback-id)) + (or id fallback-id)) nil t) (match-string-no-properties 1))))) @@ -751,6 +772,8 @@ move point, don't create the code-block button." (let ((beg (line-beginning-position))) ;; To identify code-blocks we need to be at start of line. (goto-char beg) + (when (fboundp 'markdown-syntax-propertize) + (markdown-syntax-propertize (point) (point-max))) (when (markdown-match-pre-blocks (line-end-position)) (unless dont-fontify (sx-babel--make-pre-button beg (point))) diff --git a/sx-request.el b/sx-request.el index 4914705..10bec4a 100644 --- a/sx-request.el +++ b/sx-request.el @@ -92,13 +92,27 @@ number of requests left every time it finishes a call." :group 'sx :type 'integer) -(defvar sx-request-all-items-delay - 1 +(defvar sx-request-all-items-delay 0 "Delay in seconds with each `sx-request-all-items' iteration. It is good to use a reasonable delay to avoid rate-limiting.") ;;; Making Requests +(defvar sx--backoff-time nil) + +(defun sx-request--wait-while-backoff () + (when sx--backoff-time + (message "Waiting for backoff time: %s" sx--backoff-time) + (let ((time (cadr (current-time)))) + (if (> (- sx--backoff-time time) 1000) + ;; If backoff-time is more than 1000 seconds in the future, + ;; we've likely just looped around the "least significant" + ;; bits of `current-time'. + (setq sx--backoff-time time) + (when (< time sx--backoff-time) + (message "Backoff detected, waiting %s seconds" (- sx--backoff-time time)) + (sleep-for (+ 0.3 (- sx--backoff-time time)))))))) + (defun sx-request-all-items (method &optional args request-method stop-when) "Call METHOD with ARGS until there are no more items. @@ -120,10 +134,10 @@ access the response wrapper." (sx-request-make method `((page . ,current-page) ,@args) request-method process-function))) (while (not (funcall stop-when response)) - (setq current-page (1+ current-page) - return-value - (nconc return-value - (cdr (assoc 'items response)))) + (let-alist response + (setq current-page (1+ current-page) + return-value + (nconc return-value .items))) (sleep-for sx-request-all-items-delay) (setq response (sx-request-make method `((page . ,current-page) ,@args) @@ -156,6 +170,7 @@ then read with `json-read-from-string'. `sx-request-remaining-api-requests' is updated appropriately and the main content of the response is returned." (declare (indent 1)) + (sx-request--wait-while-backoff) (let* ((url-automatic-caching t) (url-inhibit-uncompression t) (url-request-data (sx-request--build-keyword-arguments args nil)) @@ -202,6 +217,9 @@ the main content of the response is returned." (when .error_id (error "Request failed: (%s) [%i %s] %S" .method .error_id .error_name .error_message)) + (when .backoff + (message "Backoff received %s" .backoff) + (setq sx--backoff-time (+ (cadr (current-time)) .backoff))) (when (< (setq sx-request-remaining-api-requests .quota_remaining) sx-request-remaining-api-requests-message-threshold) (sx-message "%d API requests remaining" diff --git a/sx-search.el b/sx-search.el index 4e6c4f2..885cb53 100644 --- a/sx-search.el +++ b/sx-search.el @@ -54,9 +54,9 @@ Either QUERY or TAGS must be non-nil, or the search will fail. EXCLUDED-TAGS is only is used if TAGS is also provided. KEYWORDS is passed to `sx-method-call'." - (sx-method-call 'search + (sx-method-call 'search/advanced :keywords `((page . ,page) - (intitle . ,query) + (q . ,query) (tagged . ,tags) (nottagged . ,excluded-tags) ,@keywords) @@ -149,42 +149,27 @@ variables, but before refreshing the display." (setq sx-question-list--order-methods sx-tab--order-methods)) ;;;###autoload -(autoload 'sx-tab-all-questions - (expand-file-name - "sx-tab" (when load-file-name (file-name-directory load-file-name))) - nil t) +(autoload 'sx-tab-all-questions "sx-tab" nil t) (sx-tab--define "Unanswered" (sx-question-list--make-pager 'questions 'unanswered)) ;;;###autoload -(autoload 'sx-tab-unanswered - (expand-file-name - "sx-tab" (when load-file-name (file-name-directory load-file-name))) - nil t) +(autoload 'sx-tab-unanswered "sx-tab" nil t) (sx-tab--define "Unanswered-My-Tags" (sx-question-list--make-pager 'questions 'unanswered/my-tags)) ;;;###autoload -(autoload 'sx-tab-unanswered-my-tags - (expand-file-name - "sx-tab" (when load-file-name (file-name-directory load-file-name))) - nil t) +(autoload 'sx-tab-unanswered-my-tags "sx-tab" nil t) (sx-tab--define "Featured" (sx-question-list--make-pager 'questions 'featured)) ;;;###autoload -(autoload 'sx-tab-featured - (expand-file-name - "sx-tab" (when load-file-name (file-name-directory load-file-name))) - nil t) +(autoload 'sx-tab-featured "sx-tab" nil t) (sx-tab--define "Starred" (sx-question-list--make-pager 'me 'favorites)) ;;;###autoload -(autoload 'sx-tab-starred - (expand-file-name - "sx-tab" (when load-file-name (file-name-directory load-file-name))) - nil t) +(autoload 'sx-tab-starred "sx-tab" nil t) ;;; Inter-modes navigation @@ -213,10 +198,7 @@ belongs to." (setq sx-question-list--order-methods sx-tab--order-methods)) ;;;###autoload -(autoload 'sx-tab-frontpage - (expand-file-name - "sx-tab" (when load-file-name (file-name-directory load-file-name))) - nil t) +(autoload 'sx-tab-frontpage "sx-tab" nil t) (sx-tab--define "Newest" sx-tab--basic-question-pager @@ -225,10 +207,7 @@ belongs to." (setq sx-question-list--order-methods sx-tab--order-methods)) ;;;###autoload -(autoload 'sx-tab-newest - (expand-file-name - "sx-tab" (when load-file-name (file-name-directory load-file-name))) - nil t) +(autoload 'sx-tab-newest "sx-tab" nil t) (sx-tab--define "TopVoted" sx-tab--basic-question-pager @@ -237,10 +216,7 @@ belongs to." (setq sx-question-list--order-methods sx-tab--order-methods)) ;;;###autoload -(autoload 'sx-tab-topvoted - (expand-file-name - "sx-tab" (when load-file-name (file-name-directory load-file-name))) - nil t) +(autoload 'sx-tab-topvoted "sx-tab" nil t) (sx-tab--define "Hot" sx-tab--basic-question-pager @@ -249,10 +225,7 @@ belongs to." (setq sx-question-list--order-methods sx-tab--order-methods)) ;;;###autoload -(autoload 'sx-tab-hot - (expand-file-name - "sx-tab" (when load-file-name (file-name-directory load-file-name))) - nil t) +(autoload 'sx-tab-hot "sx-tab" nil t) (sx-tab--define "Week" sx-tab--basic-question-pager @@ -261,10 +234,7 @@ belongs to." (setq sx-question-list--order-methods sx-tab--order-methods)) ;;;###autoload -(autoload 'sx-tab-week - (expand-file-name - "sx-tab" (when load-file-name (file-name-directory load-file-name))) - nil t) +(autoload 'sx-tab-week "sx-tab" nil t) (sx-tab--define "Month" sx-tab--basic-question-pager @@ -273,10 +243,7 @@ belongs to." (setq sx-question-list--order-methods sx-tab--order-methods)) ;;;###autoload -(autoload 'sx-tab-month - (expand-file-name - "sx-tab" (when load-file-name (file-name-directory load-file-name))) - nil t) +(autoload 'sx-tab-month "sx-tab" nil t) (provide 'sx-tab) ;;; sx-tab.el ends here |