diff --git a/README.md b/README.md index 8688b49..278af98 100644 --- a/README.md +++ b/README.md @@ -1,7 +1,29 @@ + +tumblesocks - un-break it fork +============================== + +`tumblesocks.el` old, crazy, messy, awesome, abandoned, and broken, and it depends on `emacs-oauth`, +which is much the same. each file has about 70 `flycheck` errors in it. But it also fucking rocks. + +So this repo adds patches that people have shared online for un-breaking `tumblesocks.el`. + +A patched version of ye olde `emacs-oauth` is also needed. It's here: https://codeberg.org/martianh/emacs-oauth. + +If you try these out, I'd recommend you remove all trace of any other versions. + +Further patches are most welcome. + + + +Modified README +=============== + `tumblesocks-mode` - Tumblr Support for Emacs ============================================= -![http://i.imgur.com/9wroS.png](http://i.imgur.com/9wroS.png) +This is how tumblesocks looks now: + +![https://i.ibb.co/9WYG2mB/xwd.jpg](https://i.ibb.co/9WYG2mB/xwd.jpg) Tumblesocks is an Emacs tumblr client. With it, you can write posts, check your dashboard, and view blogs and notes. @@ -34,6 +56,9 @@ Managing your posts: * **d: Delete** the post under the cursor. (This only works if you made that post.) * **e: Edit** the post under the cursor. (This only works if you made that post.) +View activity +* **a: Notifications** shows you your Notifications (likes, reblogs, milestones, replies.) `tumblesocks-view-notifications` works as well. + Installing ---------- diff --git a/tumblesocks-api.el b/tumblesocks-api.el index edd4682..0432029 100644 --- a/tumblesocks-api.el +++ b/tumblesocks-api.el @@ -1,5 +1,6 @@ ;; tumblesocks-api.el -- functions for talking with tumblr ;; Copyright (C) 2012 gcr +;; Copyright (C) 2023 gargle (require 'oauth) (require 'json) @@ -65,10 +66,10 @@ call `tumblesocks-api-reauthenticate' after this." (if (string-match "\\([^:]*\\):\\(.*\\)" (buffer-substring (point-min) (point-max))) (setq tumblesocks-token - (make-oauth-access-token + (oauth-access-token--create :consumer-key tumblesocks-consumer-key :consumer-secret tumblesocks-secret-key - :auth-t (make-oauth-t + :auth-t (oauth-t--create :token (match-string 1 str) :token-secret (match-string 2 str)))))) (kill-this-buffer))) @@ -136,7 +137,7 @@ error if the error code is not in the 200 category." tumblesocks-token (concat url "?api_key=" tumblesocks-consumer-key (mapconcat - '(lambda (x) + #'(lambda (x) (concat "&" (url-hexify-string (format "%s" (car x))) "=" (url-hexify-string (format "%s" (cdr x))))) (tumblesocks-plist-to-alist params) ""))) @@ -151,7 +152,7 @@ error if the error code is not in the 200 category." (with-current-buffer (url-retrieve-synchronously (concat url "?api_key=" tumblesocks-consumer-key (mapconcat - '(lambda (x) + #'(lambda (x) (concat "&" (url-hexify-string (format "%s" (car x))) "=" (url-hexify-string (format "%s" (cdr x))))) (tumblesocks-plist-to-alist params) ""))) @@ -168,7 +169,7 @@ error if the error code is not in the 200 category." (with-current-buffer (oauth-post-url tumblesocks-token url - (mapcar '(lambda (x) + (mapcar #'(lambda (x) (cons (format "%s" (car x)) (format "%s" (cdr x)))) (tumblesocks-plist-to-alist params))) @@ -180,8 +181,8 @@ returning JSON or signaling an error for other requests." (decode-coding-region (point-min) (point-max) 'utf-8-dos) ;; the following copied from url.el (goto-char (point-min)) - (skip-chars-forward " \t\n") ; Skip any blank crap - (skip-chars-forward "HTTP/") ; Skip HTTP Version + (skip-chars-forward " \t\n") ; Skip any blank crap + (skip-chars-forward "HTTP/") ; Skip HTTP Version (skip-chars-forward "[0-9].") (let ((pointpos (point)) (code (read (current-buffer)))) @@ -194,7 +195,9 @@ returning JSON or signaling an error for other requests." (error (buffer-substring pointpos (line-end-position)))) (t - (search-forward-regexp "^$" nil t) + ;; brute force and ignorance + (search-forward-regexp "^{" nil t) + (previous-line) ;; body (let* ((json-response (buffer-substring (1+ (point)) (point-max))) (json-object-type 'plist) @@ -258,6 +261,17 @@ returning JSON or signaling an error for other requests." (tumblesocks-api-http-oauth-post (tumblesocks-api-url "/user/unlike") `(:id ,id :reblog_key ,reblog_key))) +(defun tumblesocks-api-blog-notifications (&optional limit offset) + "Retrieve the activity items for a specific blog, in reverse chronological order, newest first" + (unless tumblesocks-blog (error "Which blog? Please set `tumblesocks-blog'")) + (let ((args (append + (and limit `(:limit ,limit)) + (and offset `(:offset ,offset))))) + (tumblesocks-api-http-oauth-get + (tumblesocks-api-url "/blog/" + tumblesocks-blog + "/notifications") args))) + (defun tumblesocks-api-blog-info () "Gather information about the blog listed in `tumblesocks-blog'." diff --git a/tumblesocks-compose.el b/tumblesocks-compose.el index e6091fe..eb3b9f2 100644 --- a/tumblesocks-compose.el +++ b/tumblesocks-compose.el @@ -8,7 +8,7 @@ ;; Tumblr compose mode ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (defvar tumblesocks-compose-finish-action - '(lambda () (call-interactively 'tumblesocks-text-post-from-buffer)) + #'(lambda () (call-interactively 'tumblesocks-text-post-from-buffer)) "The action to run when finishing posting") (defvar tumblesocks-compose-continuation nil "Optional action to run when finishing editing or posting. @@ -38,7 +38,7 @@ tumblesocks-view uses this to refresh buffers, for example.") "Major mode for composing a new Tumblr post." (make-local-variable 'tumblesocks-compose-finish-action) (setq tumblesocks-compose-finish-action - '(lambda () (call-interactively 'tumblesocks-text-post-from-buffer))) + #'(lambda () (call-interactively 'tumblesocks-text-post-from-buffer))) (make-local-variable 'tumblesocks-compose-editing-args) (make-local-variable 'tumblesocks-compose-editing-id) (make-local-variable 'tumblesocks-compose-continuation)) diff --git a/tumblesocks-pkg.el b/tumblesocks-pkg.el index 585f992..b3e61a6 100644 --- a/tumblesocks-pkg.el +++ b/tumblesocks-pkg.el @@ -1,5 +1,5 @@ -(define-package "tumblesocks" "0.0.6" +(define-package "tumblesocks" "1.1.8" "An Emacs tumblr client." - '((htmlize "1.39") - (oauth "1.0.3") - (markdown-mode "1.8.1"))) + '((htmlize "20210825.2150") + (oauth "20230706.2026") + (markdown-mode "20230830.1338"))) diff --git a/tumblesocks-user.el b/tumblesocks-user.el index b473aaf..88c6c7d 100644 --- a/tumblesocks-user.el +++ b/tumblesocks-user.el @@ -42,7 +42,7 @@ the user what to do for each post." "Blog URL to unfollow (TAB to complete): " (let ((bloglist (plist-get (tumblesocks-api-user-following) :blogs))) - (mapcar '(lambda (blog) + (mapcar #'(lambdao (blog) (plist-get blog :url)) bloglist)) nil t))) @@ -85,3 +85,6 @@ the user what to do for each post." "Create a new Tumblr markdown text post from the current buffer, returning the ID and copying the URL to the clipboard." (interactive "sTitle: \nsTags (optional, comma separated): ") (tumblesocks-text-post-from-region (point-min) (point-max) title tags)) + +(provide 'tumblesocks-user) +;;; tumblesocks-user.el ends here diff --git a/tumblesocks-view.el b/tumblesocks-view.el index 60988ea..a76fa49 100644 --- a/tumblesocks-view.el +++ b/tumblesocks-view.el @@ -1,5 +1,8 @@ ;; tumblesocks-view.el -- Provide an interface to view tumblr blog posts. +;; Copyright 2012 gcr +;; Copyright 2023 gargle + (eval-when-compile (require 'easymenu)) @@ -46,6 +49,7 @@ This causes Tumblesocks to ignore the setting of (define-key tumblesocks-view-mode-map "r" 'tumblesocks-view-reblog-post-at-point) (define-key tumblesocks-view-mode-map (kbd "RET") 'tumblesocks-view-post-at-point) (define-key tumblesocks-view-mode-map (kbd "SPC") 'forward-page) + (define-key tumblesocks-view-mode-map "a" 'tumblesocks-view-notifications) (define-key tumblesocks-view-mode-map "b" 'tumblesocks-view-blog) (define-key tumblesocks-view-mode-map "d" 'tumblesocks-view-delete-post-at-point) (define-key tumblesocks-view-mode-map "e" 'tumblesocks-view-edit-post-at-point) @@ -106,8 +110,11 @@ This causes Tumblesocks to ignore the setting of "Open the post under point in a new buffer, showing notes, etc" (interactive) (when (get-text-property (point) 'tumblesocks-post-data) - (tumblesocks-view-post - (plist-get (get-text-property (point) 'tumblesocks-post-data) :id)))) + (let ((id (plist-get (get-text-property (point) 'tumblesocks-post-data) + :id)) + (tumblesocks-blog (plist-get (get-text-property (point) 'tumblesocks-post-data) + :blog_name))) + (tumblesocks-view-post id)))) (defun tumblesocks-view-post-url-at-point () "Open the post under point in your browser" @@ -154,37 +161,41 @@ This causes Tumblesocks to ignore the setting of (tumblesocks-view-refresh) (goto-char pos)))) -(defun tumblesocks-view-edit-post-at-point () +(defun tumblesocks-view-post-at-point () + "Open the post under point in a new buffer, showing notes, etc" (interactive) - (when (yes-or-no-p "Really try to edit this post? ") - (tumblesocks-compose-edit-post - (format "%d" - (plist-get (get-text-property (point) 'tumblesocks-post-data) :id))) - '(lambda () - (let ((pos (point))) - (tumblesocks-view-refresh) - (goto-char pos))))) + (when (get-text-property (point) 'tumblesocks-post-data) + (let ((id (plist-get (get-text-property (point) 'tumblesocks-post-data) + :id)) + (tumblesocks-blog (plist-get (get-text-property (point) 'tumblesocks-post-data) + :blog_name))) + (tumblesocks-view-post id)))) (defun tumblesocks-view-reblog-post-at-point () "Reblog the post at point, if there is one." (interactive) - (when (get-text-property (point) 'tumblesocks-post-data) + (let* ((data (get-text-property (point) 'tumblesocks-post-data)) + (from-blog (plist-get data :channel-name)) + (post_id (format "%d" (plist-get data :id))) + (reblog_key (plist-get data :reblog_key))) + (when data ;; Get the reblog key. - (let* ((post_id - (format "%d" - (plist-get - (get-text-property (point) 'tumblesocks-post-data) :id))) - ;; we need to do another API fetch because - ;; tumblesocks-post-data doesn't have reblog keys, by design - (blog (tumblesocks-api-blog-posts - nil post_id nil "1" nil "true" nil "html")) - (post (car (plist-get blog :posts))) - (reblog_key (plist-get post :reblog_key))) + ;; (let* ((tumblesocks-blog from-blog) + ;; ;; we need to do another API fetch because + ;; ;; tumblesocks-post-data doesn't have reblog keys, by design + ;; (blog (tumblesocks-api-blog-posts + ;; nil post_id nil "1" nil "true" nil "html")) + ;; (post (car (plist-get blog :posts)))) + ;; (setq reblog_key (plist-get post :reblog_key))) + (tumblesocks-api-reblog-post post_id reblog_key (read-string "(Optional) comments to add: ")) (message "Reblogged.") - (tumblesocks-view-refresh)))) + (let ((pos (point))) + (tumblesocks-view-refresh) + (goto-char pos)) + ))) @@ -205,7 +216,7 @@ This causes Tumblesocks to ignore the setting of "Renders and inserts an HTML sexp. If inline is t, then

tags will have no effect." (let ((shr-width nil)) (if inline - (flet ((shr-ensure-paragraph () 0)) + (cl-flet ((shr-ensure-paragraph () 0)) ; cl-flet ;; disable newlines, for now ... (condition-case nil ;; this must go in the flet, sorry! @@ -214,6 +225,7 @@ This causes Tumblesocks to ignore the setting of (condition-case nil (shr-insert-document html-frag-parsed) (error (message "Couldn't insert HTML.")))))) + (defun tumblesocks-view-insert-html-fragment (html-fragment &optional inline) "Renders and inserts an HTML fragment. If inline is t, then

tags will have no effect." (let (html-frag-parsed) @@ -318,6 +330,8 @@ better suited to inserting each post." ;; For answer posts: asking_name asking_url question answer) (let ((begin-post-area (point))) + (insert (make-string (frame-width) ?\u2500)) + (insert "\n") (tumblesocks-view-insert-header verbose-header) (cond ((string= type "text") (tumblesocks-view-insert-text)) @@ -329,6 +343,9 @@ better suited to inserting each post." ((string= type "photo") (tumblesocks-view-insert-photo)) ((string= type "chat") (tumblesocks-view-insert-chat)) (t (tumblesocks-view-insert-i-have-no-clue-what-this-is))) + ;; Tags + (when tags + (insert (mapconcat 'identity (mapcar (lambda (tag) (format "#%s" tag)) tags) " "))) (insert "\n") ;; Record this post data so we know how to read it next (put-text-property begin-post-area (point) @@ -339,15 +356,17 @@ better suited to inserting each post." "Draw the header for the current post, optionally being verbose." (let (begin end_bname) (setq begin (point)) - (insert blog_name ":") - (setq end_bname (point)) + (insert blog_name) ;; Title - (insert " ") (cond - (title (tumblesocks-view-insert-html-fragment title t)) - (caption (tumblesocks-view-insert-html-fragment caption t)) - (question (tumblesocks-view-insert-html-fragment question t)) - (t (insert " "))) + (title (if (not (string= title "")) + (insert " : " title)))) + (setq end_bname (point)) + (put-text-property begin end_bname 'face (list '(:weight bold) 'highlight)) + ;; Date + (insert "\n") + (insert (format-time-string "%c" (date-to-time date))) + (insert " ") ;; Notes (when (and note_count (> note_count 0)) (insert " (" (format "%d" note_count) " note" @@ -358,18 +377,11 @@ better suited to inserting each post." (when verbose (insert "Date: " date - "\nTags: " (mapconcat '(lambda (x) (concat "#" x)) tags ", ") + "\nTags: " (mapconcat #'(lambda (x) (concat "#" x)) tags ", ") "\nPermalink: ") (tumblesocks-view-insert-parsed-html-fragment `(a ((href . ,post_url)) ,post_url) t) - (insert "\n")) - (put-text-property begin end_bname 'face - (list '(:inverse-video t) - '(:weight bold) - font-lock-keyword-face)) - (put-text-property end_bname (point) 'face - (list '(:weight bold) - 'highlight)))) + (insert "\n")))) (defun tumblesocks-view-insert-text () (tumblesocks-view-insert-html-fragment body) @@ -380,7 +392,7 @@ better suited to inserting each post." `(p () . ,(apply 'append (mapcar - '(lambda (photodata) + #'(lambda (photodata) ;; There could be several photos here, and ;; each photo has several alternative sizes. ;; The first is usually the biggest, the @@ -388,7 +400,7 @@ better suited to inserting each post." (let* ((alts (plist-get photodata :alt_sizes)) (desired-size-alts (delq nil - (mapcar '(lambda(alt) + (mapcar #'(lambda(alt) (and (= (plist-get alt :width) tumblesocks-desired-image-size) alt)) @@ -410,11 +422,13 @@ better suited to inserting each post." (insert "\n")) (defun tumblesocks-view-insert-answer () - (insert asking_name " asks: \n ") + (insert asking_name " asks:") (let ((start (point)) - (shr-indentation 4)) + (shr-indentation 32)) (tumblesocks-view-insert-html-fragment question t) - (put-text-property start (point) 'face font-lock-comment-face)) + ;;(put-text-property start (point) 'face font-lock-comment-face) + ;;(set-face-attribute start (point) :background "grey") + ) (tumblesocks-view-insert-html-fragment answer)) (defun tumblesocks-view-insert-link () @@ -519,7 +533,7 @@ You can browse around, edit, and delete posts from here. 99999) ; allow them to browse practically infinite posts (tumblesocks-view-finishrender) (setq tumblesocks-view-refresh-action - '(lambda () (tumblesocks-view-dashboard t))))) + #'(lambda () (tumblesocks-view-dashboard t))))) (defun tumblesocks-view-post (post_id) "View a post in its own dedicated buffer, with notes" @@ -547,42 +561,70 @@ You can browse around, edit, and delete posts from here. (defun tumblesocks-view-render-notes (notes) "Render the given notes into the current buffer." (let ((start (point))) - (flet ((comment-that () - (put-text-property start (point) 'face font-lock-comment-face) - (setq start (point))) - (bold-that () - (put-text-property start (point) 'face - (cons '(:weight bold) font-lock-comment-face)) - (setq start (point)))) + (cl-flet ((comment-that () + (put-text-property start (point) 'face font-lock-comment-face) + (setq start (point))) + (bold-that () + (put-text-property start (point) 'face + (cons '(:weight bold) font-lock-comment-face)) + (setq start (point)))) (insert "-- Notes:\n") (comment-that) (dolist (note notes) - (tumblesocks-bind-plist-keys note - (type post_id blog_name blog_url reply_text answer_text added_text) - (cond ((string= type "posted") - (insert blog_name " posted this")) - ((string= type "answer") - (insert blog_name " answers:\n ") - (comment-that) - (tumblesocks-view-insert-html-fragment answer_text t) - (bold-that)) - ((string= type "reblog") - (insert blog_name " reblogged this on " blog_url)) - ((string= type "like") - (insert blog_name " liked this")) - ((string= type "reply") - (insert blog_name " says: ") - (comment-that) - (tumblesocks-view-insert-html-fragment reply_text t) - (bold-that)) - (t (insert (format "%S" note)))) - (when added_text - (insert "\n ") - (comment-that) - (insert added_text) - (bold-that)) - (insert "\n") - (comment-that)))))) + (tumblesocks-bind-plist-keys + note + (type post_id blog_name blog_url reply_text answer_text added_text) + (cond ((string= type "posted") + (insert blog_name " posted this")) + ((string= type "answer") + (insert blog_name " answers:\n ") + (comment-that) + (tumblesocks-view-insert-html-fragment answer_text t) + (bold-that)) + ((string= type "reblog") + (insert blog_name " reblogged this on " blog_url)) + ((string= type "like") + (insert blog_name " liked this")) + ((string= type "reply") + (insert blog_name " says: ") + (comment-that) + (tumblesocks-view-insert-html-fragment reply_text t) + (bold-that)) + (t (insert (format "%S" note)))) + (when added_text + (insert "\n ") + (comment-that) + (insert added_text) + (bold-that)) + (insert "\n") + (comment-that)))))) + +(defun tumblesocks-view-notifications () + "View all notfications, newest on top" + ;; TODO paging! + (interactive) + (tumblesocks-api-blog-notifications) + (tumblesocks-view-prepare-buffer "notifications") + (let ((begin (point))) + (insert "Notifications") + (center-line) + (insert "\n\n") + (put-text-property begin (point) 'face font-lock-comment-face)) + (dolist (notification (plist-get (tumblesocks-api-blog-notifications) :notifications)) + (insert (make-string fill-column ?\u2500)) + (insert "\n") + ;;(insert (format "%s\n" notification)) + (insert (format "%s - " (format-time-string "%c" (plist-get notification :timestamp)))) + (insert (format "%s - " (plist-get notification :type))) + (insert (format "%s - " (plist-get notification :from_tumblelog_name))) + (when (string= (plist-get notification :type) "reply") + (insert (format "%s - " (plist-get notification :reply_text)))) + (tumblesocks-view-insert-parsed-html-fragment + `(img ((src . ,(plist-get notification :media_url)))) t) + (insert (format "\n%s\n" (plist-get notification :target_post_summary)))) + (tumblesocks-view-finishrender) + (setq tumblesocks-view-refresh-action + `(lambda () (tumblesocks-view-notifications)))) ; <-- CLOSURE HACK :p (defun tumblesocks-view-like-post-at-point (like-p) "Like the post underneath point. With prefix arg (C-u), unlike it." @@ -618,12 +660,12 @@ You can browse around, edit, and delete posts from here. (defun tumblesocks-view-posts-tagged (tag) "Search for posts with the given tag." (interactive (list (read-from-minibuffer - "Search for posts with tag: " + "Search for posts with tag: " (tumblesocks-view--dwim-at-point)))) (tumblesocks-view-prepare-buffer (concat "Tag search: " tag)) (tumblesocks-view-render-blogdata - (tumblesocks-api-tagged tag nil nil "html") + (tumblesocks-api-tagged tag nil nil "raw") 0) ; don't allow them to browse next (this isn't possible in general anyways) (tumblesocks-view-finishrender) (setq tumblesocks-view-refresh-action @@ -656,7 +698,7 @@ You can browse around, edit, and delete posts from here. :help "Move to the previous post."] "--" ["Search" tumblesocks-view-posts-tagged - :help "Search for posts with a certain tag."] + :help "Search for posts with a certain tag."] ["Refresh List" tumblesocks-view-refresh :help "Refresh the current view (download new posts)."] "---" @@ -666,3 +708,6 @@ You can browse around, edit, and delete posts from here. :help "tumblesocks-mode settings"] ["Quit" quit-window :help "Close the current frame"])) + +(provide 'tumblesocks-view) +;;; tumblesocks-view.el ends here diff --git a/tumblesocks.el b/tumblesocks.el index 8c7a6e1..c37ed8a 100644 --- a/tumblesocks.el +++ b/tumblesocks.el @@ -1,9 +1,12 @@ ;;; tumblesocks.el --- An Emacs tumblr client. ;; Copyright 2012 gcr +;; Copyright 2023 gargle ;; Author: gcr +;; gargle ;; URL: http://github.com/gcr/tumblesocks +;; https://codeberg.org/gargle/tumblesocks ;; License: zlib (defgroup tumblesocks nil