Overview
| Comment: | Process recursive markup correctly |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | ancestors | descendants | both | master | trunk |
| Files: | files | file ages | folders |
| SHA3-256: |
d3eb8c5431942eb46b6b18267dc716c2 |
| User & Date: | zge on 2021-05-28 11:56:22 |
| Other Links: | branch diff | manifest | tags |
Context
|
2021-05-28
| ||
| 11:58 | Add sbbs-open-at-last-post for compose buffers check-in: 651e7552b5 user: zge tags: master, trunk | |
| 11:56 | Process recursive markup correctly check-in: d3eb8c5431 user: zge tags: master, trunk | |
| 10:53 | Fix checkdoc complaints check-in: 6673da2ac4 user: zge tags: master, trunk | |
Changes
Modified sbbs.el from [8aac24173f] to [1d77173350].
| ︙ | ︙ | |||
266 267 268 269 270 271 272 |
(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)))))))
| | | | 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 |
(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))))))
| < | | | > > | | | | | | > | | > | | > | | > | | | | | | > > > > > > > | > > > > > > > > > > > > | 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)
|
| ︙ | ︙ |