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 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)