Merge branch 'develop'

1 files changed, 156 insertions, 108 deletions

diff --git a/lisp/mastodon-toot.el b/lisp/mastodon-toot.el
index e77ddf3..825831d 100644
--- a/lisp/mastodon-toot.el
+++ b/lisp/mastodon-toot.el
@@ -41,6 +41,11 @@
 (require 'cl-lib)
 (require 'persist)
 (require 'mastodon-iso)
+(require 'facemenu)
+(require 'text-property-search)
+
+(eval-when-compile
+  (require 'mastodon-tl))
 
 (defvar mastodon-instance-url)
 (defvar mastodon-tl--buffer-spec)
@@ -130,7 +135,8 @@ You need to install company yourself to use this."
   "Display a copy of the toot replied to in the compose buffer."
   :type 'boolean)
 
-(defcustom mastodon-toot-orig-in-reply-length 160
+(defcustom mastodon-toot-orig-in-reply-length 191
+  ;; three lines of divider width: (- (* 3 67) (length " Reply to: "))
   "Length to crop toot replied to in the compose buffer to."
   :type 'integer)
 
@@ -147,6 +153,12 @@ If the original toot visibility is different we use the more restricted one."
   "Whether to enable your instance's custom emoji by default."
   :type 'boolean)
 
+(defcustom mastodon-toot--proportional-fonts-compose nil
+  "Nonnil to enable using proportional fonts in the compose buffer.
+By default fixed width fonts are used."
+  :type '(boolean :tag "Enable using proportional rather than fixed \
+width fonts"))
+
 (defvar-local mastodon-toot--content-warning nil
   "A flag whether the toot should be marked with a content warning.")
 
@@ -214,19 +226,15 @@ to also capture toots that are 'sent' but that don't successfully
 send.")
 
 (defvar mastodon-toot-handle-regex
-  (concat
-   ;; preceding bracket, space or bol [boundary doesn't work with @]
-   "\\([(\n\t ]\\|^\\)"
-   "\\(?2:@[0-9a-zA-Z._-]+" ; a handle
-   "\\(@[^ \n\t]*\\)?\\)" ; with poss domain, * = allow only @
-   "\\(\\b\\|'\\)")) ; boundary or ' char
+  (rx (| (any ?\( "\n" "\t "" ") bol) ; preceding things
+      (group-n 2 (+ ?@ (* (any ?- ?_ ?. "A-Z" "a-z" "0-9" ))) ; handle
+               (? ?@ (* (not (any "\n" "\t" " "))))) ; optional domain
+      (| "'" word-boundary))) ; boundary or possessive
 
 (defvar mastodon-toot-tag-regex
-  (concat
-   ;; preceding bracket, space or bol [boundary doesn't work with #]
-   "\\([(\n\t ]\\|^\\)"
-   "\\(?2:#[0-9a-zA-Z_]+\\)" ; tag
-   "\\(\\b\\|'\\)")) ; boundary or ' char
+  (rx (| (any ?\( "\n" "\t" " ") bol)
+      (group-n 2 ?# (+ (any "A-Z" "a-z" "0-9")))
+      (| "'" word-boundary))) ; boundary or possessive
 
 (defvar mastodon-toot-url-regex
   ;; adapted from ffap-url-regexp
@@ -329,7 +337,6 @@ boosting, or bookmarking toots."
 (defun mastodon-toot--toggle-boost-or-favourite (type)
   "Toggle boost or favourite of toot at `point'.
 TYPE is a symbol, either `favourite' or `boost.'"
-  (interactive)
   (mastodon-tl--do-if-toot-strict
    (let* ((boost-p (equal type 'boost))
           (has-id (mastodon-tl--property 'base-toot-id))
@@ -351,37 +358,41 @@ TYPE is a symbol, either `favourite' or `boost.'"
           (visibility (mastodon-tl--field 'visibility
                                           (mastodon-tl--property 'toot-json))))
      (if byline-region
-         (cond ;; actually there's nothing wrong with faving/boosting own toots!
-          ;;((mastodon-toot--own-toot-p (mastodon-tl--property 'toot-json))
-          ;;(error "You can't %s your own toots" action-string))
-          ;; & nothing wrong with faving/boosting own toots from notifs:
-          ;; this boosts/faves the base toot, not the notif status
-          ((and (equal "reblog" toot-type)
-                (not (mastodon-tl--buffer-type-eq 'notifications)))
-           (error "You can't %s boosts" action-string))
-          ((and (equal "favourite" toot-type)
-                (not (mastodon-tl--buffer-type-eq 'notifications)))
-           (error "You can't %s favourites" action-string))
-          ((and (equal "private" visibility)
-                (equal type 'boost))
-           (error "You can't boost private toots"))
-          (t
-           (mastodon-toot--action
-            action
-            (lambda ()
-              (let ((inhibit-read-only t))
-                (add-text-properties (car byline-region)
-                                     (cdr byline-region)
-                                     (if boost-p
-                                         (list 'boosted-p (not boosted))
-                                       (list 'favourited-p (not faved))))
-                (mastodon-toot--update-stats-on-action type remove)
-                (mastodon-toot--action-success
-                 (if boost-p
-                     (mastodon-tl--symbol 'boost)
-                   (mastodon-tl--symbol 'favourite))
-                 byline-region remove))
-              (message (format "%s #%s" (if boost-p msg action) id))))))
+         (if (and (or (equal visibility "direct")
+                      (equal visibility "unlisted"))
+                  boost-p)
+             (message "You cant boost posts with visibility: %s" visibility)
+           (cond ;; actually there's nothing wrong with faving/boosting own toots!
+            ;;((mastodon-toot--own-toot-p (mastodon-tl--property 'toot-json))
+            ;;(error "You can't %s your own toots" action-string))
+            ;; & nothing wrong with faving/boosting own toots from notifs:
+            ;; this boosts/faves the base toot, not the notif status
+            ((and (equal "reblog" toot-type)
+                  (not (mastodon-tl--buffer-type-eq 'notifications)))
+             (error "You can't %s boosts" action-string))
+            ((and (equal "favourite" toot-type)
+                  (not (mastodon-tl--buffer-type-eq 'notifications)))
+             (error "You can't %s favourites" action-string))
+            ((and (equal "private" visibility)
+                  (equal type 'boost))
+             (error "You can't boost private toots"))
+            (t
+             (mastodon-toot--action
+              action
+              (lambda ()
+                (let ((inhibit-read-only t))
+                  (add-text-properties (car byline-region)
+                                       (cdr byline-region)
+                                       (if boost-p
+                                           (list 'boosted-p (not boosted))
+                                         (list 'favourited-p (not faved))))
+                  (mastodon-toot--update-stats-on-action type remove)
+                  (mastodon-toot--action-success
+                   (if boost-p
+                       (mastodon-tl--symbol 'boost)
+                     (mastodon-tl--symbol 'favourite))
+                   byline-region remove))
+                (message (format "%s #%s" (if boost-p msg action) id)))))))
        (message (format "Nothing to %s here?!?" action-string))))))
 
 (defun mastodon-toot--inc-or-dec (count subtract)
@@ -496,7 +507,7 @@ With FAVOURITE, list favouriters, else list boosters."
 
 (defun mastodon-toot--copy-toot-url ()
   "Copy URL of toot at point.
-If the toot is a fave/boost notification, copy the URLof the
+If the toot is a fave/boost notification, copy the URL of the
 base toot."
   (interactive)
   (let* ((toot (or (mastodon-tl--property 'base-toot)
@@ -892,31 +903,28 @@ instance to edit a toot."
   "View editing history of the toot at point in a popup buffer."
   (interactive)
   (let ((id (mastodon-tl--property 'base-toot-id))
-        (history (mastodon-tl--property 'edit-history)))
-    (with-current-buffer (get-buffer-create "*mastodon-toot-edits*")
-      (let ((inhibit-read-only t))
-        (special-mode)
-        (erase-buffer)
-        (let ((count 1))
-          (mapc (lambda (x)
-                  (insert (propertize (if (= count 1)
-                                          (format "%s [original]:\n" count)
-                                        (format "%s:\n" count))
-                                      'face font-lock-comment-face)
-                          (mastodon-toot--insert-toot-iter x)
-                          "\n")
-                  (cl-incf count))
-                history))
-        (switch-to-buffer-other-window (current-buffer))
-        (setq-local header-line-format
-                    (propertize
-                     (format "Edits to toot by %s:"
-                             (alist-get 'username
-                                        (alist-get 'account (car history))))
-                     'face font-lock-comment-face))
-        (mastodon-tl--set-buffer-spec (buffer-name (current-buffer))
-                                      (format "statuses/%s/history" id)
-                                      nil)))))
+        (history (mastodon-tl--property 'edit-history))
+        (buf "*mastodon-toot-edits*"))
+    (with-mastodon-buffer buf #'special-mode :other-window
+      (let ((count 1))
+        (mapc (lambda (x)
+                (insert (propertize (if (= count 1)
+                                        (format "%s [original]:\n" count)
+                                      (format "%s:\n" count))
+                                    'face font-lock-comment-face)
+                        (mastodon-toot--insert-toot-iter x)
+                        "\n")
+                (cl-incf count))
+              history))
+      (setq-local header-line-format
+                  (propertize
+                   (format "Edits to toot by %s:"
+                           (alist-get 'username
+                                      (alist-get 'account (car history))))
+                   'face font-lock-comment-face))
+      (mastodon-tl--set-buffer-spec (buffer-name (current-buffer))
+                                    (format "statuses/%s/history" id)
+                                    nil))))
 
 (defun mastodon-toot--insert-toot-iter (it)
   "Insert iteration IT of toot."
@@ -1131,12 +1139,12 @@ text of the toot being replied to in the compose buffer."
   (mastodon-toot--refresh-attachments-display)
   (mastodon-toot--update-status-fields))
 
-(defun mastodon-toot--attach-media (file content-type description)
-  "Prompt for an attachment FILE of CONTENT-TYPE with DESCRIPTION.
+(defun mastodon-toot--attach-media (file description)
+  "Prompt for an attachment FILE with DESCRIPTION.
 A preview is displayed in the new toot buffer, and the file
 is uploaded asynchronously using `mastodon-toot--upload-attached-media'.
 File is actually attached to the toot upon posting."
-  (interactive "fFilename: \nsContent type: \nsDescription: ")
+  (interactive "fFilename: \nsDescription: ")
   (when (>= (length mastodon-toot--media-attachments) 4)
     ;; Only a max. of 4 attachments are allowed, so pop the oldest one.
     (pop mastodon-toot--media-attachments))
@@ -1145,7 +1153,6 @@ File is actually attached to the toot upon posting."
     (setq mastodon-toot--media-attachments
           (nconc mastodon-toot--media-attachments
                  `(((:contents . ,(mastodon-http--read-file-as-string file))
-                    (:content-type . ,content-type)
                     (:description . ,description)
                     (:filename . ,file)))))
     (mastodon-toot--refresh-attachments-display)
@@ -1187,12 +1194,11 @@ which is used to attach it to a toot when posting."
                                            (when image-options 'imagemagick)
                                          nil) ; inbuilt scaling in 27.1
                                        t image-options))
-                         (type (alist-get :content-type attachment))
                          (description (alist-get :description attachment)))
                     (setq counter (1+ counter))
                     (list (format "\n    %d: " counter)
                           image
-                          (format " \"%s\" (%s)" description type))))
+                          (format " \"%s\"" description))))
                 mastodon-toot--media-attachments))
       (list "None")))
 
@@ -1418,15 +1424,20 @@ LONGEST is the length of the longest binding."
 (defun mastodon-toot--format-reply-in-compose-string (reply-text)
   "Format a REPLY-TEXT for display in compose buffer docs."
   (let* ((rendered (mastodon-tl--render-text reply-text))
-         (no-newlines (replace-regexp-in-string "\n\n" "\n" rendered)))
-    (concat " Reply to:\n\""
-            ;; (propertize
-            (truncate-string-to-width
-             no-newlines
-             mastodon-toot-orig-in-reply-length)
-            ;; overridden by containing propertize call:
-            ;; 'face 'mastodon-toot-docs-reply-text-face)
-            "...\"\n")))
+         (no-props (substring-no-properties rendered))
+         ;; FIXME: this regex replaces \n at end of every post
+         ;; so we have to trim:
+         (no-newlines (string-trim
+                       (replace-regexp-in-string "[\n]+" " " no-props)))
+         (reply-to (concat " Reply to: \"" no-newlines "\""))
+         (crop (truncate-string-to-width
+                ;; (string-limit
+                reply-to
+                mastodon-toot-orig-in-reply-length)))
+    (if (> (length no-newlines)
+           (length crop)) ; we cropped:
+        (concat crop "\n")
+      (concat reply-to "\n"))))
 
 (defun mastodon-toot--display-docs-and-status-fields (&optional reply-text)
   "Insert propertized text with documentation about `mastodon-toot-mode'.
@@ -1464,12 +1475,14 @@ REPLY-TEXT is the text of the toot being replied to."
                    'toot-attachments t)
        "\n"
        (if reply-text
-           (mastodon-toot--format-reply-in-compose-string reply-text)
+           (propertize
+            (mastodon-toot--format-reply-in-compose-string reply-text)
+            'toot-reply t)
          "")
        divider
        "\n")
       'rear-nonsticky t
-      'face font-lock-comment-face
+      'face 'mastodon-toot-docs-face
       'read-only "Edit your message below."
       'toot-post-header t))))
 
@@ -1557,7 +1570,8 @@ REPLY-JSON is the full JSON of the toot being replied to."
 (defun mastodon-toot--count-toot-chars (toot-string &optional cw)
   "Count the characters in TOOT-STRING.
 URLs always = 23, and domain names of handles are not counted.
-This is how mastodon does it."
+This is how mastodon does it.
+CW is the content warning, which contributes to the character count."
   (with-temp-buffer
     (switch-to-buffer (current-buffer))
     (insert toot-string)
@@ -1631,11 +1645,12 @@ Added to `after-change-functions'."
   (when (mastodon-toot--compose-buffer-p)
     (let ((header-region
            (mastodon-tl--find-property-range 'toot-post-header
-                                             (point-min))))
+                                             (point-min)))
+          (face (when mastodon-toot--proportional-fonts-compose
+                  'variable-pitch)))
       ;; cull any prev props:
       ;; stops all text after a handle or mention being propertized:
-      (set-text-properties (cdr header-region) (point-max) nil)
-      ;; TODO: confirm allowed hashtag/handle characters:
+      (set-text-properties (cdr header-region) (point-max) `(face ,face))
       (mastodon-toot--propertize-item mastodon-toot-tag-regex
                                       'success
                                       (cdr header-region))
@@ -1660,11 +1675,22 @@ Added to `after-change-functions'."
   (or (mastodon-tl--buffer-type-eq 'edit-toot)
       (mastodon-tl--buffer-type-eq 'new-toot)))
 
+(defun mastodon-toot--fill-reply-in-compose ()
+  "Fill reply text in compose buffer to the width of the divider."
+  (save-excursion
+    (save-match-data
+      (let* ((fill-column 67))
+        (goto-char (point-min))
+        ;; while-let shoulndn't be needed here, as we really should only have
+        ;; one. if we have more, the bug is elsewhere.
+        (when-let ((prop (text-property-search-forward 'toot-reply)))
+          (fill-region (prop-match-beginning prop)
+                       (point)))))))
+
 ;; NB: now that we have toot drafts, to ensure offline composing remains
 ;; possible, avoid any direct requests here:
-(defun mastodon-toot--compose-buffer (&optional reply-to-user
-                                                reply-to-id reply-json initial-text
-                                                edit)
+(defun mastodon-toot--compose-buffer
+    (&optional reply-to-user reply-to-id reply-json initial-text edit)
   "Create a new buffer to capture text for a new toot.
 If REPLY-TO-USER is provided, inject their handle into the message.
 If REPLY-TO-ID is provided, set the `mastodon-toot--reply-to-id' var.
@@ -1690,9 +1716,11 @@ EDIT means we are editing an existing toot, not composing a new one."
               (mastodon-profile--get-source-pref 'privacy)
               "public")) ; fallback
     (unless buffer-exists
-      (mastodon-toot--display-docs-and-status-fields
-       (when mastodon-toot-display-orig-in-reply-buffer
-         reply-text))
+      (if mastodon-toot-display-orig-in-reply-buffer
+          (progn
+            (mastodon-toot--display-docs-and-status-fields reply-text)
+            (mastodon-toot--fill-reply-in-compose))
+        (mastodon-toot--display-docs-and-status-fields))
       ;; `reply-to-user' (alone) is also used by `mastodon-tl--dm-user', so
       ;; perhaps we should not always call --setup-as-reply, or make its
       ;; workings conditional on reply-to-id. currently it only checks for
@@ -1706,12 +1734,10 @@ EDIT means we are editing an existing toot, not composing a new one."
     (when mastodon-toot--enable-completion
       (set ; (setq-local
        (make-local-variable 'completion-at-point-functions)
-       (add-to-list
-        'completion-at-point-functions
-        #'mastodon-toot--mentions-capf))
-      (add-to-list
-       'completion-at-point-functions
-       #'mastodon-toot--tags-capf)
+       (add-to-list 'completion-at-point-functions
+                    #'mastodon-toot--mentions-capf))
+      (add-to-list 'completion-at-point-functions
+                   #'mastodon-toot--tags-capf)
       ;; company
       (when (and mastodon-toot--use-company-for-completion
                  (require 'company nil :no-error))
@@ -1721,20 +1747,42 @@ EDIT means we are editing an existing toot, not composing a new one."
         (company-mode-on)))
     ;; after-change:
     (make-local-variable 'after-change-functions)
-    (push #'mastodon-toot--update-status-fields after-change-functions)
-    (mastodon-toot--refresh-attachments-display)
+    (cl-pushnew #'mastodon-toot--update-status-fields after-change-functions)
+    (cl-pushnew #'mastodon-toot--save-toot-text after-change-functions)
+    (cl-pushnew #'mastodon-toot--propertize-tags-and-handles after-change-functions)
     (mastodon-toot--update-status-fields)
+    (mastodon-toot--propertize-tags-and-handles)
+    (mastodon-toot--refresh-attachments-display)
     ;; draft toot text saving:
     (setq mastodon-toot-current-toot-text nil)
-    (push #'mastodon-toot--save-toot-text after-change-functions)
-    (push #'mastodon-toot--propertize-tags-and-handles after-change-functions)
     ;; if we set this before changing modes, it gets nuked:
     (setq mastodon-toot-previous-window-config previous-window-config)
+    (when mastodon-toot--proportional-fonts-compose
+      (facemenu-set-face 'variable-pitch))
     (when initial-text
       (insert initial-text))))
 
+;; flyspell ignore masto toot regexes:
+(defvar flyspell-generic-check-word-predicate)
+(defun mastodon-toot-mode-flyspell-verify ()
+  "A predicate function for `flyspell'.
+Only text that is not one of these faces will be spell-checked."
+  (let ((faces '(mastodon-display-name-face
+                 mastodon-toot-docs-face font-lock-comment-face
+                 success link)))
+    (unless (eql (point) (point-min))
+      ;; (point) is next char after the word. Must check one char before.
+      (let ((f (get-text-property (1- (point)) 'face)))
+        (not (memq f faces))))))
+
+(add-hook 'mastodon-toot-mode-hook
+    	  (lambda ()
+            (setq flyspell-generic-check-word-predicate
+                  'mastodon-toot-mode-flyspell-verify)))
+
 ;;;###autoload
-(add-hook 'mastodon-toot-mode-hook #'mastodon-profile--fetch-server-account-settings-maybe)
+(add-hook 'mastodon-toot-mode-hook
+          #'mastodon-profile--fetch-server-account-settings-maybe)
 
 ;; disable auto-fill-mode:
 (add-hook 'mastodon-toot-mode-hook