From f5cd8832412ffb16def55807fd68b3d85d4be9b5 Mon Sep 17 00:00:00 2001 From: Johnson Denen Date: Mon, 19 Jun 2017 11:28:37 -0400 Subject: Bump version to 0.7.1 --- lisp/mastodon.el | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) (limited to 'lisp/mastodon.el') diff --git a/lisp/mastodon.el b/lisp/mastodon.el index 2bf5e84..c031774 100644 --- a/lisp/mastodon.el +++ b/lisp/mastodon.el @@ -2,7 +2,7 @@ ;; Copyright (C) 2017 Johnson Denen ;; Author: Johnson Denen -;; Version: 0.7.0 +;; Version: 0.7.1 ;; Package-Requires: ((emacs "24.4")) ;; Homepage: https://github.com/jdenen/mastodon.el -- cgit v1.2.3 From c7e0da711b433ccac1f2791c16047e1eb2ed2c75 Mon Sep 17 00:00:00 2001 From: Holger Dürer Date: Sat, 13 May 2017 18:45:51 +0100 Subject: Allow user to navigate interesting things in a buffer via tabbing (tab to go forward, M-tab and S-Tab to go back). This has always been possible while on a hyperlink but now works everywhere. Currently only hyperlinks are tab stops but in the future we will want to support other things and there are already TODO comments in the code to note where we may want to do this. --- lisp/mastodon-tl.el | 223 +++++++++++++++++++++++++++++++++------------- lisp/mastodon.el | 9 +- test/mastodon-tl-tests.el | 173 ++++++++++++++++++++++++++++++++--- 3 files changed, 329 insertions(+), 76 deletions(-) (limited to 'lisp/mastodon.el') diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index 2f26b55..58b50ab 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -40,6 +40,7 @@ (autoload 'mastodon-media--inline-images "mastodon-media") (autoload 'mastodon-mode "mastodon") (defvar mastodon-toot-timestamp-format) +(defvar shr-use-fonts) ;; need to declare it since Emacs24 didn't have this (defgroup mastodon-tl nil "Timelines in Mastodon." @@ -73,6 +74,47 @@ keep the timestamps current as time progresses." "The timer that, when set will scan the buffer to update the timestamps.") (make-variable-buffer-local 'mastodon-tl--timestamp-update-timer) +(defvar mastodon-tl--shr-map-replacement + (let ((map (copy-keymap shr-map))) + ;; Replace the move to next/previous link bindings with our + ;; version that knows about more types of links. + (define-key map [remap shr-next-link] 'mastodon-tl--next-tab-item) + (define-key map [remap shr-previous-link] 'mastodon-tl--previous-tab-item) + (keymap-canonicalize map))) + +(defvar mastodon-tl--shr-image-map-replacement + (let ((map (copy-keymap (if (boundp 'shr-image-map) + shr-image-map + shr-map)))) + ;; Replace the move to next/previous link bindings with our + ;; version that knows about more types of links. + (define-key map [remap shr-next-link] 'mastodon-tl--next-tab-item) + (define-key map [remap shr-previous-link] 'mastodon-tl--previous-tab-item) + (keymap-canonicalize map))) + +(defun mastodon-tl--next-tab-item () + "Move to the next interesting item. + +This could be the next toot, link, or image; whichever comes first. +Don't move if nothing else to move to is found, i.e. near the end of the buffer." + (interactive) + (let ((next-range (mastodon-tl--find-next-or-previous-property-range 'mastodon-tab-stop (point) nil))) + (if (null next-range) + (message "Nothing else here.") + (goto-char (car next-range)) + (message "%s" (get-text-property (point) 'help-echo))))) + +(defun mastodon-tl--previous-tab-item () + "Move to the previous interesting item. + +This could be the previous toot, link, or image; whichever comes first. +Don't move if nothing else to move to is found, i.e. near the start of the buffer." + (interactive) + (let ((next-range (mastodon-tl--find-next-or-previous-property-range 'mastodon-tab-stop (point) t))) + (if (null next-range) + (message "Nothing else before this.") + (goto-char (car next-range)) + (message "%s" (get-text-property (point) 'help-echo))))) (defun mastodon-tl--get-federated-timeline () "Opens federated timeline." @@ -140,6 +182,8 @@ Optionally start from POS." (handle (cdr (assoc 'acct account))) (name (cdr (assoc 'display_name account))) (avatar-url (cdr (assoc 'avatar account)))) + ;; TODO: Once we have a view for a user (e.g. their posts + ;; timeline) make this a tab-stop and attach an action (concat (when (and mastodon-tl--show-avatars-p mastodon-tl--display-media-p) (mastodon-media--get-avatar-rendering avatar-url)) @@ -237,49 +281,74 @@ TIME-STAMP is assumed to be in the past." (parsed-time (date-to-time (mastodon-tl--field 'created_at toot))) (faved (equal 't (mastodon-tl--field 'favourited toot))) (boosted (equal 't (mastodon-tl--field 'reblogged toot)))) - (propertize - (concat (propertize "\n | " 'face 'default) - (when boosted - (format "(%s) " - (propertize "B" 'face 'mastodon-boost-fave-face))) - (when faved - (format "(%s) " - (propertize "F" 'face 'mastodon-boost-fave-face))) - (mastodon-tl--byline-author toot) - (mastodon-tl--byline-boosted toot) - " " - (propertize - (format-time-string mastodon-toot-timestamp-format parsed-time) - 'timestamp parsed-time - 'display (if mastodon-tl--enable-relative-timestamps - (mastodon-tl--relative-time-description parsed-time) - parsed-time)) - (propertize "\n ------------" 'face 'default)) - 'favourited-p faved - 'boosted-p boosted - 'toot-id id - 'toot-json toot))) - -(defun mastodon-tl--set-face (string face render) - "Set the face of a string. If `render' is not nil -also render the html" - (propertize - (with-temp-buffer - (insert string) - (when render - (let ((shr-use-fonts nil)) - (shr-render-region (point-min) (point-max)))) - (buffer-string)) - 'face face)) + (concat + (propertize "\n | " 'face 'default) + (propertize + (concat (when boosted + (format "(%s) " + (propertize "B" 'face 'mastodon-boost-fave-face))) + (when faved + (format "(%s) " + (propertize "F" 'face 'mastodon-boost-fave-face))) + (mastodon-tl--byline-author toot) + (mastodon-tl--byline-boosted toot) + " " + ;; TODO: Once we have a view for toot (responses etc.) make + ;; this a tab stop and attach an action. + (propertize + (format-time-string mastodon-toot-timestamp-format parsed-time) + 'timestamp parsed-time + 'display (if mastodon-tl--enable-relative-timestamps + (mastodon-tl--relative-time-description parsed-time) + parsed-time)) + (propertize "\n ------------" 'face 'default)) + 'favourited-p faved + 'boosted-p boosted + 'toot-id id + 'toot-json toot)))) + +(defun mastodon-tl--render-text (string) + "Returns a propertized text giving the rendering of the given HTML string." + (with-temp-buffer + (insert string) + (let ((shr-use-fonts nil)) + (shr-render-region (point-min) (point-max))) + ;; Make all links a tab stop recognized by our own logic and + ;; update keymaps where needed. + ;; + ;; TODO: Once we have views for users and tags we need to + ;; recognize these links and turn them into links to our own + ;; views. + (let (region) + (while (setq region (mastodon-tl--find-property-range + 'shr-url (or (cdr region) (point-min)))) + (let* ((start (car region)) + (end (cdr region)) + (keymap (if (eq shr-map (get-text-property start 'keymap)) + mastodon-tl--shr-map-replacement + mastodon-tl--shr-image-map-replacement))) + (add-text-properties start end + (list 'mastodon-tab-stop 'shr-url + 'keymap keymap))))) + (buffer-string))) + +(defun mastodon-tl--set-face (string face) + "Returns the propertized STRING with the face property set to FACE." + (propertize string 'face face)) (defun mastodon-tl--spoiler (toot) "Retrieve spoiler message from TOOT." (let* ((spoiler (mastodon-tl--field 'spoiler_text toot)) - (string (mastodon-tl--set-face spoiler 'default t)) + (string (mastodon-tl--set-face + (mastodon-tl--render-text spoiler) + 'default)) + ;; TODO: Make this a tab stop and link; then hide the main + ;; text and make the link action a toggling of the + ;; visibility of that main body. (message (concat "\n ---------------" "\n Content Warning" "\n ---------------\n")) - (cw (mastodon-tl--set-face message 'mastodon-cw-face nil))) + (cw (mastodon-tl--set-face message 'mastodon-cw-face))) (if (> (length string) 0) (replace-regexp-in-string "\n\n\n ---------------" "\n ---------------" (concat string cw)) @@ -299,28 +368,23 @@ also render the html" media-attachements ""))) (if (not (and mastodon-tl--display-media-p (equal media-string ""))) - (concat "\n" media-string) ""))) + (concat "\n" media-string) + ""))) (defun mastodon-tl--content (toot) "Retrieve text content from TOOT." - (let ((content (mastodon-tl--field 'content toot)) - (shr-use-fonts nil)) - (propertize (with-temp-buffer - (insert content) - (shr-render-region (point-min) (point-max)) - (buffer-string)) - 'face 'default))) + (let ((content (mastodon-tl--field 'content toot))) + (mastodon-tl--render-text content))) (defun mastodon-tl--toot (toot) "Display TOOT content and byline." (insert (concat (mastodon-tl--spoiler toot) - ;; remove two trailing newlines - (substring (mastodon-tl--content toot) 0 -2) + ;; remove trailing whitespace + (replace-regexp-in-string "[\t\n ]*\\'" "" (mastodon-tl--content toot)) (mastodon-tl--media toot) - "\n\n" (mastodon-tl--byline toot) "\n\n"))) @@ -454,23 +518,60 @@ webapp" (funcall update-function json) (goto-char point-before))))) -(defun mastodon-tl--find-property-range (property start-point) - "Finds (start . end) range around or after START-POINT where PROPERTY is set to a consistent value. +(defun mastodon-tl--find-property-range (property start-point &optional search-backwards) + "Finds (start . end) range around or before/after START-POINT where PROPERTY is set to a consistent value. + +Returns `nil` if no such range is found. -If PROPERTY is set at START-POINT returns a range aroung -START-POINT otherwise after START-POINT." +If PROPERTY is set at START-POINT returns a range around +START-POINT otherwise before/after START-POINT. + +SEARCH-BACKWARDS determines whether we pick point +before (non-nil) or after (nil)" (if (get-text-property start-point property) ;; We are within a range, so look backwards for the start: - (cons (or (previous-single-property-change start-point property) - (point-min)) - (or (next-single-property-change start-point property) - (point-max))) - (let* ((start (next-single-property-change start-point property)) - (end (and start - (or (next-single-property-change start property) - (point-max))))) - (when start - (cons start end))))) + (cons (previous-single-property-change + (if (equal start-point (point-max)) start-point (1+ start-point)) + property nil (point-min)) + (next-single-property-change start-point property nil (point-max))) + (if search-backwards + (let* ((end (or (previous-single-property-change + (if (equal start-point (point-max)) start-point (1+ start-point)) + property) + ;; we may either be just before the range or there is nothing at all + (and (not (equal start-point (point-min))) + (get-text-property (1- start-point) property) + start-point))) + (start (and end + (previous-single-property-change end property nil (point-min))))) + (when end + (cons start end))) + (let* ((start (next-single-property-change start-point property)) + (end (and start + (next-single-property-change start property nil (point-max))))) + (when start + (cons start end)))))) + +(defun mastodon-tl--find-next-or-previous-property-range (property start-point search-backwards) + "Finds (start . end) range after/before START-POINT where PROPERTY is set to a consistent value (different from the value at START-POINT if that is set). + +Returns nil if no such range exists. + +If SEARCH-BACKWARDS is non-nil it find a region before +START-POINT otherwise after START-POINT. +" + (if (get-text-property start-point property) + ;; We are within a range, we need to start the search from + ;; before/after this range: + (let ((current-range (mastodon-tl--find-property-range property start-point))) + (if search-backwards + (unless (equal (car current-range) (point-min)) + (mastodon-tl--find-property-range property (1- (car current-range)) search-backwards)) + (unless (equal (cdr current-range) (point-max)) + (mastodon-tl--find-property-range property (1+ (cdr current-range)) search-backwards)))) + ;; If we are not within a range, we can just defer to + ;; mastodon-tl--find-property-range directly. + (mastodon-tl--find-property-range property start-point search-backwards))) (defun mastodon-tl--consider-timestamp-for-updates (timestamp) "Take note that TIMESTAMP is used in buffer and ajust timers as needed. diff --git a/lisp/mastodon.el b/lisp/mastodon.el index c031774..e04babe 100644 --- a/lisp/mastodon.el +++ b/lisp/mastodon.el @@ -38,6 +38,8 @@ (autoload 'mastodon-tl--get-tag-timeline "mastodon-tl") (autoload 'mastodon-tl--goto-next-toot "mastodon-tl") (autoload 'mastodon-tl--goto-prev-toot "mastodon-tl") +(autoload 'mastodon-tl--next-tab-item "mastodon-tl") +(autoload 'mastodon-tl--previous-tab-item "mastodon-tl") (autoload 'mastodon-tl--thread "mastodon-tl") (autoload 'mastodon-tl--update "mastodon-tl") (autoload 'mastodon-toot--compose-buffer "mastodon-toot") @@ -131,7 +133,12 @@ If REPLY-TO-ID is non-nil, attach new toot to a conversation." (define-key map (kbd "r") #'mastodon-toot--reply) (define-key map (kbd "t") #'mastodon-tl--thread) (define-key map (kbd "T") #'mastodon-tl--get-tag-timeline) - (define-key map (kbd "u") #'mastodon-tl--update))) + (define-key map (kbd "u") #'mastodon-tl--update) + (define-key map [?\t] #'mastodon-tl--next-tab-item) + (define-key map [backtab] #'mastodon-tl--previous-tab-item) + (define-key map [?\S-\t] #'mastodon-tl--previous-tab-item) + (define-key map [?\M-\t] #'mastodon-tl--previous-tab-item) + )) (with-eval-after-load 'mastodon (when (require 'discover nil :noerror) diff --git a/test/mastodon-tl-tests.el b/test/mastodon-tl-tests.el index 5d7699e..4e284a3 100644 --- a/test/mastodon-tl-tests.el +++ b/test/mastodon-tl-tests.el @@ -1,5 +1,6 @@ -(require 'el-mock) +(require 'cl-lib) (require 'cl-macs) +(require 'el-mock) (defconst mastodon-tl-test-base-toot '((id . 61208) @@ -478,7 +479,8 @@ a string or a numeric." (insert "Just some random text") (insert (propertize "More text with a different property" 'other-property 'set)) - (should (null (mastodon-tl--find-property-range 'test-property 2))))) + (should (null (mastodon-tl--find-property-range 'test-property 2 nil))) + (should (null (mastodon-tl--find-property-range 'test-property 2 t))))) (ert-deftest mastodon-tl--find-property-range--earlier-tag () "Should cope with a buffer completely lacking the tag." @@ -487,7 +489,9 @@ a string or a numeric." (let ((end-of-region (point))) (insert "More random text") - (should (null (mastodon-tl--find-property-range 'test-property end-of-region)))))) + (should (null (mastodon-tl--find-property-range 'test-property end-of-region nil))) + (should (equal (cons (point-min) end-of-region) + (mastodon-tl--find-property-range 'test-property end-of-region t)))))) (ert-deftest mastodon-tl--find-property-range--successful-finding () "Should find the sought tag in all expected circumstances." @@ -501,13 +505,47 @@ a string or a numeric." ;; before the region (should (equal (cons start-of-region end-of-region) - (mastodon-tl--find-property-range 'test-property 1))) + (mastodon-tl--find-property-range 'test-property 1 nil))) + (should (null (mastodon-tl--find-property-range 'test-property 1 t))) ;; in the region (should (equal (cons start-of-region end-of-region) - (mastodon-tl--find-property-range 'test-property (+ 2 start-of-region)))) + (mastodon-tl--find-property-range 'test-property (+ 2 start-of-region) nil))) + (should (equal (cons start-of-region end-of-region) + (mastodon-tl--find-property-range 'test-property (+ 2 start-of-region) t))) ;; at end of region (should (equal (cons start-of-region end-of-region) - (mastodon-tl--find-property-range 'test-property (1- end-of-region))))))) + (mastodon-tl--find-property-range 'test-property (1- end-of-region) nil))) + (should (equal (cons start-of-region end-of-region) + (mastodon-tl--find-property-range 'test-property (1- end-of-region) t)))))) + +(ert-deftest mastodon-tl--find-property-range--successful-finding-consecutive-ranges () + "Should find the sought tag even from in between consecutive ranges." + (with-temp-buffer + (insert "Previous text") + (let ((start-of-region-1 (point)) + between-regions + end-of-region-2) + (insert (propertize "region1" 'test-property 'region1)) + (setq between-regions (point)) + (insert (propertize "region2" 'test-property 'region2)) + (setq end-of-region-2 (point)) + (insert "More random text") + + + ;; before + (should (equal (cons start-of-region-1 between-regions) + (mastodon-tl--find-property-range 'test-property 1 nil))) + (should (null (mastodon-tl--find-property-range 'test-property 1 t))) + + ;; between the regions + (should (equal (cons between-regions end-of-region-2) + (mastodon-tl--find-property-range 'test-property between-regions nil))) + (should (equal (cons between-regions end-of-region-2) + (mastodon-tl--find-property-range 'test-property between-regions t))) + ;; after + (should (null (mastodon-tl--find-property-range 'test-property end-of-region-2 nil))) + (should (equal (cons between-regions end-of-region-2) + (mastodon-tl--find-property-range 'test-property end-of-region-2 t)))))) (ert-deftest mastodon-tl--find-property-range--successful-finding-at-start () "Should cope with a tag at start." @@ -518,13 +556,17 @@ a string or a numeric." ;; at start of the region (should (equal (cons 1 end-of-region) - (mastodon-tl--find-property-range 'test-property 1))) + (mastodon-tl--find-property-range 'test-property 1 nil))) + (should (equal (cons 1 end-of-region) + (mastodon-tl--find-property-range 'test-property 1 t))) ;; in the region (should (equal (cons 1 end-of-region) - (mastodon-tl--find-property-range 'test-property 3))) + (mastodon-tl--find-property-range 'test-property 3 nil))) + (should (equal (cons 1 end-of-region) + (mastodon-tl--find-property-range 'test-property 3 t))) ;; at end of region (should (equal (cons 1 end-of-region) - (mastodon-tl--find-property-range 'test-property (1- end-of-region))))))) + (mastodon-tl--find-property-range 'test-property (1- end-of-region) t)))))) (ert-deftest mastodon-tl--find-property-range--successful-finding-at-end () "Should cope with a tag at end." @@ -537,22 +579,28 @@ a string or a numeric." ;; before the region (should (equal (cons start-of-region end-of-region) - (mastodon-tl--find-property-range 'test-property 1))) + (mastodon-tl--find-property-range 'test-property 1 nil))) + (should (null (mastodon-tl--find-property-range 'test-property 1 t))) ;; in the region (should (equal (cons start-of-region end-of-region) - (mastodon-tl--find-property-range 'test-property (1+ start-of-region)))) + (mastodon-tl--find-property-range 'test-property (1+ start-of-region) nil))) + (should (equal (cons start-of-region end-of-region) + (mastodon-tl--find-property-range 'test-property (1+ start-of-region) t))) ;; at end of region (should (equal (cons start-of-region end-of-region) - (mastodon-tl--find-property-range 'test-property (1- end-of-region))))))) + (mastodon-tl--find-property-range 'test-property (1- end-of-region) nil))) + (should (equal (cons start-of-region end-of-region) + (mastodon-tl--find-property-range 'test-property (1- end-of-region) t)))))) (ert-deftest mastodon-tl--find-property-range--successful-finding-whole-buffer () "Should cope with a tag being set for the whole buffer." (with-temp-buffer (insert (propertize "Just some text with a the sought property" 'test-property 'set)) - ;; before the region (should (equal (cons (point-min) (point-max)) - (mastodon-tl--find-property-range 'test-property 2))))) + (mastodon-tl--find-property-range 'test-property 2 nil))) + (should (equal (cons (point-min) (point-max)) + (mastodon-tl--find-property-range 'test-property 2 t))))) (defun tl-tests--all-regions-with-property (property) "Returns a list with (start . end) regions where PROPERTY is set." @@ -565,6 +613,102 @@ a string or a numeric." (goto-char (min (point-max) (cdr region)))) (nreverse result))) + +(ert-deftest mastodon-tl--next-tab-item--with-spaces-at-ends () + "Should do the correct tab actions." + (with-temp-buffer + ;; We build a buffer with 3 tab stops: "...R1...R2R3..." (a dot + ;; represents text that is not part of a link, so R1 and R2 have a + ;; gap in between each other, R2 and R3 don't. + (insert "Random text at start") + (let ((start 2) + (r1 (point)) + r2 gap r3 + end) + (insert (propertize "R1 R1 R1" 'mastodon-tab-stop 'region1)) + (setq gap (+ (point) 2)) + (insert " a gap ") + (setq r2 (point)) + (insert (propertize "R2 R2 R2" 'mastodon-tab-stop 'region2)) + (setq r3 (point)) + (insert (propertize "R3 R3 R3" 'mastodon-tab-stop 'region3)) + (setq end (+ (point) 2)) + (insert " more text at end") + + (let ((test-cases + ;; a list 4-elemet lists of (test-name start-point + ;; expected-prev-stop expected-next-stop): + (list (list 'start start start r1) + (list 'r1 r1 r1 r2) + (list 'gap gap r1 r2) + (list 'r2 r2 r1 r3) + (list 'r3 r3 r2 r3) + (list 'end end r3 end)))) + (with-mock + (stub message => nil) ;; don't mess up our test output with the function's messages + (cl-dolist (test test-cases) + (let ((test-name (cl-first test)) + (test-start (cl-second test)) + (expected-prev (cl-third test)) + (expected-next (cl-fourth test))) + (goto-char test-start) + (mastodon-tl--previous-tab-item) + (should (equal (list 'prev test-name expected-prev) + (list 'prev test-name (point)))) + (goto-char test-start) + (mastodon-tl--next-tab-item) + (should (equal (list 'next test-name expected-next) + (list 'next test-name (point))))))))))) + +(ert-deftest mastodon-tl--next-tab-item--no-spaces-at-ends () + "Should do the correct tab actions even with regions right at buffer ends." + (with-temp-buffer + ;; We build a buffer with 3 tab stops: "R1...R2R3...R4" (a dot + ;; represents text that is not part of a link, so R1 and R2, and + ;; R3 and R4 have a gap in between each other, R2 and R3 don't. + (let ((r1 (point)) + gap1 + r2 r3 + gap2 + r4) + (insert (propertize "R1 R1 R1" 'mastodon-tab-stop 'region1)) + (setq gap1 (+ (point) 2)) + (insert " a gap ") + (setq r2 (point)) + (insert (propertize "R2 R2 R2" 'mastodon-tab-stop 'region2)) + (setq r3 (point)) + (insert (propertize "R3 R3 R3" 'mastodon-tab-stop 'region3)) + (setq gap2 (+ (point) 2)) + (insert " another gap ") + (setq r4 (point)) + (insert (propertize "R4 R4 R4" 'mastodon-tab-stop 'region4)) + + (let ((test-cases + ;; a list 4-elemet lists of (test-name start-point + ;; expected-prev-stop expected-next-stop): + (list (list 'r1 r1 r1 r2) + (list 'gap1 gap1 r1 r2) + (list 'r2 r2 r1 r3) + (list 'r3 r3 r2 r4) + (list 'gap2 gap2 r3 r4) + (list 'r4 r4 r3 r4)))) + (with-mock + (stub message => nil) ;; don't mess up our test output with the function's messages + (cl-dolist (test test-cases) + (let ((test-name (cl-first test)) + (test-start (cl-second test)) + (expected-prev (cl-third test)) + (expected-next (cl-fourth test))) + (goto-char test-start) + (mastodon-tl--previous-tab-item) + (should (equal (list 'prev test-name expected-prev) + (list 'prev test-name (point)))) + (goto-char test-start) + (mastodon-tl--next-tab-item) + (should (equal (list 'next test-name expected-next) + (list 'next test-name (point))))))))))) + + (defun tl-tests--property-values-at (property ranges) "Returns a list with property values at the given ranges. @@ -618,3 +762,4 @@ constant." (tl-tests--property-values-at 'display (tl-tests--all-regions-with-property 'timestamp)))) (should (null (marker-position (nth 9 markers))))))))) + -- cgit v1.2.3 From b277114d7b3be3447eeecaf3ba7ac0b282a339fe Mon Sep 17 00:00:00 2001 From: Alexander Griffith Date: Mon, 5 Mar 2018 21:39:12 -0500 Subject: Bump to 0.7.2 and shorten long code lines (#172) * Bump version numbers to 0.7.2 * Adjusted functions to bring line length below 90. --- lisp/mastodon-auth.el | 2 +- lisp/mastodon-client.el | 5 ++- lisp/mastodon-http.el | 2 +- lisp/mastodon-inspect.el | 2 +- lisp/mastodon-media.el | 16 +++++--- lisp/mastodon-tl.el | 97 +++++++++++++++++++++++++++++------------------- lisp/mastodon-toot.el | 2 +- lisp/mastodon.el | 2 +- 8 files changed, 78 insertions(+), 50 deletions(-) (limited to 'lisp/mastodon.el') diff --git a/lisp/mastodon-auth.el b/lisp/mastodon-auth.el index b2399d2..28c14bc 100644 --- a/lisp/mastodon-auth.el +++ b/lisp/mastodon-auth.el @@ -2,7 +2,7 @@ ;; Copyright (C) 2017 Johnson Denen ;; Author: Johnson Denen -;; Version: 0.7.1 +;; Version: 0.7.2 ;; Homepage: https://github.com/jdenen/mastodon.el ;; Package-Requires: ((emacs "24.4")) diff --git a/lisp/mastodon-client.el b/lisp/mastodon-client.el index cceb70a..968cdf3 100644 --- a/lisp/mastodon-client.el +++ b/lisp/mastodon-client.el @@ -2,7 +2,7 @@ ;; Copyright (C) 2017 Johnson Denen ;; Author: Johnson Denen -;; Version: 0.7.1 +;; Version: 0.7.2 ;; Homepage: https://github.com/jdenen/mastodon.el ;; Package-Requires: ((emacs "24.4")) @@ -96,7 +96,8 @@ Make `mastodon-client--fetch' call to determine client values." Read plist from `mastodon-client--token-file' if variable is nil. Fetch and store plist if `mastodon-client--read' returns nil." - (let ((client-details (cdr (assoc mastodon-instance-url mastodon-client--client-details-alist)))) + (let ((client-details + (cdr (assoc mastodon-instance-url mastodon-client--client-details-alist)))) (unless client-details (setq client-details (or (mastodon-client--read) diff --git a/lisp/mastodon-http.el b/lisp/mastodon-http.el index 905a853..de9d464 100644 --- a/lisp/mastodon-http.el +++ b/lisp/mastodon-http.el @@ -2,7 +2,7 @@ ;; Copyright (C) 2017 Johnson Denen ;; Author: Johnson Denen -;; Version: 0.7.1 +;; Version: 0.7.2 ;; Package-Requires: ((emacs "24.4")) ;; Homepage: https://github.com/jdenen/mastodon.el diff --git a/lisp/mastodon-inspect.el b/lisp/mastodon-inspect.el index c5b2924..62a91b5 100644 --- a/lisp/mastodon-inspect.el +++ b/lisp/mastodon-inspect.el @@ -2,7 +2,7 @@ ;; Copyright (C) 2017 Johnson Denen ;; Author: Johnson Denen -;; Version: 0.7.1 +;; Version: 0.7.2 ;; Package-Requires: ((emacs "24.4")) ;; Homepage: https://github.com/jdenen/mastodon.el diff --git a/lisp/mastodon-media.el b/lisp/mastodon-media.el index fa5b8c3..2decce4 100644 --- a/lisp/mastodon-media.el +++ b/lisp/mastodon-media.el @@ -2,7 +2,7 @@ ;; Copyright (C) 2017 Johnson Denen ;; Author: Johnson Denen -;; Version: 0.7.1 +;; Version: 0.7.2 ;; Homepage: https://github.com/jdenen/mastodon.el ;; Package-Requires: ((emacs "24.4")) @@ -127,7 +127,8 @@ BAIQCEAgAIEABAIsJVH58WqHw8FIgjUIQCAACAQgEIBAAAIBCAQgEIBAAAIBCAQgEAAEAhAIQCBA fKRJkmVZjAQwh78A6vCRWJE8K+8AAAAASUVORK5CYII=") "The PNG data for a generic 200x200 'broken image' view") -(defun mastodon-media--process-image-response (status-plist marker image-options region-length) +(defun mastodon-media--process-image-response + (status-plist marker image-options region-length) "Callback function processing the url retrieve response for URL. STATUS-PLIST is the usual plist of status events as per `url-retrieve'. @@ -151,7 +152,8 @@ REGION-LENGTH is the length of the region that should be replaced with the image (let ((inhibit-read-only t)) (save-restriction (widen) - (put-text-property marker (+ marker region-length) 'media-state 'loaded) + (put-text-property marker + (+ marker region-length) 'media-state 'loaded) (when image ;; We only set the image to display if we could load ;; it; we already have set a default image when we @@ -185,7 +187,10 @@ MEDIA-TYPE is a symbol and either 'avatar or 'media-link." (list marker image-options region-length)) (error (with-current-buffer buffer ;; TODO: Consider adding retries - (put-text-property marker (+ marker region-length) 'media-state 'loading-failed) + (put-text-property marker + (+ marker region-length) + 'media-state + 'loading-failed) :loading-failed)))))) (defun mastodon-media--select-next-media-line () @@ -235,7 +240,8 @@ not been returned." (put-text-property start end 'media-state 'invalid-url) ;; proceed to load this image asynchronously (put-text-property start end 'media-state 'loading) - (mastodon-media--load-image-from-url image-url media-type start (- end start))))))) + (mastodon-media--load-image-from-url + image-url media-type start (- end start))))))) (defun mastodon-media--get-avatar-rendering (avatar-url) "Returns the string to be written that renders the avatar at AVATAR-URL." diff --git a/lisp/mastodon-tl.el b/lisp/mastodon-tl.el index ad5105d..d6f7d04 100644 --- a/lisp/mastodon-tl.el +++ b/lisp/mastodon-tl.el @@ -2,7 +2,7 @@ ;; Copyright (C) 2017 Johnson Denen ;; Author: Johnson Denen -;; Version: 0.7.1 +;; Version: 0.7.2 ;; Homepage: https://github.com/jdenen/mastodon.el ;; Package-Requires: ((emacs "24.4")) @@ -56,9 +56,12 @@ keep the timestamps current as time progresses." :type '(boolean :tag "Enable relative timestamps and background updater task")) (defcustom mastodon-tl--enable-proportional-fonts nil - "Nonnil to enable using proportional (rather than the default fixed width) fonts when rendering HTML." + "Nonnil to enable using proportional fonts when rendering HTML. + +By default fixed width fonts are used." :group 'mastodon-tl - :type '(boolean :tag "Enable using proportional rather than fixed width fonts when rendering HTML text")) + :type '(boolean :tag "Enable using proportional rather than fixed \ +width fonts when rendering HTML text")) (defvar mastodon-tl--buffer-spec nil "A unique identifier and functions for each Mastodon buffer.") @@ -130,7 +133,8 @@ This also skips tab items in invisible text, i.e. hidden spoiler text." (interactive) (let (next-range (search-pos (point))) - (while (and (setq next-range (mastodon-tl--find-next-or-previous-property-range 'mastodon-tab-stop search-pos nil)) + (while (and (setq next-range (mastodon-tl--find-next-or-previous-property-range + 'mastodon-tab-stop search-pos nil)) (get-text-property (car next-range) 'invisible) (setq search-pos (1+ (cdr next-range)))) ;; do nothing, all the action in in the while condition @@ -149,7 +153,8 @@ This also skips tab items in invisible text, i.e. hidden spoiler text." (interactive) (let (next-range (search-pos (point))) - (while (and (setq next-range (mastodon-tl--find-next-or-previous-property-range 'mastodon-tab-stop search-pos t)) + (while (and (setq next-range (mastodon-tl--find-next-or-previous-property-range + 'mastodon-tab-stop search-pos t)) (get-text-property (car next-range) 'invisible) (setq search-pos (1- (car next-range)))) ;; do nothing, all the action in in the while condition @@ -373,8 +378,8 @@ TIME-STAMP is assumed to be in the past." mastodon-tl--shr-map-replacement mastodon-tl--shr-image-map-replacement))) (add-text-properties start end - (list 'mastodon-tab-stop 'shr-url - 'keymap keymap))))) + (list 'mastodon-tab-stop 'shr-url + 'keymap keymap))))) (buffer-string))) (defun mastodon-tl--set-face (string face) @@ -384,11 +389,14 @@ TIME-STAMP is assumed to be in the past." (defun mastodon-tl--toggle-spoiler-text (position) "Toggle the visibility of the spoiler text at/after POSITION." (let ((inhibit-read-only t) - (spoiler-text-region (mastodon-tl--find-property-range 'mastodon-content-warning-body position nil))) + (spoiler-text-region (mastodon-tl--find-property-range + 'mastodon-content-warning-body position nil))) (if (not spoiler-text-region) (message "No spoiler text here") (add-text-properties (car spoiler-text-region) (cdr spoiler-text-region) - (list 'invisible (not (get-text-property (car spoiler-text-region) 'invisible))))))) + (list 'invisible + (not (get-text-property (car spoiler-text-region) + 'invisible))))))) (defun mastodon-tl--make-link (string link-type) "Return a propertized version of STRING that will act like link. @@ -400,11 +408,11 @@ LINK-TYPE is the type of link to produce." (t (error "unknown link type %s" link-type))))) (propertize - string - 'mastodon-tab-stop link-type - 'mouse-face 'highlight - 'keymap mastodon-tl--link-keymap - 'help-echo help-text))) + string + 'mastodon-tab-stop link-type + 'mouse-face 'highlight + 'keymap mastodon-tl--link-keymap + 'help-echo help-text))) (defun mastodon-tl--do-link-action-at-point (position) (interactive "d") @@ -438,7 +446,9 @@ message is a link which unhides/hides the main body." 'default)) (message (concat "\n" " ---------------\n" - " " (mastodon-tl--make-link "Content Warning" 'content-warning) "\n" + " " (mastodon-tl--make-link "Content Warning" + 'content-warning) + "\n" " ---------------\n")) (cw (mastodon-tl--set-face message 'mastodon-cw-face))) (concat @@ -478,10 +488,11 @@ message is a link which unhides/hides the main body." (insert (concat ;; remove trailing whitespace - (replace-regexp-in-string "[\t\n ]*\\'" "" (if (mastodon-tl--has-spoiler toot) - (mastodon-tl--spoiler toot) - (mastodon-tl--content toot))) - + (replace-regexp-in-string + "[\t\n ]*\\'" "" + (if (mastodon-tl--has-spoiler toot) + (mastodon-tl--spoiler toot) + (mastodon-tl--content toot))) (mastodon-tl--byline toot) "\n\n"))) @@ -616,7 +627,7 @@ webapp" (goto-char point-before))))) (defun mastodon-tl--find-property-range (property start-point &optional search-backwards) -" Returns `nil` if no such range is found. + " Returns `nil` if no such range is found. If PROPERTY is set at START-POINT returns a range around START-POINT otherwise before/after START-POINT. @@ -631,14 +642,17 @@ before (non-nil) or after (nil)" (next-single-property-change start-point property nil (point-max))) (if search-backwards (let* ((end (or (previous-single-property-change - (if (equal start-point (point-max)) start-point (1+ start-point)) + (if (equal start-point (point-max)) + start-point (1+ start-point)) property) - ;; we may either be just before the range or there is nothing at all + ;; we may either be just before the range or there + ;; is nothing at all (and (not (equal start-point (point-min))) (get-text-property (1- start-point) property) start-point))) - (start (and end - (previous-single-property-change end property nil (point-min))))) + (start (and + end + (previous-single-property-change end property nil (point-min))))) (when end (cons start end))) (let* ((start (next-single-property-change start-point property)) @@ -647,7 +661,8 @@ before (non-nil) or after (nil)" (when start (cons start end)))))) -(defun mastodon-tl--find-next-or-previous-property-range (property start-point search-backwards) +(defun mastodon-tl--find-next-or-previous-property-range + (property start-point search-backwards) "Finds (start . end) range after/before START-POINT where PROPERTY is set to a consistent value (different from the value at START-POINT if that is set). Returns nil if no such range exists. @@ -661,9 +676,11 @@ START-POINT otherwise after START-POINT. (let ((current-range (mastodon-tl--find-property-range property start-point))) (if search-backwards (unless (equal (car current-range) (point-min)) - (mastodon-tl--find-property-range property (1- (car current-range)) search-backwards)) + (mastodon-tl--find-property-range + property (1- (car current-range)) search-backwards)) (unless (equal (cdr current-range) (point-max)) - (mastodon-tl--find-property-range property (1+ (cdr current-range)) search-backwards)))) + (mastodon-tl--find-property-range + property (1+ (cdr current-range)) search-backwards)))) ;; If we are not within a range, we can just defer to ;; mastodon-tl--find-property-range directly. (mastodon-tl--find-property-range property start-point search-backwards))) @@ -723,8 +740,9 @@ from the start if it is nil." (seconds-to-time 300)) mastodon-tl--timestamp-update-timer nil)) (while (and (< iteration 5) - (setq next-timestamp-range (mastodon-tl--find-property-range 'timestamp - previous-timestamp))) + (setq next-timestamp-range + (mastodon-tl--find-property-range 'timestamp + previous-timestamp))) (let* ((start (car next-timestamp-range)) (end (cdr next-timestamp-range)) (timestamp (get-text-property start 'timestamp)) @@ -732,15 +750,17 @@ from the start if it is nil." (new-display (mastodon-tl--relative-time-description timestamp))) (unless (string= current-display new-display) (let ((inhibit-read-only t)) - (add-text-properties start end - (list 'display (mastodon-tl--relative-time-description timestamp))))) + (add-text-properties + start end (list 'display + (mastodon-tl--relative-time-description timestamp))))) (mastodon-tl--consider-timestamp-for-updates timestamp) (setq iteration (1+ iteration) previous-timestamp (1+ (cdr next-timestamp-range))))) (if next-timestamp-range ;; schedule the next batch from the previous location to ;; start very soon in the future: - (run-at-time 0.1 nil #'mastodon-tl--update-timestamps-callback buffer (copy-marker previous-timestamp)) + (run-at-time 0.1 nil #'mastodon-tl--update-timestamps-callback buffer + (copy-marker previous-timestamp)) ;; otherwise we are done for now; schedule a new run for when needed (setq mastodon-tl--timestamp-update-timer (run-at-time mastodon-tl--timestamp-next-update @@ -781,12 +801,13 @@ UPDATE-FUNCTION is used to recieve more toots." `(buffer-name ,buffer-name endpoint ,endpoint update-function ,update-function) - mastodon-tl--timestamp-update-timer (when mastodon-tl--enable-relative-timestamps - (run-at-time mastodon-tl--timestamp-next-update - nil ;; don't repeat - #'mastodon-tl--update-timestamps-callback - (current-buffer) - nil)))) + mastodon-tl--timestamp-update-timer + (when mastodon-tl--enable-relative-timestamps + (run-at-time mastodon-tl--timestamp-next-update + nil ;; don't repeat + #'mastodon-tl--update-timestamps-callback + (current-buffer) + nil)))) buffer)) (provide 'mastodon-tl) diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el index 7e2451e..bad9b3f 100644 --- a/lisp/mastodon-toot.el +++ b/lisp/mastodon-toot.el @@ -2,7 +2,7 @@ ;; Copyright (C) 2017 Johnson Denen ;; Author: Johnson Denen -;; Version: 0.7.1 +;; Version: 0.7.2 ;; Homepage: https://github.com/jdenen/mastodon.el ;; Package-Requires: ((emacs "24.4")) diff --git a/lisp/mastodon.el b/lisp/mastodon.el index e04babe..7f02295 100644 --- a/lisp/mastodon.el +++ b/lisp/mastodon.el @@ -2,7 +2,7 @@ ;; Copyright (C) 2017 Johnson Denen ;; Author: Johnson Denen -;; Version: 0.7.1 +;; Version: 0.7.2 ;; Package-Requires: ((emacs "24.4")) ;; Homepage: https://github.com/jdenen/mastodon.el -- cgit v1.2.3