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