;;; sx-question-print.el --- populating the question-mode buffer with content -*- lexical-binding: t; -*- ;; Copyright (C) 2014 Artur Malabarba ;; Author: Artur Malabarba ;; This program is free software; you can redistribute it and/or modify ;; it under the terms of the GNU General Public License as published by ;; the Free Software Foundation, either version 3 of the License, or ;; (at your option) any later version. ;; This program is distributed in the hope that it will be useful, ;; but WITHOUT ANY WARRANTY; without even the implied warranty of ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the ;; GNU General Public License for more details. ;; You should have received a copy of the GNU General Public License ;; along with this program. If not, see . ;;; Commentary: ;;; Code: (require 'markdown-mode) (require 'sx-button) (require 'sx) (require 'sx-question) (require 'sx-babel) (require 'sx-user) (defvar sx-question-mode--data) (defgroup sx-question-mode nil "Customization group for sx-question-mode." :prefix "sx-question-mode-" :tag "SX Question Mode" :group 'sx) (defgroup sx-question-mode-faces '((sx-user custom-group)) "Customization group for the faces of `sx-question-mode'. Some faces of this mode might be defined in the `sx-user' group." :prefix "sx-question-mode-" :tag "SX Question Mode Faces" :group 'sx-question-mode) ;;; Faces and Variables (defface sx-question-mode-header '((t :inherit font-lock-variable-name-face)) "Face used on the question headers in the question buffer." :group 'sx-question-mode-faces) (defface sx-question-mode-title '((t :weight bold :inherit default)) "Face used on the question title in the question buffer." :group 'sx-question-mode-faces) (defface sx-question-mode-title-comments '((t :inherit sx-question-mode-title)) "Face used on the question title in the question buffer." :group 'sx-question-mode-faces) (defcustom sx-question-mode-header-title "\n" "String used before the question title at the header." :type 'string :group 'sx-question-mode) (defcustom sx-question-mode-header-author-format "\nAuthor: %d %r" "String used to display the question author at the header. % constructs have special meaning here. See `sx-user--format'." :type 'string :group 'sx-question-mode) (defface sx-question-mode-date '((t :inherit font-lock-string-face)) "Face used on the question date in the question buffer." :group 'sx-question-mode-faces) (defcustom sx-question-mode-header-date "\nPosted on: " "String used before the question date at the header." :type 'string :group 'sx-question-mode) (defface sx-question-mode-score '((t)) "Face used for the score in the question buffer." :group 'sx-question-mode-faces) (defface sx-question-mode-score-downvoted '((t :inherit (font-lock-warning-face sx-question-mode-score))) "Face used for downvoted score in the question buffer." :group 'sx-question-mode-faces) (defface sx-question-mode-score-upvoted '((t :weight bold :inherit (font-lock-function-name-face sx-question-mode-score))) "Face used for downvoted score in the question buffer." :group 'sx-question-mode-faces) (defcustom sx-question-mode-header-tags "\nTags: " "String used before the question tags at the header." :type 'string :group 'sx-question-mode) (defcustom sx-question-mode-header-score "\nScore: " "String used before the question score at the header." :type 'string :group 'sx-question-mode) (defface sx-question-mode-content-face '((((background dark)) :background "#090909") (((background light)) :background "#f4f4f4")) "Face used on the question body in the question buffer. This shouldn't have a foreground, or this will interfere with font-locking." :group 'sx-question-mode-faces) (defcustom sx-question-mode-last-edit-format " (edited %s ago by %s)" "Format used to describe last edit date in the header. First \"%s\" is replaced with the date and the second \"%s\" with the editor's name." :type 'string :group 'sx-question-mode) (defcustom sx-question-mode-separator (concat (propertize (make-string 72 ?\s) 'face '(underline sx-question-mode-header)) "\n") "Separator used between header and body." :type 'string :group 'sx-question-mode) (defcustom sx-question-mode-answer-title "Answer" "Title used at the start of \"Answer\" sections." :type 'string :group 'sx-question-mode) (defface sx-question-mode-accepted '((((background dark)) :foreground "LimeGreen" :height 1.3 :inherit sx-question-mode-title) (((background light)) :foreground "ForestGreen" :height 1.3 :inherit sx-question-mode-title)) "Face used for accepted answers in the question buffer." :group 'sx-question-mode-faces) (defface sx-question-mode-closed '((t :box 2 :inherit font-lock-warning-face)) "Face used for closed question header in the question buffer." :group 'sx-question-mode-faces) (defface sx-question-mode-closed-reason `((t :box (:line-width 2 :color ,(face-attribute 'sx-question-mode-closed :foreground nil t)) :inherit sx-question-mode-title)) "Face used for closed question header in the question buffer. Aesthetically, it's important that the color of this face's :box attribute match the color of the face `sx-question-mode-closed'." :group 'sx-question-mode-faces) (defcustom sx-question-mode-answer-accepted-title "Accepted Answer" "Title used at the start of accepted \"Answer\" section." :type 'string :group 'sx-question-mode) (defcustom sx-question-mode-comments-title " Comments" "Title used at the start of \"Comments\" sections." :type 'string :group 'sx-question-mode) (defcustom sx-question-mode-comments-format "%s: %s\n" "Format used to display comments. First \"%s\" is replaced with user name. Second \"%s\" is replaced with the comment." :type 'string :group 'sx-question-mode) (defcustom sx-question-mode-pretty-links t "If non-nil, markdown links are displayed in a compact form." :type 'boolean :group 'sx-question-mode) (defconst sx-question-mode--sort-methods (let ((methods '(("Higher-scoring" . sx-answer-higher-score-p) ("Newer" . sx-answer-newer-p) ("More active" . sx-answer-more-active-p)))) (append (mapcar (lambda (x) (cons (concat (car x) " first") (cdr x))) methods) (mapcar (lambda (x) (cons (concat (car x) " last") (sx--invert-predicate (cdr x)))) methods)))) (defcustom sx-question-mode-answer-sort-function #'sx-answer-higher-score-p "Function used to sort answers in the question buffer." :type (cons 'choice (mapcar (lambda (x) `(const :tag ,(car x) ,(cdr x))) sx-question-mode--sort-methods)) :group 'sx-question-mode) (defcustom sx-question-mode-use-images (image-type-available-p 'imagemagick) "Non-nil if SX should download and display images. By default, this is `t' if the `imagemagick' image type is available (checked with `image-type-available-p'). If this image type is not available, images won't work." :type 'boolean :group 'sx-question-mode) (defcustom sx-question-mode-image-max-width 550 "Maximum width, in pixels, of images in the question buffer." :type 'integer :group 'sx-question-mode) ;;; Functions ;;;; Printing the general structure (defconst sx-question-mode--closed-mode-line-string '(:propertize " [CLOSED] " face font-lock-warning-face) "String indicating closed questions in the mode-line.") (defun sx-question-mode--print-question (question) "Print a buffer describing QUESTION. QUESTION must be a data structure returned by `json-read'." (when (sx--deleted-p question) (sx-user-error "This is a deleted question")) (setq sx-question-mode--data question) ;; Clear the overlays (mapc #'delete-overlay sx--overlays) (setq sx--overlays nil) ;; Print everything (sx-assoc-let question (when .closed_reason (add-to-list 'mode-line-format sx-question-mode--closed-mode-line-string) (sx-question-mode--print-close-reason .closed_reason .closed_date .closed_details)) (sx-question-mode--print-section question) (mapc #'sx-question-mode--print-section (cl-remove-if #'sx--deleted-p (cl-sort .answers sx-question-mode-answer-sort-function)))) (insert "\n\n ") (insert-text-button "Write an Answer" :type 'sx-button-answer) ;; Go up (goto-char (point-min)) (sx-question-mode-next-section)) (defun sx-question-mode--print-close-reason (reason date &optional details) "Print a header explaining REASON and DATE. DATE is an integer. DETAILS, when given is an alist further describing the close." (let ((l (point))) (let-alist details (insert "\n " (propertize (format " %s as %s, %s ago. " (if .on_hold "Put on hold" "Closed") reason (sx-time-since date)) 'face 'sx-question-mode-closed) "\n") (when .description (insert (replace-regexp-in-string "<[^>]+>" "" .description) "\n"))) (save-excursion (goto-char l) (search-forward " as " nil 'noerror) (setq l (point)) (skip-chars-forward "^,") (let ((ov (make-overlay l (point)))) (overlay-put ov 'face 'sx-question-mode-closed-reason) (push ov sx--overlays))))) (defun sx-question-mode--maybe-print-accept-button () "Print accept button if you own this question." (when (sx-assoc-let sx-question-mode--data (ignore-errors (= .owner.user_id (cdr (assq 'user_id (sx-network-user .site_par)))))) (insert " ") (insert-text-button "Accept" :type 'sx-button-accept))) (defun sx-question-mode--print-section (data) "Print a section corresponding to DATA. DATA can represent a question or an answer." ;; This makes `data' accessible through `sx--data-here'. (sx--wrap-in-overlay (list 'sx--data-here data) (sx-assoc-let data (insert sx-question-mode-header-title) (insert-text-button ;; Questions have title, Answers don't (cond (.title) (.is_accepted sx-question-mode-answer-accepted-title) (t sx-question-mode-answer-title)) ;; Section level 'sx-question-mode--section (if .title 1 2) 'sx-button-copy .share_link 'face (if .is_accepted 'sx-question-mode-accepted 'sx-question-mode-title) :type 'sx-question-mode-title) (when (not (or .title .is_accepted)) (sx-question-mode--maybe-print-accept-button)) ;; Sections can be hidden with overlays (sx--wrap-in-overlay '(sx-question-mode--section-content t) ;; Author (insert (sx-user--format (propertize sx-question-mode-header-author-format 'face 'sx-question-mode-header) .owner)) ;; Date (sx-question-mode--insert-header sx-question-mode-header-date (concat (sx-time-seconds-to-date .creation_date) (when .last_edit_date (format sx-question-mode-last-edit-format (sx-time-since .last_edit_date) (sx-user--format "%d" .last_editor)))) 'sx-question-mode-date) ;; Score and upvoted/downvoted status. (sx-question-mode--insert-header sx-question-mode-header-score (format "%s%s" .score (cond (.upvoted "↑") (.downvoted "↓") (t ""))) (cond (.upvoted 'sx-question-mode-score-upvoted) (.downvoted 'sx-question-mode-score-downvoted) (t 'sx-question-mode-score))) ;; Tags (when .title ;; Tags (sx-question-mode--insert-header sx-question-mode-header-tags (sx-tag--format-tags .tags .site_par) nil)) ;; Body (insert "\n" sx-question-mode-separator) (sx--wrap-in-overlay '(face sx-question-mode-content-face) (insert "\n") (sx-question-mode--insert-markdown .body_markdown) (insert "\n" sx-question-mode-separator)) ;; Clean up commments manually deleted. The `append' call is ;; to ensure `comments' is a list and not a vector. (let ((comments (cl-remove-if #'sx--deleted-p .comments))) (when comments (insert "\n") (insert-text-button sx-question-mode-comments-title 'face 'sx-question-mode-title-comments 'sx-question-mode--section 3 'sx-button-copy .share_link :type 'sx-question-mode-title) (sx--wrap-in-overlay '(sx-question-mode--section-content t) (insert "\n") (sx--wrap-in-overlay '(face sx-question-mode-content-face) ;; Comments have their own `sx--data-here' property (so they can ;; be upvoted too). (mapc #'sx-question-mode--print-comment comments)) ;; If there are comments, we want part of this margin to go ;; inside them, so the button get's placed beside the ;; "Comments" header when you hide them. (insert " "))) ;; If there are no comments, we have to add this margin here. (unless comments (insert " "))) (insert " ") ;; This is where the "add a comment" button is printed. (insert-text-button "Add a Comment" :type 'sx-button-comment) (insert "\n"))))) (defun sx-question-mode--print-comment (comment-data) "Print the comment described by alist COMMENT-DATA. The comment is indented, filled, and then printed according to `sx-question-mode-comments-format'." (sx--wrap-in-overlay (list 'sx--data-here comment-data) (sx-assoc-let comment-data (when (and (numberp .score) (> .score 0)) (insert (number-to-string .score) (if .upvoted "^" "") " ")) (insert (format sx-question-mode-comments-format (sx-user--format "%d" .owner) (substring ;; 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 " " (sx--squash-whitespace .body_markdown))) (buffer-string)) ;; Then we remove the spaces from the first line, since we'll ;; add the username there anyway. 3)))))) (defun sx-question-mode--insert-header (&rest args) "Insert propertized ARGS. ARGS is a list of repeating values -- `header', `value', and `face'. `header' is given `sx-question-mode-header' as a face, where `value' is given `face' as its face. \(fn HEADER VALUE FACE [HEADER VALUE FACE] [HEADER VALUE FACE] ...)" (while args (insert (propertize (pop args) 'face 'sx-question-mode-header) (let ((header (pop args)) (face (pop args))) (if face (propertize header 'face face) header))))) ;;;; Printing and Font-locking the content (body) (defvar sx-question-mode-bullet-appearance (propertize (if (char-displayable-p ?•) "•" "*") 'face 'markdown-list-face) "String to be displayed as the bullet of markdown list items.") (defconst sx-question-mode--reference-regexp (rx line-start (0+ blank) "[%s]:" (0+ blank) (group-n 1 (1+ (not (any blank "\n\r"))))) "Regexp used to find the url of labeled links. E.g.: [1]: https://...") (defconst sx-question-mode--link-regexp ;; Done at compile time. (rx (or (and "[" (optional (group-n 6 "meta-")) "tag:" (group-n 5 (+ (not (any " ]")))) "]") (and (opt "!") "[" (group-n 1 (1+ (not (any "[]")))) "]" (or (and "(" (group-n 2 (1+ (not (any ")")))) ")") (and "[" (group-n 3 (1+ (not (any "]")))) "]"))) (group-n 4 (and "http" (opt "s") "://" (>= 2 (any lower numeric "_%")) "." (>= 2 (any lower numeric "_%")) (* (any lower numeric "-/._%&#?=;")))))) "Regexp matching markdown links.") (defun sx-question-mode--process-line-breaks (beg end-marker) "Process Markdown line breaks between BEG and END-MARKER. Double space at the end of a line becomes an invisible \"\\n\". Consecutive blank lines beyond the first are consensed. Assumes `marker-insertion-type' of END-MARKER is t." (goto-char beg) (while (search-forward-regexp (rx line-start (* blank) "\n" (group-n 1 (+ (any blank "\n")))) end-marker 'noerror) ;; An invisible newline ensures the previous text ;; will get filled as a separate paragraph. (replace-match "" nil nil nil 1)) (goto-char beg) (while (search-forward-regexp " $" end-marker 'noerror) ;; An invisible newline ensures the previous text ;; will get filled as a separate paragraph. (replace-match (propertize "\n" 'invisible t)))) (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." ;; 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 (narrow-to-region beg end) ;; html tags can span many paragraphs, so we handle them ;; globally first. (sx-question-mode--process-html-tags (point-min) (copy-marker (point-max))) ;; 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) (let ((end (point-marker))) (set-marker-insertion-type end t) ;; Turn markdown linebreaks into their final form (sx-question-mode--process-line-breaks beg end) ;; Compactify links by paragraph, so we don't linkify ;; inside code-blocks. This will still linkify inside ;; code tags, unfortunately. (sx-question-mode--process-links beg end) ;; Filling is done after all of the above, since those ;; steps change the length of text. (fill-region beg end) (goto-char end))))) (goto-char (point-max))))) (defconst sx-question-mode-hr (propertize (make-string 72 ?―) 'face 'markdown-header-rule-face)) (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) ;; Trim whitespace (goto-char (point-max)) (skip-chars-backward "\r\n[:blank:]") (delete-region (point) (point-max)) (goto-char (point-min)) (skip-chars-forward "\r\n[:blank:]") (forward-line 0) (delete-region (point-min) (point)) ;; Font lock (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) ("^---+$" 0 '(face nil display ,sx-question-mode-hr)))) ;; 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)))) ;;; HTML tags (defconst sx-question-mode--html-tag-regexp (rx "<" (group-n 1 "%s") (* (not (any ">"))) ">")) (defface sx-question-mode-sub-sup-tag '((t :height 0.7)) "Face used on and tags." :group 'sx-question-mode-faces) (defface sx-question-mode-kbd-tag '((((background dark)) :height 0.9 :weight semi-bold :box (:line-width 3 :style released-button :color "gray30")) (((background light)) :height 0.9 :weight semi-bold :box (:line-width 3 :style released-button :color "gray70"))) "Face used on tags." :group 'sx-question-mode-faces) (defun sx-question-mode--inside-code-p () "Return non-nil if point is inside code. This can be inline Markdown code or a Markdown code-block." (save-match-data (or (markdown-code-at-point-p) (save-excursion (sx-question-mode--skip-and-fontify-pre 'dont-fontify))))) (defun sx-question-mode--standalone-tag-p (string) "Return non-nil if STRING ends in \"/>\"." (string-match "/[[:blank:]]*>\\'" string)) (defun sx-question-mode--next-tag (tag &optional closing end) "Move point to the next occurrence of html TAG, or return nil. Don't move past END. If CLOSING is non-nil, find a closing tag." (search-forward-regexp (format sx-question-mode--html-tag-regexp (if closing (concat "/[[:blank:]]*" tag) tag)) end 'noerror)) (defun sx-question-mode--process-html-tags (beg end-marker) "Hide all html tags between BEG and END and possibly interpret them. END-MARKER should be a marker." ;; This code understands nested html, but not if the same tag is ;; nested in itself (e.g., ). (set-marker-insertion-type end-marker t) (goto-char beg) (while (sx-question-mode--next-tag "[[:alpha:]]+" nil end-marker) (unless (sx-question-mode--inside-code-p) (let ((tag (match-string 1)) (full (match-string 0)) (l (match-beginning 0))) (replace-match "") (pcase tag (`"hr" (unless (looking-at-p "^") (insert "\n")) (insert (propertize "---" 'display sx-question-mode-hr)) (unless (eq (char-after) ?\n) (insert "\n"))) (`"br" (insert "\n "))) (when (and (not (sx-question-mode--standalone-tag-p full)) (sx-question-mode--next-tag tag 'closing)) (let ((r (copy-marker (match-beginning 0)))) ;; The code tag is special, because it quotes everything inside. (if (string= tag "code") (progn (replace-match "`") (save-excursion (goto-char l) (insert "`"))) (replace-match "") ;; Handle stuff between the two tags. (save-match-data (sx-question-mode--process-html-tags l r)) (pcase tag (`"kbd" (add-text-properties l r '(face sx-question-mode-kbd-tag)) (when (looking-at-p (format sx-question-mode--html-tag-regexp "kbd")) (insert " "))) (`"sub" (add-text-properties l r '(face sx-question-mode-sub-sup-tag display (raise -0.3)))) (`"sup" (add-text-properties l r '(face sx-question-mode-sub-sup-tag display (raise +0.3)))))))))))) ;;; Handling links (defun sx-question-mode--process-links (beg end-marker) "Turn all markdown links between BEG and ENG into compact format. Image links are downloaded and displayed, if `sx-question-mode-use-images' is non-nil. Assumes `marker-insertion-type' of END-MARKER is t." (goto-char beg) (while (search-forward-regexp sx-question-mode--link-regexp end-marker t) ;; Tags are tag-buttons. (let ((tag (match-string-no-properties 5))) (if (and tag (> (length tag) 0)) (progn (replace-match "") (sx-tag--insert tag)) ;; Other links are link-buttons. (let* ((text (match-string-no-properties 1)) (url (or (match-string-no-properties 2) (match-string-no-properties 4) (sx-question-mode-find-reference (match-string-no-properties 3) text))) (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 (cond (image-p (sx-question-mode--create-image url)) ((and sx-question-mode-pretty-links text)) ((not text) (sx--shorten-url url)) (t full-text)) url))))))) (defun sx-question-mode--create-image (url) "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* ((ov (make-overlay (point) (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) (overlay-put ov 'face 'default) ov)) (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." ;; Try to handle an image/link inside another link. (when (eq (char-before) ?\[) (insert "a") (forward-char -2) (if (looking-at sx-question-mode--link-regexp) (progn (setq url (or (match-string-no-properties 2) (match-string-no-properties 4) (sx-question-mode-find-reference (match-string-no-properties 3) (if (stringp text) text "¶")) url)) (replace-match "")) (forward-char 1) (delete-char 1))) (unless (stringp text) ;; Images need to be at the start of a line. (unless (looking-at-p "^") (insert "\n")) ;; And need an empty line above so they don't get wrapped into ;; text when we do filling. (insert (propertize "\n" 'display ""))) ;; Insert the link button. (insert-text-button (if (stringp text) text "¶") ;; Mouse-over 'help-echo (format sx-button--link-help-echo ;; If TEXT is a shortened url, we don't shorten URL. (propertize (if (and (stringp text) (string-match "^https?:" text)) url (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. (unless (stringp text) (move-overlay text (1- (point)) (point) (current-buffer)) (insert (propertize "\n\n" 'display "\n")))) (defun sx-question-mode-find-reference (id &optional fallback-id) "Find url identified by reference ID in current buffer. If ID is nil, use FALLBACK-ID instead." (save-excursion (save-match-data (goto-char (point-min)) (when (search-forward-regexp (format sx-question-mode--reference-regexp (or id fallback-id)) nil t) (match-string-no-properties 1))))) ;;; Things we don't fill (defun sx-question-mode--dont-fill-here () "If text shouldn't be filled here, return t and skip over it." (catch 'sx-question-mode-done (let ((before (point))) (skip-chars-forward "\r\n[:blank:]") (let ((first-non-blank (point))) (dolist (it '(sx-question-mode--skip-and-fontify-pre sx-question-mode--skip-headline sx-question-mode--skip-references sx-question-mode--skip-comments)) ;; If something worked, keep point where it is and return t. (if (funcall it) (throw 'sx-question-mode-done t) ;; Before calling each new function. Go back to the first ;; non-blank char. (goto-char first-non-blank))) ;; If nothing matched, go back to the very beginning. (goto-char before) ;; And return nil nil)))) (defun sx-question-mode--skip-and-fontify-pre (&optional dont-fontify) "If there's a pre block ahead, handle it, skip it and return t. Handling means to turn it into a button and remove erroneous font-locking. If DONT-FONTIFY is non-nil, just return the result and possibly move point, don't create the code-block button." (let ((beg (line-beginning-position))) ;; To identify code-blocks we need to be at start of line. (goto-char beg) (when (fboundp 'markdown-syntax-propertize) (markdown-syntax-propertize (point) (point-max))) (when (markdown-match-pre-blocks (line-end-position)) (unless dont-fontify (sx-babel--make-pre-button beg (point))) t))) (defun sx-question-mode--skip-comments () "If there's an html comment ahead, skip it and return t." ;; @TODO: Handle the comment. ;; "Handling means to store any relevant metadata it might be holding." (let ((end (save-excursion (when (markdown-match-comments (line-end-position)) (point))))) (when end (delete-region (point) end) (skip-chars-backward "[:blank:]") (when (looking-at "^[:blank:]*\n") (replace-match "")) t))) (defun sx-question-mode--skip-headline () "If there's a headline ahead, skip it and return non-nil." (when (or (looking-at-p "^#+ ") (progn (forward-line 1) (looking-at-p "===\\|---"))) ;; Returns non-nil. (forward-line 1))) (defun sx-question-mode--skip-references () "If there's a reference ahead, skip it and return non-nil." (forward-line 0) (when (looking-at-p (format sx-question-mode--reference-regexp ".+")) ;; Returns non-nil (forward-paragraph 1) t)) (provide 'sx-question-print) ;;; sx-question-print.el ends here ;; Local Variables: ;; indent-tabs-mode: nil ;; End: