From 68087a1c87a105e3d26c77e0aaf3b95b80d5b503 Mon Sep 17 00:00:00 2001 From: Blake DeMarcy Date: Thu, 2 Mar 2017 21:01:01 -0600 Subject: [PATCH] bbj: -> bbj- --- bbj.el | 283 +++++++++++++++++++++++++++++---------------------------- 1 file changed, 142 insertions(+), 141 deletions(-) diff --git a/bbj.el b/bbj.el index 9ed2535..2056459 100644 --- a/bbj.el +++ b/bbj.el @@ -1,49 +1,49 @@ (require 'json) (require 'cl) -(defvar bbj:host "localhost") -(defvar bbj:port "7066") -(defvar bbj:width 80) +(defvar bbj-host "localhost") +(defvar bbj-port "7066") +(defvar bbj-width 80) ;; blah blah user servicable parts blah blaheiu hre ;;;;;;;;;;r;r;r;r;;;q;q;;; -(defvar bbj:old-p (eq emacs-major-version 24)) -(defvar bbj:logged-in nil) -(defvar bbj:user nil) -(defvar bbj:hash nil) +(defvar bbj-old-p (eq emacs-major-version 24)) +(defvar bbj-logged-in nil) +(defvar bbj-user nil) +(defvar bbj-hash nil) (make-variable-buffer-local - (defvar bbj:*usermap* nil)) + (defvar bbj-*usermap* nil)) (make-variable-buffer-local - (defvar bbj:buffer-type nil)) + (defvar bbj-buffer-type nil)) (make-variable-buffer-local - (defvar bbj:aux-callback #'ignore)) + (defvar bbj-aux-callback #'ignore)) (define-derived-mode bbj-mode fundamental-mode "BBJ" "Mode for browsing and posting to BBJ." :group 'bbj-mode - (local-set-key (kbd "SPC") 'bbj:next-post) - (local-set-key (kbd "j") 'bbj:next-post) - (local-set-key (kbd "n") 'bbj:next-post) - (local-set-key (kbd "") 'bbj:next-post) + (local-set-key (kbd "SPC") 'bbj-next-post) + (local-set-key (kbd "j") 'bbj-next-post) + (local-set-key (kbd "n") 'bbj-next-post) + (local-set-key (kbd "") 'bbj-next-post) - (local-set-key (kbd "DEL") 'bbj:prev-post) - (local-set-key (kbd "k") 'bbj:prev-post) - (local-set-key (kbd "p") 'bbj:prev-post) - (local-set-key (kbd "") 'bbj:prev-post) + (local-set-key (kbd "DEL") 'bbj-prev-post) + (local-set-key (kbd "k") 'bbj-prev-post) + (local-set-key (kbd "p") 'bbj-prev-post) + (local-set-key (kbd "") 'bbj-prev-post) - (local-set-key (kbd "RET") 'bbj:enter) - (local-set-key (kbd "l") 'bbj:enter) - (local-set-key (kbd "o") 'bbj:enter) - (local-set-key (kbd "") 'bbj:enter) + (local-set-key (kbd "RET") 'bbj-enter) + (local-set-key (kbd "l") 'bbj-enter) + (local-set-key (kbd "o") 'bbj-enter) + (local-set-key (kbd "") 'bbj-enter) (local-set-key (kbd "q") 'quit-window) (local-set-key (kbd "") 'quit-window) - (local-set-key (kbd "+") 'bbj:compose) - (local-set-key (kbd "c") 'bbj:compose) + (local-set-key (kbd "+") 'bbj-compose) + (local-set-key (kbd "c") 'bbj-compose) - (local-set-key (kbd "C-c C-c") 'bbj:aux) - (local-set-key (kbd "r") 'bbj:quote-current-post)) + (local-set-key (kbd "C-c C-c") 'bbj-aux) + (local-set-key (kbd "r") 'bbj-quote-current-post)) (ignore-errors (evil-set-initial-state 'bbj-mode 'emacs)) @@ -75,7 +75,7 @@ ;;;; network shit ;;;; -(defun bbj:descend (alist &rest keys) +(defun bbj-descend (alist &rest keys) "Recursively retrieve symbols from a nested alist. A required beverage for all JSON tourists." (while keys @@ -83,13 +83,13 @@ for all JSON tourists." alist) -(defun bbj:request (method &rest pairs) +(defun bbj-request (method &rest pairs) "Poke netcat to poke the server who will hopefully poke us back" ;; json-false/json-nil are bound as nil here to stop them from being silly keywords (let (json message json-false json-null (data (list - (cons 'user bbj:user) - (cons 'auth_hash bbj:hash) + (cons 'user bbj-user) + (cons 'auth_hash bbj-hash) (cons 'method method)))) ;; populate a query with our hash and username, then the func arguments (while pairs @@ -100,61 +100,61 @@ for all JSON tourists." (call-process-region (point-min) (point-max) shell-file-name t t nil ;; meow meow - "-c" (format "nc %s %s" bbj:host bbj:port)) + "-c" (format "nc %s %s" bbj-host bbj-port)) (setq json (progn (goto-char (point-min)) (json-read)))) (if (eq json t) t ;; a few enpoints just return true/false - (setq message (bbj:descend json 'error 'description)) - (case (bbj:descend json 'error 'code) + (setq message (bbj-descend json 'error 'description)) + (case (bbj-descend json 'error 'code) ;; haha epic handling ((4 5 6 7) (error message)) (otherwise json))))) -(defun bbj:sethash (&optional password) +(defun bbj-sethash (&optional password) "Either prompt for or take the arg `PASSWORD', and then sha256-hash it. Sets it globally and also returns it." (interactive) (unless password (setq password (read-from-minibuffer "(Password)> "))) - (setq bbj:hash (secure-hash 'sha256 password))) + (setq bbj-hash (secure-hash 'sha256 password))) -(defun bbj:login () +(defun bbj-login () "Prompts the user for a name and password. If it isn't registered, we'll take care of that. Jumps to the index afterward. This function only needs to be used once per emacs session." (interactive) - (setq bbj:user (read-from-minibuffer "(BBJ Username)> ")) + (setq bbj-user (read-from-minibuffer "(BBJ Username)> ")) (cond - ((bbj:request "is_registered" 'target_user bbj:user) - (bbj:sethash) - (if (bbj:request "check_auth") + ((bbj-request "is_registered" 'target_user bbj-user) + (bbj-sethash) + (if (bbj-request "check_auth") (progn - (setq bbj:logged-in t) - (bbj:browse-index) - (message "Logged in as %s!" bbj:user)) + (setq bbj-logged-in t) + (bbj-browse-index) + (message "Logged in as %s!" bbj-user)) (message "(Invalid Password!)") - (run-at-time 1 nil #'bbj:login))) - ((y-or-n-p (format "Register for BBJ as %s? " bbj:user)) - (bbj:sethash) + (run-at-time 1 nil #'bbj-login))) + ((y-or-n-p (format "Register for BBJ as %s? " bbj-user)) + (bbj-sethash) (let ((response - (bbj:request "user_register" + (bbj-request "user_register" ;; need to add some cute prompts for these 'quip "" 'bio ""))) (if (alist-get 'error response) (message "%s" (alist-get 'error response)) - (setq bbj:logged-in t) - (bbj:browse-index) - (message "Logged in as %s!" bbj:user)))))) + (setq bbj-logged-in t) + (bbj-browse-index) + (message "Logged in as %s!" bbj-user)))))) ;;;; user navigation shit. a LOT of user navigation shit. ;;;; -(defun bbj:next-pos (string &optional regex prop backward group bound) +(defun bbj-next-pos (string &optional regex prop backward group bound) ;; haha yes i ripped this from one of my other projects "Takes a STRING and returns the char position of the beginning of its next occurence from point in `current-buffer'. Returns nil if not found. -A simpler way to call this is to use `bbj:next-prop'. +A simpler way to call this is to use `bbj-next-prop'. When REGEX is non-nil, STRING is interpreted as a regular expression. @@ -186,129 +186,129 @@ BOUND can be a buffer position (integer) that the search will not exceed." (match-beginning group))))) -(defun bbj:next-prop (prop &optional backward bound) - "Like the `bbj:next-pos', but doesnt care about strings and +(defun bbj-next-prop (prop &optional backward bound) + "Like the `bbj-next-pos', but doesnt care about strings and just hunts for a specific text property." - (bbj:next-pos "." t prop backward nil bound)) + (bbj-next-pos "." t prop backward nil bound)) -(defun bbj:post-prop (prop &optional id) +(defun bbj-post-prop (prop &optional id) "retrieve PROP from the current post. needs ID-seeking support" (save-excursion - (bbj:assert-post-start) + (bbj-assert-post-start) (get-char-property (point) prop))) ;; returns positions of the next head and ending seps, respectively -(defun bbj:head-pos (&optional backward) - (bbj:next-prop 'head backward)) -(defun bbj:sep-pos (&optional backward) - (bbj:next-prop 'end backward)) +(defun bbj-head-pos (&optional backward) + (bbj-next-prop 'head backward)) +(defun bbj-sep-pos (&optional backward) + (bbj-next-prop 'end backward)) -(defun bbj:assert-post-start () +(defun bbj-assert-post-start () (unless (eql 'head (get-char-property (point) 'type)) - (goto-char (bbj:head-pos t)))) + (goto-char (bbj-head-pos t)))) -(defun bbj:point-to-post (dir &optional nocenter) +(defun bbj-point-to-post (dir &optional nocenter) "Move the cursor from the head of one post to another, in (symbol) DIR" (let ((check (case dir - (prev (bbj:head-pos t)) + (prev (bbj-head-pos t)) (next (save-excursion ;; or else point will stick (while (eq 'head (get-char-property (point) 'type)) (goto-char (next-property-change (point)))) - (bbj:head-pos)))))) + (bbj-head-pos)))))) (when check (goto-char check) (back-to-indentation) (unless nocenter (recenter 1))))) -(defun bbj:next-post () +(defun bbj-next-post () (interactive) - (bbj:point-to-post 'next)) + (bbj-point-to-post 'next)) -(defun bbj:prev-post () +(defun bbj-prev-post () (interactive) - (bbj:point-to-post 'prev)) + (bbj-point-to-post 'prev)) -(defun bbj:first-post () +(defun bbj-first-post () ;; does interactive work like this? i never checked tbh (interactive (push-mark)) - (goto-char (+ 1 bbj:width (point-min)))) + (goto-char (+ 1 bbj-width (point-min)))) -(defun bbj:aux () +(defun bbj-aux () "just some random lazy callback shitty thing for C-c C-c" (interactive) - (funcall bbj:aux-callback)) + (funcall bbj-aux-callback)) -(defun bbj:enter () +(defun bbj-enter () "Handles the RETURN key (and other similar binds) depending on content type. Currently only opens threads." (interactive) - (case bbj:buffer-type + (case bbj-buffer-type (index - (bbj:enter-thread - (alist-get 'thread_id (bbj:post-prop 'data)))))) + (bbj-enter-thread + (alist-get 'thread_id (bbj-post-prop 'data)))))) -(defun bbj:quote-current-post () +(defun bbj-quote-current-post () "Pop a composer, and insert the post number at point as a quote." (interactive) - (case bbj:buffer-type + (case bbj-buffer-type (thread - (let ((id (alist-get 'post_id (bbj:post-prop 'data)))) - (bbj:compose) + (let ((id (alist-get 'post_id (bbj-post-prop 'data)))) + (bbj-compose) (insert (format ">>%s\n\n" id)))) (index ;; recursion haha yes (let ((buffer (current-buffer))) - (bbj:enter) + (bbj-enter) (unless (equal buffer (current-buffer)) - (bbj:quote-current-post)))))) + (bbj-quote-current-post)))))) -(defun bbj:compose () +(defun bbj-compose () "Construct an appropriate callback to either create a thread or reply to one. Pops a new window; window is killed and the message is sent using C-c C-c." (interactive) - (let ((params (case bbj:buffer-type + (let ((params (case bbj-buffer-type (index `("Composing a new thread (C-c C-c to send)" (lambda () - (let* ((message (bbj:consume-window (current-buffer))) - (request (bbj:request "thread_create" + (let* ((message (bbj-consume-window (current-buffer))) + (request (bbj-request "thread_create" 'body message 'title ,(read-from-minibuffer "(Thread Title)> ") 'tags ,(read-from-minibuffer "(Comma-seperated tags, if any)> ")))) - (if (numberp (bbj:descend request 'error 'code)) + (if (numberp (bbj-descend request 'error 'code)) (message "%s" request) (message "thread submitted") - (bbj:browse-index)))))) + (bbj-browse-index)))))) (thread `("Replying to thread (C-c C-c to send)" (lambda () - (let* ((message (bbj:consume-window (current-buffer))) - (request (bbj:request "thread_reply" + (let* ((message (bbj-consume-window (current-buffer))) + (request (bbj-request "thread_reply" 'body message 'thread_id ,thread-id))) - (if (numberp (bbj:descend request 'error 'code)) + (if (numberp (bbj-descend request 'error 'code)) (message "%s" request) (message "reply submitted") - (bbj:enter-thread ,thread-id) + (bbj-enter-thread ,thread-id) (goto-char (point-max)) - (bbj:point-to-post 'prev) + (bbj-point-to-post 'prev) (recenter nil))))))))) - (apply #'bbj:compose-in-window params))) + (apply #'bbj-compose-in-window params))) -(defun bbj:compose-in-window (title callback &rest cbargs) +(defun bbj-compose-in-window (title callback &rest cbargs) "Create a new buffer, pop it, set TITLE as the header line, and assign CALLBACK to C-c C-c." (let ((buffer (get-buffer-create "*BBJ: Compose*"))) @@ -317,12 +317,12 @@ assign CALLBACK to C-c C-c." (erase-buffer) (text-mode) (use-local-map (copy-keymap text-mode-map)) - (local-set-key (kbd "C-c C-c") 'bbj:aux) + (local-set-key (kbd "C-c C-c") 'bbj-aux) (setq header-line-format title - bbj:aux-callback callback)))) + bbj-aux-callback callback)))) -(defun bbj:consume-window (buffer) +(defun bbj-consume-window (buffer) "Consume all text in the current buffer, delete the window if it is one, and kill the buffer. Returns property-free string." (interactive) @@ -333,21 +333,21 @@ it is one, and kill the buffer. Returns property-free string." content))) -(defun bbj:postprocess () +(defun bbj-postprocess () "Makes all the whitespace in and between posts consistent." - (bbj:first-post) + (bbj-first-post) (save-excursion (while (re-search-forward "\n\n\n+" nil t) (replace-match "\n\n")))) -(defun bbj:render-body (string &optional return-string notrim) +(defun bbj-render-body (string &optional return-string notrim) "takes an html STRING. If RETURN-STRING is non nil, it renders it in a temp buffer and returns the string. Otherwise, inserts and renders the content in the current buffer." - (let* ((shr-width bbj:width) + (let* ((shr-width bbj-width) (shr-external-rendering-functions - '((span . bbj:render-tag-span))) + '((span . bbj-render-tag-span))) result) (if (not return-string) (let ((start (point))) @@ -362,15 +362,15 @@ and renders the content in the current buffer." (if notrim result (string-trim result))))) -(defun bbj:timestring (epoch) +(defun bbj-timestring (epoch) "Make a cute timestring out of the epoch (for post heads)" (format-time-string "%H:%M %a %m/%d/%y" (seconds-to-time epoch))) -(defun bbj:render-post (object) +(defun bbj-render-post (object) "Render an API object into the current buffer. Can be either the parent object or any of its children." - (let* ((userdata (cdr (assoc-string (alist-get 'author object) bbj:*usermap*))) + (let* ((userdata (cdr (assoc-string (alist-get 'author object) bbj-*usermap*))) (title (alist-get 'title object)) (indicator (format ">>%s " (or title (alist-get 'post_id object))))) (insert (propertize indicator @@ -380,22 +380,22 @@ or any of its children." (insert (propertize (concat "~" (alist-get 'name userdata) " ") 'face 'font-lock-keyword-face)) - (insert (if (eq bbj:buffer-type 'index) + (insert (if (eq bbj-buffer-type 'index) (propertize (format "@ %s\n%s replies; last active %s\n" - (bbj:timestring (alist-get 'created object)) + (bbj-timestring (alist-get 'created object)) (alist-get 'reply_count object) - (bbj:timestring (alist-get 'lastmod object))) + (bbj-timestring (alist-get 'lastmod object))) 'face 'font-lock-comment-face) - (propertize (format "@ %s\n\n" (bbj:timestring (alist-get 'created object))) + (propertize (format "@ %s\n\n" (bbj-timestring (alist-get 'created object))) 'face 'font-lock-comment-face))) - (when (eq bbj:buffer-type 'thread) - (bbj:render-body (alist-get 'body object))) - (bbj:insert-sep))) + (when (eq bbj-buffer-type 'thread) + (bbj-render-body (alist-get 'body object))) + (bbj-insert-sep))) -;; (defun bbj:render-tag-span (dom) +;; (defun bbj-render-tag-span (dom) ;; "A slightly modified version of `shr-tag-span' which handles quotes and stuff." -;; (let ((class (if bbj:old-p +;; (let ((class (if bbj-old-p ;; (assq :class (cdr dom)) ;; (dom-attr dom 'class)))) ;; (dolist (sub (if (consp (car dom)) (cddr (car dom)) (cddr dom))) @@ -412,12 +412,13 @@ or any of its children." ;; (t (shr-insert sub))) ;; (shr-descend sub))))) -(defun bbj:render-tag-span (dom) - "A slightly modified version of `shr-tag-span' which handles quotes and stuff." - (let ((class (if bbj:old-p +(defun bbj-render-tag-span (dom) + "A highly bastardized version of `shr-tag-span', beaten and maimed until +it worked on emacs 24." + (let ((class (if bbj-old-p (alist-get :class dom) (dom-attr dom 'class))) - (text (if bbj:old-p + (text (if bbj-old-p (alist-get 'text dom) (car (last dom))))) (cond @@ -433,52 +434,52 @@ or any of its children." (text (shr-insert text))))) -(defun bbj:mksep () - (format "\n%s\n" (make-string bbj:width ?\-))) +(defun bbj-mksep () + (format "\n%s\n" (make-string bbj-width ?\-))) -(defun bbj:insert-sep (&optional drop-newline) - (let ((sep (bbj:mksep))) +(defun bbj-insert-sep (&optional drop-newline) + (let ((sep (bbj-mksep))) (insert (propertize (if drop-newline (subseq sep 1) sep) 'face 'font-lock-comment-face 'type 'end)))) -(defun bbj:browse-index () +(defun bbj-browse-index () (interactive) (let* ((inhibit-read-only t) (buffer (get-buffer-create "*BBJ Index*")) - (response (bbj:request "thread_index")) - (bbj:*usermap* (alist-get 'usermap response))) + (response (bbj-request "thread_index")) + (bbj-*usermap* (alist-get 'usermap response))) (with-current-buffer buffer (erase-buffer) (bbj-mode) - (setq bbj:buffer-type 'index - bbj:*usermap* (alist-get 'usermap response)) - (bbj:insert-sep t) + (setq bbj-buffer-type 'index + bbj-*usermap* (alist-get 'usermap response)) + (bbj-insert-sep t) (loop for thread across (alist-get 'threads response) do - (bbj:render-post thread)) - (bbj:postprocess)) + (bbj-render-post thread)) + (bbj-postprocess)) (switch-to-buffer buffer) (setq buffer-read-only t))) -(defun bbj:enter-thread (id) +(defun bbj-enter-thread (id) (interactive) (let* ((inhibit-read-only t) - (response (bbj:request "thread_load" 'thread_id id)) + (response (bbj-request "thread_load" 'thread_id id)) (buffer (get-buffer-create (format "BBJ: %s" (alist-get 'title response))))) (with-current-buffer buffer (erase-buffer) (bbj-mode) - (setq bbj:buffer-type 'thread - bbj:*usermap* (alist-get 'usermap response)) + (setq bbj-buffer-type 'thread + bbj-*usermap* (alist-get 'usermap response)) (setq-local thread-id id) - (bbj:insert-sep t) - (bbj:render-post response) + (bbj-insert-sep t) + (bbj-render-post response) (loop for reply across (alist-get 'replies response) do - (bbj:render-post reply)) - (bbj:postprocess)) + (bbj-render-post reply)) + (bbj-postprocess)) (switch-to-buffer buffer) (setq buffer-read-only t)))