sbbs.el

Check-in [6673da2ac4]
Login
Overview
Comment:Fix checkdoc complaints
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | master | trunk
Files: files | file ages | folders
SHA3-256: 6673da2ac476cfef982044c004c080f1359e3bbf5d03c73515f156aac911f22b
User & Date: zge on 2021-05-28 10:53:26
Other Links: branch diff | manifest | tags
Context
2021-05-28
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
2021-03-09
21:16
Bind TAB to forward-button check-in: 9d746ddc9a user: zge tags: master, trunk
Changes
Hide Diffs Unified Diffs Show Whitespace Changes Patch

Modified sbbs.el from [a3702196fd] to [8aac24173f].

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