From 25f8929c91050332f972dca42862e65bc22608b3 Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Thu, 12 Feb 2015 20:32:39 -0200 Subject: Refactor fill-and-fontify to sx-question-mode--insert-markdown --- sx-question-print.el | 94 +++++++++++++++++++++++++++++++--------------------- 1 file changed, 56 insertions(+), 38 deletions(-) (limited to 'sx-question-print.el') diff --git a/sx-question-print.el b/sx-question-print.el index e21c998..e47bc3a 100644 --- a/sx-question-print.el +++ b/sx-question-print.el @@ -246,10 +246,9 @@ DATA can represent a question or an answer." 'face 'sx-question-mode-header)) (sx--wrap-in-overlay '(face sx-question-mode-content-face) + (insert "\n") + (sx-question-mode--insert-markdown .body_markdown) (insert "\n" - (sx-question-mode--fill-and-fontify - .body_markdown) - "\n" (propertize sx-question-mode-separator 'face 'sx-question-mode-header))) ;; Comments have their own `sx--data-here' property (so they can @@ -296,10 +295,13 @@ The comment is indented, filled, and then printed according to (format sx-question-mode-comments-format (sx-user--format "%d" .owner) (substring - ;; We fill with three spaces at the start, so the comment is - ;; slightly indented. - (sx-question-mode--fill-and-fontify - (concat " " .body_markdown)) + ;; We use temp buffer, so that image overlays don't get + ;; inserted with the comment. + (with-temp-buffer + ;; We fill with three spaces at the start, so the comment is + ;; slightly indented. + (sx-question-mode--insert-markdown (concat " " .body_markdown)) + (buffer-string)) ;; Then we remove the spaces from the first line, since we'll ;; add the username there anyway. 3)))))) @@ -345,37 +347,53 @@ E.g.: (>= 2 (any lower numeric "/._%&#?=;")))))) "Regexp matching markdown links.") -(defun sx-question-mode--fill-and-fontify (text) - "Return TEXT filled according to `markdown-mode'." - (with-temp-buffer - (insert text) - (delay-mode-hooks (markdown-mode)) - (font-lock-mode -1) - (when sx-question-mode-bullet-appearance - (font-lock-add-keywords ;; Bullet items. - nil - `((,(rx line-start (0+ blank) (group-n 1 (any "*+-")) blank) - 1 '(face nil display ,sx-question-mode-bullet-appearance) prepend)))) - (font-lock-add-keywords ;; Highlight usernames. - nil - `((,(rx (or blank line-start) - (group-n 1 (and "@" (1+ (not space)))) - symbol-end) - 1 font-lock-builtin-face))) - ;; Everything. - (font-lock-fontify-region (point-min) (point-max)) - ;; Compact links. - (sx-question-mode--process-links-in-buffer) - ;; And now the filling - (goto-char (point-min)) - (while (null (eobp)) - ;; Don't fill pre blocks. - (unless (sx-question-mode--dont-fill-here) - (let ((beg (point))) - (skip-chars-forward "\r\n[:blank:]") - (forward-paragraph) - (fill-region beg (point))))) - (replace-regexp-in-string "[[:blank:]]+\\'" "" (buffer-string)))) +(defun sx-question-mode--process-markdown-in-region (beg end) + "Process Markdown text between BEG and END. +This does not do Markdown font-locking. Instead, it fills text, +propertizes links, inserts images, cleans up html comments, and +font-locks code-blocks according to mode." + (save-restriction + (save-excursion + (narrow-to-region beg end) + ;; Compact links. + (sx-question-mode--process-links-in-buffer) + ;; And now the filling and other handlings. + (goto-char (point-min)) + (while (null (eobp)) + ;; Don't fill pre blocks. + (unless (sx-question-mode--dont-fill-here) + (let ((beg (point))) + (skip-chars-forward "\r\n[:blank:]") + (forward-paragraph) + (fill-region beg (point)))))))) + +(defun sx-question-mode--insert-markdown (text) + "Return TEXT fontified according to `markdown-mode'." + (let ((beg (point))) + (insert + ;; Font-locking needs to be done in a temp buffer, because it + ;; affects the entire buffer even if we narrow. + (with-temp-buffer + (insert text) + (delay-mode-hooks (markdown-mode)) + (font-lock-mode -1) + (when sx-question-mode-bullet-appearance + (font-lock-add-keywords ;; Bullet items. + nil + `((,(rx line-start (0+ blank) (group-n 1 (any "*+-")) blank) + 1 '(face nil display ,sx-question-mode-bullet-appearance) prepend)))) + (font-lock-add-keywords ;; Highlight usernames. + nil + `((,(rx (or blank line-start) + (group-n 1 (and "@" (1+ (not space)))) + symbol-end) + 1 font-lock-builtin-face))) + ;; Everything. + (font-lock-fontify-region (point-min) (point-max)) + (replace-regexp-in-string "[[:blank:]]+\\'" "" (buffer-string)))) + ;; This part can and should be done in place, this way it can + ;; create overlays. + (sx-question-mode--process-markdown-in-region beg (point)))) ;;; Handling links -- cgit v1.2.3 From 9356a6a039f0d8cf8d9f31e42e8007617c58577d Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Thu, 12 Feb 2015 21:06:25 -0200 Subject: Fetch images asynchronously. --- sx-question-print.el | 81 +++++++++++++++++++++++++++------------------------- 1 file changed, 42 insertions(+), 39 deletions(-) (limited to 'sx-question-print.el') diff --git a/sx-question-print.el b/sx-question-print.el index e47bc3a..b5b7201 100644 --- a/sx-question-print.el +++ b/sx-question-print.el @@ -416,30 +416,38 @@ Image links are downloaded and displayed, if (sx-question-mode-find-reference (match-string-no-properties 3) text))) - (full-text (match-string-no-properties 0))) + (full-text (match-string-no-properties 0)) + (image-p (and sx-question-mode-use-images + (eq ?! (elt full-text 0))))) (when (stringp url) (replace-match "") (sx-question-mode--insert-link - (if (and sx-question-mode-use-images (eq ?! (elt full-text 0))) - ;; Is it an image? - (sx-question-mode--create-image url) - ;; Or a regular link - (or (if sx-question-mode-pretty-links text full-text) url)) - url)))))))) - -(defun sx-question-mode--create-image (url) - "Get and create an image from URL. + (unless image-p + (or (if sx-question-mode-pretty-links text full-text) + url)) + url) + (when image-p + (sx-question-mode--create-image url (1- (point))))))))))) + +(defun sx-question-mode--create-image (url point) + "Get and create an image from URL and insert it at POINT. +The image will take the place of the character at POINT. Its size is bound by `sx-question-mode-image-max-width' and `window-body-width'." - (let* ((image - (create-image (sx-request-get-url url) 'imagemagick t)) - (image-width (car (image-size image 'pixels)))) - (append image - (list :width (min sx-question-mode-image-max-width - (window-body-width nil 'pixel) - image-width))))) - -(defun sx-question-mode--insert-link (text-or-image url) + (let* ((ov (make-overlay point (1+ point) (current-buffer) t nil)) + (callback + (lambda (data) + (let* ((image (create-image data 'imagemagick t)) + (image-width (car (image-size image 'pixels)))) + (overlay-put + ov 'display + (append image + (list :width (min sx-question-mode-image-max-width + (window-body-width nil 'pixel) + image-width)))))))) + (sx-request-get-url url callback))) + +(defun sx-question-mode--insert-link (text url) "Return a link propertized version of TEXT-OR-IMAGE. URL is used as 'help-echo and 'url properties." ;; For now, the only way to handle nested links is to remove them. @@ -450,26 +458,21 @@ URL is used as 'help-echo and 'url properties." (replace-match "") (forward-char 1) (delete-char 1))) - (let ((imagep (not (stringp text-or-image)))) - ;; Images need to be at the start of a line. - (when (and imagep (not (looking-at-p "^"))) - (insert "\n")) - (apply #'insert-text-button - (if imagep " " text-or-image) - ;; Mouse-over - 'help-echo - (format sx-button--link-help-echo - (propertize (sx--shorten-url url) - 'face 'font-lock-function-name-face)) - ;; For visiting and stuff. - 'sx-button-url url - 'sx-button-copy url - :type 'sx-button-link - ;; The last argument of `apply' is a list. - (when imagep - `(face default display ,text-or-image))) - ;; Images need to be at the end of a line too. - (insert "\n"))) + ;; Images need to be at the start of a line. + (when (and imagep (not (looking-at-p "^"))) + (insert "\n")) + (insert-text-button (or text " ") + ;; Mouse-over + 'help-echo + (format sx-button--link-help-echo + (propertize (sx--shorten-url url) + 'face 'font-lock-function-name-face)) + ;; For visiting and stuff. + 'sx-button-url url + 'sx-button-copy url + :type 'sx-button-link) + ;; Images need to be at the end of a line too. + (insert "\n")) (defun sx-question-mode-find-reference (id &optional fallback-id) "Find url identified by reference ID in current buffer. -- cgit v1.2.3 From 66af19c7df5b1ef2d3252593b4eb33a101dc1582 Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Thu, 12 Feb 2015 21:48:40 -0200 Subject: fix images --- sx-question-print.el | 9 +++++---- 1 file changed, 5 insertions(+), 4 deletions(-) (limited to 'sx-question-print.el') diff --git a/sx-question-print.el b/sx-question-print.el index 7244a6a..160074d 100644 --- a/sx-question-print.el +++ b/sx-question-print.el @@ -427,7 +427,7 @@ Image links are downloaded and displayed, if url)) url) (when image-p - (sx-question-mode--create-image url (1- (point))))))))))) + (sx-question-mode--create-image url (- (point) 2)))))))))) (defun sx-question-mode--create-image (url point) "Get and create an image from URL and insert it at POINT. @@ -445,7 +445,8 @@ Its size is bound by `sx-question-mode-image-max-width' and (list :width (min sx-question-mode-image-max-width (window-body-width nil 'pixel) image-width)))))))) - (sx-request-get-url url callback))) + (sx-request-get-url url callback) + (overlay-put ov 'face 'default))) (defun sx-question-mode--insert-link (text url) "Return a link propertized version of TEXT-OR-IMAGE. @@ -459,7 +460,7 @@ URL is used as 'help-echo and 'url properties." (forward-char 1) (delete-char 1))) ;; Images need to be at the start of a line. - (when (and imagep (not (looking-at-p "^"))) + (unless (or text (looking-at-p "^")) (insert "\n")) (insert-text-button (or text " ") ;; Mouse-over @@ -472,7 +473,7 @@ URL is used as 'help-echo and 'url properties." 'sx-button-copy url :type 'sx-button-link) ;; Images need to be at the end of a line too. - (insert "\n")) + (unless text (insert "\n"))) (defun sx-question-mode-find-reference (id &optional fallback-id) "Find url identified by reference ID in current buffer. -- cgit v1.2.3 From e19068da5bc6ab29b3a0cd21daed3cf98708df39 Mon Sep 17 00:00:00 2001 From: Artur Malabarba Date: Sun, 15 Feb 2015 12:57:04 -0200 Subject: Fix paragraph filling --- sx-question-print.el | 34 ++++++++++++++++++++-------------- 1 file changed, 20 insertions(+), 14 deletions(-) (limited to 'sx-question-print.el') diff --git a/sx-question-print.el b/sx-question-print.el index 160074d..e42e983 100644 --- a/sx-question-print.el +++ b/sx-question-print.el @@ -352,20 +352,26 @@ E.g.: This does not do Markdown font-locking. Instead, it fills text, propertizes links, inserts images, cleans up html comments, and font-locks code-blocks according to mode." - (save-restriction - (save-excursion - (narrow-to-region beg end) - ;; Compact links. - (sx-question-mode--process-links-in-buffer) - ;; And now the filling and other handlings. - (goto-char (point-min)) - (while (null (eobp)) - ;; Don't fill pre blocks. - (unless (sx-question-mode--dont-fill-here) - (let ((beg (point))) - (skip-chars-forward "\r\n[:blank:]") - (forward-paragraph) - (fill-region beg (point)))))))) + ;; Paragraph filling + (let ((paragraph-start + "\f\\|[ \t]*$\\|[ \t]*[*+-] \\|[ \t]*[0-9]+\\.[ \t]\\|[ \t]*: ") + (paragraph-separate "\\(?:[ \t\f]*\\|.* \\)$") + (adaptive-fill-first-line-regexp "\\`[ \t]*>[ \t]*?\\'") + (adaptive-fill-function #'markdown-adaptive-fill-function)) + (save-restriction + (save-excursion + (narrow-to-region beg end) + ;; Compact links. + (sx-question-mode--process-links-in-buffer) + ;; And now the filling and other handlings. + (goto-char (point-min)) + (while (null (eobp)) + ;; Don't fill pre blocks. + (unless (sx-question-mode--dont-fill-here) + (let ((beg (point))) + (skip-chars-forward "\r\n[:blank:]") + (forward-paragraph) + (fill-region beg (point))))))))) (defun sx-question-mode--insert-markdown (text) "Return TEXT fontified according to `markdown-mode'." -- cgit v1.2.3