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