Function: faceup-render-to-buffer

faceup-render-to-buffer is a byte-compiled function defined in faceup.el.gz.

Signature

(faceup-render-to-buffer TO-BUFFER &optional BUFFER)

Documentation

Convert BUFFER containing faceup markup into text with faces in TO-BUFFER.

Source Code

;; Defined in /usr/src/emacs/lisp/emacs-lisp/faceup.el.gz
(defun faceup-render-to-buffer (to-buffer &optional buffer)
  "Convert BUFFER containing faceup markup into text with faces in TO-BUFFER."
  (with-current-buffer (or buffer (current-buffer))
    (goto-char (point-min))
    (let ((last-point (point))
          (state '())                   ; List of (prop . element)
          (not-markup (concat
                       "^"
                       (make-string 1 faceup-markup-start-char)
                       (make-string 1 faceup-markup-end-char))))
      (while (progn
               (skip-chars-forward not-markup)
               (if (not (eq last-point (point)))
                   (let ((text (buffer-substring-no-properties
                                last-point (point)))
                         (prop-elements-alist '()))
                     ;; Accumulate all values for each property.
                     (dolist (prop-element state)
                       (let ((property (car prop-element))
                             (element (cdr prop-element)))
                         (let ((pair (assq property prop-elements-alist)))
                           (unless pair
                             (setq pair (cons property '()))
                             (push pair prop-elements-alist))
                           (push element (cdr pair)))))
                     ;; Apply all properties.
                     (dolist (pair prop-elements-alist)
                       (let ((property (car pair))
                             (elements (reverse (cdr pair))))
                         ;; Create one of:
                         ;;    (property element) or
                         ;;    (property (element element ...))
                         (when (eq (length elements) 1)
                           ;; This ensures that non-face-like
                           ;; properties are restored to their
                           ;; original state.
                           (setq elements (car elements)))
                         (add-text-properties 0 (length text)
                                              (list property elements)
                                              text)))
                     (with-current-buffer to-buffer
                       (insert text))
                     (setq last-point (point))))
               (not (eobp)))
        (if (eq (following-char) faceup-markup-start-char)
            ;; Start marker.
            (progn
              (forward-char)
              (if (or (eq (following-char) faceup-markup-start-char)
                      (eq (following-char) faceup-markup-end-char))
                  ;; Escaped markup character.
                  (progn
                    (setq last-point (point))
                    (forward-char))
                ;; Markup sequence.
                (let ((property faceup-default-property))
                  (when (eq (following-char) ?\( )
                    (forward-char)      ; "("
                    (let ((p (point)))
                      (forward-sexp)
                      (setq property (intern (buffer-substring p (point)))))
                    (forward-char))     ; ")"
                  (let ((element
                         (if (eq (following-char) ?:)
                             ;; :element:
                             (progn
                               (forward-char)
                               (prog1
                                   (let ((p (point)))
                                     (forward-sexp)
                                     ;; Note: (read (current-buffer))
                                     ;; doesn't work, as it reads more
                                     ;; than a sexp.
                                     (read (buffer-substring p (point))))
                                 (forward-char)))
                           ;; X:
                           (prog1
                               (car (rassoc (buffer-substring-no-properties
                                             (point) (+ (point) 1))
                                            faceup-face-short-alist))
                             (forward-char 2)))))
                    (push (cons property element) state)))
                (setq last-point (point))))
          ;; End marker.
          (pop state)
          (forward-char)
          (setq last-point (point)))))))