Overview
| Comment: | initial import many thanks to anon who fixed submission issues in http://textboard.org/prog/81 |
|---|---|
| Downloads: | Tarball | ZIP archive | SQL archive |
| Timelines: | family | descendants | master | trunk |
| Files: | files | file ages | folders |
| SHA3-256: |
8aaa2a71b555870630164e1317c90642 |
| User & Date: | philip@warpmail.net on 2020-02-21 22:15:34 |
| Other Links: | branch diff | manifest | tags |
Context
|
2020-02-21
| ||
| 23:09 | added more issues and improvments to readme check-in: 3010b30422 user: philip@warpmail.net tags: master, trunk | |
| 22:15 | initial import many thanks to anon who fixed submission issues in http://textboard.org/prog/81 check-in: 8aaa2a71b5 user: philip@warpmail.net tags: master, trunk | |
Changes
Added .dir-locals.el version [1d789c6a91].
1 +;;; Directory Local Variables 2 +;;; For more information see (info "(emacs) Directory Variables") 3 + 4 +((emacs-lisp-mode 5 + (tab-width . 4) 6 + (indent-tabs-mode . nil)))
Added .gitignore version [4aeab8f511].
1 +*.elc 2 +*~ 3 +\#*\#
Added LICENSE version [38a1a1ee40].
1 +Creative Commons Legal Code 2 + 3 +CC0 1.0 Universal 4 + 5 + CREATIVE COMMONS CORPORATION IS NOT A LAW FIRM AND DOES NOT PROVIDE 6 + LEGAL SERVICES. DISTRIBUTION OF THIS DOCUMENT DOES NOT CREATE AN 7 + ATTORNEY-CLIENT RELATIONSHIP. CREATIVE COMMONS PROVIDES THIS 8 + INFORMATION ON AN "AS-IS" BASIS. CREATIVE COMMONS MAKES NO WARRANTIES 9 + REGARDING THE USE OF THIS DOCUMENT OR THE INFORMATION OR WORKS 10 + PROVIDED HEREUNDER, AND DISCLAIMS LIABILITY FOR DAMAGES RESULTING FROM 11 + THE USE OF THIS DOCUMENT OR THE INFORMATION OR WORKS PROVIDED 12 + HEREUNDER. 13 + 14 +Statement of Purpose 15 + 16 +The laws of most jurisdictions throughout the world automatically confer 17 +exclusive Copyright and Related Rights (defined below) upon the creator 18 +and subsequent owner(s) (each and all, an "owner") of an original work of 19 +authorship and/or a database (each, a "Work"). 20 + 21 +Certain owners wish to permanently relinquish those rights to a Work for 22 +the purpose of contributing to a commons of creative, cultural and 23 +scientific works ("Commons") that the public can reliably and without fear 24 +of later claims of infringement build upon, modify, incorporate in other 25 +works, reuse and redistribute as freely as possible in any form whatsoever 26 +and for any purposes, including without limitation commercial purposes. 27 +These owners may contribute to the Commons to promote the ideal of a free 28 +culture and the further production of creative, cultural and scientific 29 +works, or to gain reputation or greater distribution for their Work in 30 +part through the use and efforts of others. 31 + 32 +For these and/or other purposes and motivations, and without any 33 +expectation of additional consideration or compensation, the person 34 +associating CC0 with a Work (the "Affirmer"), to the extent that he or she 35 +is an owner of Copyright and Related Rights in the Work, voluntarily 36 +elects to apply CC0 to the Work and publicly distribute the Work under its 37 +terms, with knowledge of his or her Copyright and Related Rights in the 38 +Work and the meaning and intended legal effect of CC0 on those rights. 39 + 40 +1. Copyright and Related Rights. A Work made available under CC0 may be 41 +protected by copyright and related or neighboring rights ("Copyright and 42 +Related Rights"). Copyright and Related Rights include, but are not 43 +limited to, the following: 44 + 45 + i. the right to reproduce, adapt, distribute, perform, display, 46 + communicate, and translate a Work; 47 + ii. moral rights retained by the original author(s) and/or performer(s); 48 +iii. publicity and privacy rights pertaining to a person's image or 49 + likeness depicted in a Work; 50 + iv. rights protecting against unfair competition in regards to a Work, 51 + subject to the limitations in paragraph 4(a), below; 52 + v. rights protecting the extraction, dissemination, use and reuse of data 53 + in a Work; 54 + vi. database rights (such as those arising under Directive 96/9/EC of the 55 + European Parliament and of the Council of 11 March 1996 on the legal 56 + protection of databases, and under any national implementation 57 + thereof, including any amended or successor version of such 58 + directive); and 59 +vii. other similar, equivalent or corresponding rights throughout the 60 + world based on applicable law or treaty, and any national 61 + implementations thereof. 62 + 63 +2. Waiver. To the greatest extent permitted by, but not in contravention 64 +of, applicable law, Affirmer hereby overtly, fully, permanently, 65 +irrevocably and unconditionally waives, abandons, and surrenders all of 66 +Affirmer's Copyright and Related Rights and associated claims and causes 67 +of action, whether now known or unknown (including existing as well as 68 +future claims and causes of action), in the Work (i) in all territories 69 +worldwide, (ii) for the maximum duration provided by applicable law or 70 +treaty (including future time extensions), (iii) in any current or future 71 +medium and for any number of copies, and (iv) for any purpose whatsoever, 72 +including without limitation commercial, advertising or promotional 73 +purposes (the "Waiver"). Affirmer makes the Waiver for the benefit of each 74 +member of the public at large and to the detriment of Affirmer's heirs and 75 +successors, fully intending that such Waiver shall not be subject to 76 +revocation, rescission, cancellation, termination, or any other legal or 77 +equitable action to disrupt the quiet enjoyment of the Work by the public 78 +as contemplated by Affirmer's express Statement of Purpose. 79 + 80 +3. Public License Fallback. Should any part of the Waiver for any reason 81 +be judged legally invalid or ineffective under applicable law, then the 82 +Waiver shall be preserved to the maximum extent permitted taking into 83 +account Affirmer's express Statement of Purpose. In addition, to the 84 +extent the Waiver is so judged Affirmer hereby grants to each affected 85 +person a royalty-free, non transferable, non sublicensable, non exclusive, 86 +irrevocable and unconditional license to exercise Affirmer's Copyright and 87 +Related Rights in the Work (i) in all territories worldwide, (ii) for the 88 +maximum duration provided by applicable law or treaty (including future 89 +time extensions), (iii) in any current or future medium and for any number 90 +of copies, and (iv) for any purpose whatsoever, including without 91 +limitation commercial, advertising or promotional purposes (the 92 +"License"). The License shall be deemed effective as of the date CC0 was 93 +applied by Affirmer to the Work. Should any part of the License for any 94 +reason be judged legally invalid or ineffective under applicable law, such 95 +partial invalidity or ineffectiveness shall not invalidate the remainder 96 +of the License, and in such case Affirmer hereby affirms that he or she 97 +will not (i) exercise any of his or her remaining Copyright and Related 98 +Rights in the Work or (ii) assert any associated claims and causes of 99 +action with respect to the Work, in either case contrary to Affirmer's 100 +express Statement of Purpose. 101 + 102 +4. Limitations and Disclaimers. 103 + 104 + a. No trademark or patent rights held by Affirmer are waived, abandoned, 105 + surrendered, licensed or otherwise affected by this document. 106 + b. Affirmer offers the Work as-is and makes no representations or 107 + warranties of any kind concerning the Work, express, implied, 108 + statutory or otherwise, including without limitation warranties of 109 + title, merchantability, fitness for a particular purpose, non 110 + infringement, or the absence of latent or other defects, accuracy, or 111 + the present or absence of errors, whether or not discoverable, all to 112 + the greatest extent permissible under applicable law. 113 + c. Affirmer disclaims responsibility for clearing rights of other persons 114 + that may apply to the Work or any use thereof, including without 115 + limitation any person's Copyright and Related Rights in the Work. 116 + Further, Affirmer disclaims responsibility for obtaining any necessary 117 + consents, permissions or other rights required for any use of the 118 + Work. 119 + d. Affirmer understands and acknowledges that Creative Commons is not a 120 + party to this document and has no duty or obligation with respect to 121 + this CC0 or use of the Work.
Added README.md version [61806f711a].
1 +`sbbs.el` 2 +========= 3 + 4 +`sbbs` is a [SchemeBBS][schemebbs] client in Emacs. It implements 5 +browsing the thread list, threads and creating responses. 6 + 7 +Any bugs, patches or questions can be submitted to my [public 8 +inbox][mail]. 9 + 10 +Issues and Improvments 11 +---------------------- 12 + 13 +- Due to issues with `url.el`, some versions of Emacs take 14 + quite long to load threads/thread lists. 15 +- No highlighting in response buffers. 16 +- Spoilers aren't shown unless manually highlighted. 17 + 18 +Copying 19 +------- 20 + 21 +`sbbs.el` is distributed under the [CC0 1.0 Universal (CC0 1.0) Public 22 +Domain Dedication][cc0] license. 23 + 24 +[schemebbs]: https://textboard.org/ 25 +[public inbox]: https://lists.sr.ht/~zge/public-inbox 26 +[cc0]: https://creativecommons.org/publicdomain/zero/1.0/deed
Added sbbs.el version [7a0569766c].
1 +;;; sbbs.el --- SchemeBBS client -*- lexical-binding: t -*- 2 + 3 +;; Author: Philip K. <philip@warpmail.net> 4 +;; Version: 0.1.0 5 +;; Keywords: comm 6 +;; Package-Requires: ((emacs "24.4")) 7 +;; URL: https://git.sr.ht/~zge/sbbs 8 + 9 +;; This file is NOT part of Emacs. 10 +;; 11 +;; This file is in the public domain, to the extent possible under law, 12 +;; published under the CC0 1.0 Universal license. 13 +;; 14 +;; For a full copy of the CC0 license see 15 +;; https://creativecommons.org/publicdomain/zero/1.0/legalcode 16 + 17 +;;; Commentary: 18 +;; 19 +;; sbbs is a SchemeBBS (https://textboard.org) client in Emacs. 20 +;; 21 +;; Start browsing a board by invoking M-x `sbbs'. 22 + 23 +;; Open a board 24 + 25 +;;; Code: 26 + 27 +(require 'tabulated-list) 28 +(require 'button) 29 +(require 'url) 30 +(require 'hl-line) 31 + 32 + ;; CUSTOMIZABLE DATA 33 + 34 +(defgroup sbbs nil 35 + "SchemeBBS client." 36 + :group 'applications 37 + :prefix "sbbs-") 38 + 39 +(defcustom sbbs-boards 40 + '(("textboard.org" ("sol" "prog") nil)) 41 + "List of SchemeBBS sites and boards." 42 + :type '(repeat (list (string :tag "Board Domain") 43 + (repeat (string :tag "Board Name")) 44 + (boolean :tag "Use TLS?"))) 45 + :risky t) 46 + 47 +(defface sbbs--spoiler-face 48 + '((((background light)) :background "black" :foreground "black") 49 + (((background dark)) :background "white" :foreground "white")) 50 + "Face for spoiler text in threads.") 51 + 52 +(defface sbbs--code-face 53 + '((((background light)) :background "gray89") 54 + (((background dark)) :background "gray11")) 55 + "Face for code blocks in threads.") 56 + 57 + ;; VARIABLES 58 + 59 +(defvar-local sbbs--board nil 60 + "Buffer local reference to current board. 61 + 62 +See `sbbs-make-board'.") 63 + 64 +(defvar-local sbbs--thread-id nil 65 + "Buffer local reference to current thread id. 66 + 67 +Used in thread and reply buffers.") 68 + 69 +(defvar sbbs--ornamentum nil 70 + "Global cache of the ornamentum, used for posting.") 71 + 72 + ;; BOARD OBJECT AND FUNCTIONS 73 + 74 +(defun sbbs-make-board (domain name &optional tls) 75 + "Create board object, using DOMAIN, NAME and TLS flag." 76 + (vector domain name tls)) 77 + 78 +(defsubst sbbs--board-domain (board) 79 + "Get domain part of a BOARD object." 80 + (aref board 0)) 81 + 82 +(defsubst sbbs--board-name (board) 83 + "Get board name part of a BOARD object." 84 + (aref board 1)) 85 + 86 +(defsubst sbbs--board-protocol (board) 87 + "Determine protocol to be used for BOARD object." 88 + (if (aref board 2) "https" "http")) 89 + 90 +(defun sbbs--board-url (&optional path api-p board) 91 + "Generate URL for BOARD to access PATH. 92 + 93 +If API-P is non-nil, prefix path with \"sexp\"." 94 + (let ((board (or board sbbs--board))) 95 + (format "%s://%s/%s%s/%s" 96 + (sbbs--board-protocol board) 97 + (sbbs--board-domain board) 98 + (if api-p "sexp/" "") 99 + (sbbs--board-name board) 100 + (or path "")))) 101 + 102 +(defun sbbs-read-board () 103 + "Read in a board using `completing-read'. 104 + 105 +The list will be generated using `sbbs-boards', and the result 106 +will be a board object generated with `sbbs-make-board'." 107 + (let (boards) 108 + (dolist (ent sbbs-boards) 109 + (dolist (board (cadr ent)) 110 + (push (cons (format "/%s/ (%s)" board (car ent)) 111 + (sbbs-make-board (car ent) board (caddr ent))) 112 + boards))) 113 + (cdr (assoc (completing-read "Board: " boards nil t) boards)))) 114 + 115 + ;; UTILITY FUNCTIONS 116 + 117 +(defun sbbs--reload-thread (&optional _ignore-auto _noconfirm) 118 + "Function to reload an opened thread." 119 + (when sbbs--thread-id (sbbs-view-open sbbs--thread-id))) 120 + 121 +(defun sbbs--reload-board () 122 + "Function to regenerate thread index. 123 + 124 +Called by `tabulated-list-mode' hooks." 125 + (when sbbs--board (sbbs-browse sbbs--board))) 126 + 127 + ;; UI GENERATOR 128 + 129 +(defun sbbs--insert-link (text link) 130 + "Insert link to LINK as TEXT into buffer. 131 + 132 +If LINK is a (board, thread or site) local link, modify opening 133 +behaviour accordingly." 134 + (let ((domain (sbbs--board-domain sbbs--board)) 135 + (name (sbbs--board-name sbbs--board)) 136 + (id sbbs--thread-id) 137 + (local-re "\\`/%s/%d/\\([[:digit:]]+\\)") 138 + (thread-re "\\`/%s/\\([[:digit:]]+\\)") 139 + (board-re "\\`http\\(s?\\)://\\([-._[:alnum:]]+\\)/sexp/\\([[:alnum:]]+\\)/\\([[:digit:]]+\\)")) 140 + (save-match-data 141 + (cond ((string-match (format local-re name id) link) 142 + (insert-button 143 + text 144 + 'action (lambda (x) 145 + (goto-char (point-min)) 146 + (sbbs-read-next (1- (button-get x 'sbbs-post-id)))) 147 + 'sbbs-post-id (string-to-number (match-string 1 link)))) 148 + ((string-match (format thread-re name id) link) 149 + (insert-button 150 + text 151 + 'action (lambda (x) 152 + (sbbs-view-open (button-get x 'sbbs-link-id))) 153 + 'sbbs-link-id (string-to-number (match-string 1 link)))) 154 + ((string-match (format board-re domain name) link) 155 + (insert-button 156 + text 157 + 'action (lambda (x) 158 + (let ((sbbs--board (button-get x 'sbbs-board))) 159 + (sbbs-view-open (button-get x 'sbbs-link-id)))) 160 + 'sbbs-board (sbbs-make-board (match-string 2 link) 161 + (match-string 3 link) 162 + (string= (match-string 1 link) "s")) 163 + 'sbbs-link-id (string-to-number (match-string 3 link)))) 164 + (t (insert-button 165 + text 166 + 'action (lambda (x) (browse-url (button-get x 'url))) 167 + 'url link)))))) 168 + 169 +(defun sbbs--insert-sxml-par (sxml) 170 + "Insert paragraph contents SXML at point." 171 + (dolist (it sxml) 172 + (cond ((stringp it) 173 + (insert (propertize it 'face 'variable-pitch))) 174 + ((eq (car it) 'br) 175 + (fill-paragraph) 176 + (newline)) 177 + ((eq (car it) 'b) 178 + (insert (propertize (cadr it) 'face '(bold variable-pitch)))) 179 + ((eq (car it) 'i) 180 + (insert (propertize (cadr it) 'face '(italic variable-pitch)))) 181 + ((eq (car it) 'code) 182 + (insert (propertize (cadr it) 'face 'fixed-pitch))) 183 + ((eq (car it) 'del) 184 + (insert (propertize (cadr it) 'face 'sbbs--spoiler-face))) 185 + ((eq (car it) 'a) 186 + (let* ((text (caddr it)) 187 + (link (plist-get (cadadr it) 'href))) 188 + (sbbs--insert-link text link))) 189 + (t (insert (prin1-to-string it))))) 190 + (insert ?\n)) 191 + 192 +(defun sbbs--insert-sxml (sxml) 193 + "Insert top-level SXML into buffer at point." 194 + (dolist (par sxml) 195 + (cond ((eq (car par) 'p) 196 + (sbbs--insert-sxml-par (cdr par))) 197 + ((eq (car par) 'blockquote) 198 + (let ((start (point)) 199 + (comment-start "> ")) 200 + (sbbs--insert-sxml-par (cdadr par)) 201 + (comment-region start (point)) 202 + (add-face-text-property start (point) 203 + 'font-lock-comment-face))) 204 + ((eq (car par) 'pre) 205 + (let ((start (point))) 206 + (insert (propertize (cadadr par) 207 + 'face 'fixed-pitch)) 208 + (newline) 209 + (add-face-text-property start (point) 'sbbs--code-face))) 210 + (t (error "Unknown top-level element"))) 211 + (insert ?\n))) 212 + 213 +(defun sbbs--thread-insert-post (post) 214 + "Prepare and Insert header and contents of POST at point." 215 + (let ((start (point))) 216 + (insert (format "#%d\t%s" (car post) 217 + (cdr (assq 'date (cdr post))))) 218 + (when (cdr (assq 'vip (cdr post))) 219 + (insert " (VIP)")) 220 + (newline 2) 221 + (add-text-properties start (1- (point)) '(face highlight)) 222 + (set-text-properties (1- (point)) (point) nil) 223 + (sbbs--insert-sxml (cdr (assq 'content (cdr post)))) 224 + (add-text-properties start (point) (list 'sbbs-thread-nr (car post))))) 225 + 226 + ;; URL.EL CALLBACKS 227 + 228 +(defun sbbs--board-loader (status buf) 229 + "Callback function for `url-retrieve' when loading board. 230 + 231 +Load results into buffer BUF." 232 + (when (plist-get status :error) 233 + (message "Error while loading: %s" 234 + (cdr (plist-get status :error)))) 235 + (forward-paragraph) 236 + (let ((list (read (current-buffer)))) 237 + (kill-buffer) 238 + (with-current-buffer buf 239 + (let (ent) 240 + (dolist (thread list) 241 + (push (list (car thread) 242 + (vector (substring (cdr (assq 'date (cdr thread))) 243 + 0 16) 244 + (number-to-string 245 + (cdr (assq 'messages (cdr thread)))) 246 + (propertize 247 + (cdr (assq 'headline (cdr thread))) 248 + 'face 'variable-pitch))) 249 + ent)) 250 + (setq-local tabulated-list-entries ent) 251 + (tabulated-list-print t t))) 252 + (switch-to-buffer buf) 253 + (hl-line-highlight))) 254 + 255 +(defun sbbs--thread-loader (status board id) 256 + "Callback function for `url-retrieve' when loading thread. 257 + 258 +The attribute ID determines what thread from board BOARD to 259 +load." 260 + (when (plist-get status :error) 261 + (message "Error while loading: %s" 262 + (cdr (plist-get status :error)))) 263 + (prog-mode) 264 + (forward-paragraph) 265 + (save-excursion 266 + (save-match-data 267 + (while (search-forward "#f" nil t) 268 + (unless (cadddr (syntax-ppss)) 269 + (replace-match "nil"))))) 270 + (save-excursion 271 + (save-match-data 272 + (while (search-forward "#f" nil t) 273 + (unless (cadddr (syntax-ppss)) 274 + (replace-match "t"))))) 275 + (let ((thread (read (current-buffer))) 276 + (buf (get-buffer-create 277 + (format "*reading /%s/%d*" 278 + (sbbs--board-name board) 279 + id)))) 280 + (kill-buffer) 281 + (with-current-buffer buf 282 + (sbbs-read-mode) 283 + (setq sbbs--board board 284 + sbbs--thread-id id) 285 + (let ((buffer-read-only nil)) 286 + (erase-buffer) 287 + (setq header-line-format 288 + (format "Thread %d: %s" id 289 + (cdr (assq 'headline thread)))) 290 + (dolist (post (cadr (assq 'posts thread))) 291 + (sbbs--thread-insert-post post)) 292 + (delete-blank-lines) 293 + (goto-char (point-min)))) 294 + (switch-to-buffer buf))) 295 + 296 + ;; INTERACTIVE FUNCTIONS 297 + 298 +(defun sbbs-view-open (id) 299 + "Open thread ID in new buffer." 300 + (interactive (list (tabulated-list-get-id))) 301 + (let ((url (sbbs--board-url (format "/%d" id) t))) 302 + (url-retrieve url #'sbbs--thread-loader 303 + (list sbbs--board id)))) 304 + 305 +(defun sbbs-view-compose () 306 + "Create buffer to start a new thread." 307 + (interactive) 308 + (let ((board sbbs--board)) 309 + (with-current-buffer (generate-new-buffer "*new thread*") 310 + (sbbs-compose-mode) 311 + (setq sbbs--board board) 312 + (switch-to-buffer (current-buffer))))) 313 + 314 +(defun sbbs-read-reply (arg) 315 + "Create buffer to start a reply in current thread. 316 + 317 +With \\[universal-argument] add a reply reference to thread at 318 +point." 319 + (interactive "P") 320 + (let ((id sbbs--thread-id) 321 + (nr (get-text-property (point) 'sbbs-thread-nr)) 322 + (board sbbs--board)) 323 + (with-current-buffer (generate-new-buffer "*new response*") 324 + (sbbs-compose-mode) 325 + (when (and arg (= (car arg) 4)) 326 + (insert (format ">>%d" nr)) 327 + (newline)) 328 + (setq header-line-format (format "Responding to Thread %d" id) 329 + sbbs--thread-id id 330 + sbbs--board board) 331 + (switch-to-buffer (current-buffer))))) 332 + 333 +(defun sbbs-compose-create () 334 + "Upload response or thread to board." 335 + (interactive) 336 + (let ((board sbbs--board) 337 + (url-request-method "POST") 338 + (url-request-extra-headers 339 + '(("Content-Type" . "application/x-www-form-urlencoded"))) 340 + (url-request-data 341 + (url-build-query-string 342 + `((epistula ,(buffer-string)) 343 + (ornamentum "") (name "") (message "") 344 + (frontpage ,(if sbbs--thread-id "true" "false")) 345 + . ,(and (not sbbs--thread-id) 346 + `((titulus ,(read-string "Headline: "))))))) 347 + (url (if sbbs--thread-id 348 + (sbbs--board-url (format "%d/post" sbbs--thread-id)) 349 + (sbbs--board-url "/post")))) 350 + (url-retrieve url (lambda (status buf) 351 + (if (plist-get status :error) 352 + (message "Error while submitting: %s" 353 + (cdr (plist-get status :error))) 354 + (kill-buffer buf) 355 + (let ((sbbs--board board)) 356 + (sbbs--reload-thread)))) 357 + (list (current-buffer))))) 358 + 359 +(defun sbbs-read-next (arg) 360 + "Move point to next thread header." 361 + (interactive "p") 362 + (dotimes (_ arg) 363 + (end-of-line) 364 + (catch 'found 365 + (while (search-forward-regexp "^#" nil t) 366 + (when (eq 'highlight (get-text-property (point) 'face)) 367 + (throw 'found t))))) 368 + (beginning-of-line)) 369 + 370 +(defun sbbs-read-previous (arg) 371 + "Move point to previous thread header." 372 + (interactive "p") 373 + (dotimes (_ arg) 374 + (catch 'found 375 + (while (search-backward-regexp "^#" nil t) 376 + (when (eq 'highlight (get-text-property (point) 'face)) 377 + (throw 'found t))))) 378 + (beginning-of-line)) 379 + 380 +;;;###autoload 381 +(defun sbbs-browse (board) 382 + "Open thread overview for BOARD." 383 + (interactive (list (sbbs-read-board))) 384 + (let* ((name (format "*browsing /%s/*" (sbbs--board-name board))) 385 + (url (sbbs--board-url "list" t board))) 386 + (with-current-buffer (get-buffer-create name) 387 + (let ((buffer-read-only nil)) 388 + (erase-buffer)) 389 + (sbbs-view-mode) 390 + (setq sbbs--board board) 391 + (url-retrieve url #'sbbs--board-loader 392 + (list (current-buffer)))))) 393 + 394 +;;;###autoload 395 +(defalias 'sbbs #'sbbs-browse) 396 + 397 + ;; MAJOR MODES 398 + 399 +(defvar sbbs-view-mode-map 400 + (let ((map (make-sparse-keymap))) 401 + (define-key map (kbd "RET") #'sbbs-view-open) 402 + (define-key map (kbd "c") #'sbbs-view-compose) 403 + map)) 404 + 405 +(define-derived-mode sbbs-view-mode tabulated-list-mode "SchemeBBS Browse" 406 + "Major mode for browsing a SchemeBBS board." 407 + (buffer-disable-undo) 408 + 409 + (setq tabulated-list-format [("Date" 16 t) 410 + ("#" 3 t :right-align t) 411 + ("Headline" 0 nil)] 412 + tabulated-list-sort-key '("Date" . t)) 413 + (add-hook 'tabulated-list-revert-hook 414 + #'sbbs--reload-board nil t) 415 + (tabulated-list-init-header) 416 + 417 + (hl-line-mode t)) 418 + 419 +(defvar sbbs-read-mode-map 420 + (let ((map (make-sparse-keymap))) 421 + (suppress-keymap map) 422 + (define-key map (kbd "<tab>") #'forward-button) 423 + (define-key map (kbd "<backtab>") #'backward-button) 424 + (define-key map (kbd "r") #'sbbs-read-reply) 425 + (define-key map (kbd "n") #'sbbs-read-next) 426 + (define-key map (kbd "p") #'sbbs-read-previous) 427 + map)) 428 + 429 +(define-derived-mode sbbs-read-mode special-mode "SchemeBBS Read" 430 + "Major mode for reading a thread." 431 + (buffer-disable-undo) 432 + (visual-line-mode t) 433 + (setq-local revert-buffer-function #'sbbs--reload-thread)) 434 + 435 +(defvar sbbs-compose-mode-map 436 + (let ((map (make-sparse-keymap))) 437 + (define-key map (kbd "C-c C-c") #'sbbs-compose-create) 438 + map)) 439 + 440 +(define-derived-mode sbbs-compose-mode text-mode "SchemeBBS Compose" 441 + "Major mode for composing replies and starting new threads." 442 + (message "Press C-c C-c to send")) 443 + 444 +(provide 'sbbs) 445 + 446 +;;; sbbs.el ends here