Differences From
Artifact [a3702196fd]:
134 134 (sbbs--board-protocol board)
135 135 (sbbs--board-domain board)
136 136 (if api-p "sexp/" "")
137 137 (sbbs--board-name board)
138 138 (or path ""))))
139 139
140 140 (defun sbbs--list-boards ()
141 + "Return a list of known board objects."
141 142 (let (boards)
142 143 (dolist (ent sbbs-boards)
143 144 (dolist (board (cadr ent))
144 145 (push (sbbs-make-board (car ent) board (caddr ent))
145 146 boards)))
146 147 boards))
147 148
................................................................................
195 196 (mapcar
196 197 (lambda (range)
197 198 (cond ((string-match "\\`\\([[:digit:]]+\\)-\\([[:digit:]]+\\)\\'" range)
198 199 (number-sequence (string-to-number (match-string 1 range))
199 200 (min limit (string-to-number (match-string 2 range)))))
200 201 ((string-match "\\`\\([[:digit:]]+\\)\\'" range)
201 202 (list (string-to-number (match-string 1 range))))
202 - (t (error "invalid range"))))
203 + (t (error "Invalid range"))))
203 204 (split-string desc ",")))))
204 205
205 206 (defun sbbs--read-jump-to (nr)
206 207 "Set point to first character of post with number NR."
207 208 (let ((up (point-min)) (down (point-max)) current)
208 209 (while (progn
209 210 (goto-char (+ up (/ (- down up) 2)))
................................................................................
359 360 (newline 2)
360 361 (add-text-properties start (1- (point)) '(face sbbs--post-header-face))
361 362 (set-text-properties (1- (point)) (point) nil)
362 363 (sbbs--insert-sxml (cdr (assq 'content (cdr post))))
363 364 (add-text-properties start (point) (list 'sbbs-thread-nr (car post)))))
364 365
365 366 (defun sbbs--uncover-spoiler ()
366 - ""
367 + "Uncover or cover a spoiler, depending on the point."
367 368 (cond ((eq (get-text-property (point) 'face) 'sbbs--spoiler-face)
368 369 (let* ((start (previous-property-change (1+ (point))))
369 370 (end (next-property-change (point)))
370 371 (o (make-overlay start end (current-buffer) t t)))
371 372 (overlay-put o 'face 'sbbs--uncover-spoiler-face)
372 373 (overlay-put o 'sbbs-uncover-p t))
373 374 (setq sbbs--last-spoiler (point)))
................................................................................
384 385 (save-excursion
385 386 ;; see http://textboard.org/prog/39/263
386 387 (set-buffer-multibyte nil)
387 388 (while (search-forward-regexp
388 389 ;; rx generates a multibyte string, that confuses
389 390 ;; search-forward-regexp, therefore the regexp literal
390 391 ;; here
391 - "[\x80-\xff]\\(\\(?:\\\\[0-7]\\{3\\}\\)+\\)"
392 + "[\x80-\xff]\\(\\(?:\\\\[0-7]\\{3\\}\\)+\\)"
392 393 nil t)
393 394 (let (new)
394 395 (goto-char (match-beginning 1))
395 396 (while (< (point) (match-end 1))
396 397 (push (string-to-number (buffer-substring
397 398 (+ (point) 1)
398 399 (+ (point) 4))
................................................................................
404 405 (set-buffer-multibyte t)
405 406 (decode-coding-region (point) (point-max)
406 407 'utf-8))
407 408
408 409 (defun sbbs--board-loader (status buf)
409 410 "Callback function for `url-retrieve' when loading board.
410 411
411 -Load results into buffer BUF. STATUS is used to check for
412 +Load results into buffer BUF. STATUS is used to check for
412 413 errors."
413 414 (when (buffer-live-p buf)
414 415 (when (plist-get status :error)
415 416 (error "Error while loading: %s"
416 417 (cdr (plist-get status :error))))
417 418 (forward-paragraph)
418 419 (sbbs--fix-encoding)
................................................................................
434 435 (tabulated-list-print t t)
435 436 (hl-line-highlight))))))
436 437
437 438 (defun sbbs--thread-loader (status id buf range)
438 439 "Callback function for `url-retrieve' when loading thread.
439 440
440 441 The attribute ID determines what thread from board BOARD to
441 -load. STATUS is used to check for errors."
442 +load. STATUS is used to check for errors."
442 443 (when (buffer-live-p buf)
443 444 (when (plist-get status :error)
444 445 (error "Error while loading: %s"
445 446 (cdr (plist-get status :error))))
446 447 (prog-mode)
447 448 (forward-paragraph)
448 449 (sbbs--fix-encoding)
................................................................................
479 480 "Show all hidden posts."
480 481 (interactive)
481 482 (sbbs-show-pop -1))
482 483
483 484 (defun sbbs-show-pop (&optional n)
484 485 "Show all hidden posts.
485 486
486 -A prefix argument N, repeats this N times. If negative or zero,
487 +A prefix argument N, repeats this N times. If negative or zero,
487 488 pop all the way up."
488 489 (interactive "P")
489 490 (let ((n (or n 1)))
490 491 (unless sbbs--limit-stack
491 492 (message "Nothing left to pop"))
492 493 (dotimes (_ (if (> n 0) n (length sbbs--limit-stack)))
493 494 (let ((point (car (pop sbbs--limit-stack))))
................................................................................
506 507 range))
507 508 (setq point (overlay-end overlay)))
508 509 (if range
509 510 (sbbs--limit-to-range range)
510 511 (message "No posts referencing %d" nr))))
511 512
512 513 (defun sbbs-view-open (id &optional range)
513 - "Open thread ID in new buffer."
514 + "Open thread ID in new buffer.
515 +If RANGE is nil, display all posts. If range is a list, display
516 +only those posts designated by RANGE."
514 517 (interactive (list (tabulated-list-get-id)))
515 518 (let ((url (sbbs--board-url (format "/%d" id) t))
516 519 (headline (or (and (not (tabulated-list-get-entry))
517 520 header-line-format)
518 521 (substring-no-properties
519 522 (aref (tabulated-list-get-entry) 2))))
520 523 (board sbbs--board)
................................................................................
595 598
596 599 (defun sbbs-compose-format-spoiler ()
597 600 "Insert spoiler syntax markers."
598 601 (interactive)
599 602 (sbbs-compose-format "~~"))
600 603
601 604 (defun sbbs-compose-unformat ()
605 + "Remove formatting from point."
602 606 (interactive)
603 607 (when (search-backward-regexp "\\(\\*\\*\\|==\\|__\\|~~\\)" nil t)
604 608 (looking-at (concat "\\(" (regexp-quote (match-string 1)) "\\).*?"
605 609 "\\(" (regexp-quote (match-string 1)) "\\)"))
606 610 (replace-match "" nil nil nil 2)
607 611 (replace-match "" nil nil nil 1)))
608 612
................................................................................
664 668 (interactive)
665 669 (goto-char (point-max))
666 670 (let ((sbbs-recenter-to-top nil))
667 671 (sbbs-read-previous 1)))
668 672
669 673 ;;;###autoload
670 674 (defun sbbs-browse (board reload)
671 - "Open thread overview for BOARD."
672 - (interactive (list (sbbs-read-board) nil))
675 + "Open thread overview for BOARD.
676 +If RELOAD is non-nil, force-reloading the board."
677 + (interactive (list (sbbs-read-board) current-prefix-arg))
673 678 (let* ((name (format "*browsing /%s/*" (sbbs--board-name board)))
674 679 (url (sbbs--board-url "list" t board)))
675 680 (if (and (get-buffer name) (not reload))
676 681 (progn (switch-to-buffer name)
677 682 (sbbs--reload-board))
678 683 (with-current-buffer (get-buffer-create name)
679 684 (sbbs-view-mode)
................................................................................
757 762 ;; spoiler
758 763 ("~~[^ ].*?~~" . 'sbbs--spoiler-face)
759 764 ;; references
760 765 (">>\\([[:digit:]]+\\(?:-[[:digit:]]+\\)?\\(?:,[[:digit:]]+\\(?:-[[:digit:]]+\\)?\\)*\\)"
761 766 . 'link)
762 767 ;; quotes
763 768 ("^>.*" . font-lock-comment-face))
764 - "Highlighting for SchemeBBS posts")
769 + "Highlighting for SchemeBBS posts.")
765 770
766 771 (define-derived-mode sbbs-compose-mode text-mode "SchemeBBS Compose"
767 772 "Major mode for composing replies and starting new threads."
768 773 (setq-local comment-start ">")
769 774 (setq-local comment-start-skip "^>")
770 775 (setq-local font-lock-defaults '(sbbs--font-lock))
771 776 (setq-local font-lock-multiline t)
772 777 (setq-local fill-column most-positive-fixnum)
773 778 (message "Press C-c C-c to send"))
774 779
775 780 (provide 'sbbs)
776 781
777 782 ;;; sbbs.el ends here