Differences From
Artifact [8aac24173f]:
266 266 (sbbs--read-jump-to (apply #'min spec)))
267 267 (let ((point (point)))
268 268 (when sbbs-jump-to-link
269 269 (forward-button 1)
270 270 (when (invisible-p (point))
271 271 (goto-char point)))))))
272 272
273 -(defun sbbs--insert-link (text link)
274 - "Insert link to LINK as TEXT into buffer.
273 +(defun sbbs--process-link (text link)
274 + "Process TEXT that refers to LINK.
275 275
276 276 If LINK is a (board, thread or site) local link, modify opening
277 277 behaviour accordingly."
278 278 (save-match-data
279 279 (let ((match (string-match sbbs--link-regexp link))
280 280 range id other)
281 281 (when match
................................................................................
300 300 (sbbs-view-open id range)))
301 301 ;; other thread
302 302 ((/= id sbbs--thread-id)
303 303 (let ((sbbs--board board))
304 304 (sbbs-view-open id range)))
305 305 ;; this thread
306 306 (range (sbbs--limit-to-range range))))))
307 - (insert-button (propertize text 'face 'sbbs--variable-pitch)
308 - 'action func 'sbbs-ref range)))))
307 + (propertize text 'action func 'sbbs-ref range)))))
308 +
309 +(defun sbbs--process-sxml (sxml)
310 + "Process SXML into a formatted string."
311 + (message "%S" sxml)
312 + (let (processed)
313 + (dolist (it (if (listp sxml) sxml (list sxml)))
314 + (push (cond ((stringp it)
315 + (propertize it 'face 'sbbs--variable-pitch))
316 + ((eq (car it) 'br)
317 + "\n")
318 + ((eq (car it) 'b)
319 + (propertize (sbbs--process-sxml (cdr it))
320 + 'face '(bold sbbs--variable-pitch)))
321 + ((eq (car it) 'i)
322 + (propertize (sbbs--process-sxml (cdr it))
323 + 'face '(italic sbbs--variable-pitch)))
324 + ((eq (car it) 'code)
325 + (propertize (sbbs--process-sxml (cdr it))
326 + 'face 'fixed-pitch))
327 + ((eq (car it) 'del)
328 + (propertize (sbbs--process-sxml (cdr it))
329 + 'face 'sbbs--spoiler-face))
330 + ((eq (car it) 'a)
331 + (let* ((text (sbbs--process-sxml (caddr it)))
332 + (link (plist-get (cadadr it) 'href)))
333 + (sbbs--process-link text link)))
334 + (t (prin1-to-string it)))
335 + processed))
336 + (apply #'concat (nreverse processed))))
309 337
310 338 (defun sbbs--insert-sxml-par (sxml)
311 339 "Insert paragraph contents SXML at point."
312 - (dolist (it sxml)
313 - (cond ((stringp it)
314 - (insert (propertize it 'face 'sbbs--variable-pitch)))
315 - ((eq (car it) 'br)
316 - (newline))
317 - ((eq (car it) 'b)
318 - (insert (propertize (cadr it) 'face '(bold sbbs--variable-pitch))))
319 - ((eq (car it) 'i)
320 - (insert (propertize (cadr it) 'face '(italic sbbs--variable-pitch))))
321 - ((eq (car it) 'code)
322 - (insert (propertize (cadr it) 'face 'fixed-pitch)))
323 - ((eq (car it) 'del)
324 - (insert (propertize (cadr it) 'face 'sbbs--spoiler-face)))
325 - ((eq (car it) 'a)
326 - (let* ((text (caddr it))
327 - (link (plist-get (cadadr it) 'href)))
328 - (sbbs--insert-link text link)))
329 - (t (insert (prin1-to-string it)))))
330 - (insert ?\n))
340 + (save-restriction
341 + (narrow-to-region (point) (point))
342 + (insert (sbbs--process-sxml sxml))
343 + (let (match)
344 + (goto-char (point-min))
345 + (while (setq match (text-property-search-forward 'action))
346 + ;; Buttons use overlays that cannot be passed in
347 + ;; strings. Therefore whenever a `activity' property was
348 + ;; inserted into the buffer, `make-button' has to be called
349 + ;; once more to add the actual overlay.
350 + (make-button (prop-match-beginning match)
351 + (prop-match-end match)
352 + 'action (prop-match-value match)))
353 + (goto-char (point-max)))
354 + (newline)))
331 355
332 356 (defun sbbs--insert-sxml (sxml)
333 357 "Insert top level SXML into buffer at point."
334 358 (dolist (par sxml)
335 359 (cond ((eq (car par) 'p)
336 360 (sbbs--insert-sxml-par (cdr par)))
337 361 ((eq (car par) 'blockquote)