sbbs.el

Check-in [5fba0a20a4]
Login
Overview
Comment:enable sbbs-read-mode before fetching thread contents
Downloads: Tarball | ZIP archive | SQL archive
Timelines: family | ancestors | descendants | both | master | trunk
Files: files | file ages | folders
SHA3-256: 5fba0a20a46c6aacb8ed36d3a6b4d6b94e4ba3337e967425591a38dee3336380
User & Date: philip@warpmail.net on 2020-02-26 15:23:13
Other Links: branch diff | manifest | tags
Context
2020-02-26
22:17
removed risky flag from sbbs-boards check-in: 9ba0256b5c user: philip@warpmail.net tags: master, trunk
15:23
enable sbbs-read-mode before fetching thread contents check-in: 5fba0a20a4 user: philip@warpmail.net tags: master, trunk
2020-02-24
16:19
removed sbbs--ornamentum variable check-in: 06efb04e61 user: philip@warpmail.net tags: master, trunk
Changes
Hide Diffs Unified Diffs Ignore Whitespace Patch

Modified sbbs.el from [637706a84f] to [aca41172ba].

246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
...
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300

301
302
303
304
305
306
307

308



309
310
311
312
313
314
315
                                 (cdr (assq 'headline (cdr thread)))
                                 'face 'variable-pitch)))
                  ent))
          (setq-local tabulated-list-entries ent)
          (tabulated-list-print t t)
          (hl-line-highlight))))))

(defun sbbs--thread-loader (status board id buf)
  "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"
................................................................................
      (save-match-data
        (while (search-forward "#f" nil t)
          (unless (cadddr (syntax-ppss))
            (replace-match "t")))))
    (let ((thread (read (current-buffer))))
      (kill-buffer)
      (with-current-buffer buf
        (sbbs-read-mode)
        (setq sbbs--board board
              sbbs--thread-id id)
        (let ((buffer-read-only nil))
          (erase-buffer)
          (setq header-line-format
                (format "Thread %d: %s" id
                        (cdr (assq 'headline thread))))
          (dolist (post (cadr (assq 'posts thread)))
            (sbbs--thread-insert-post post))
          (delete-blank-lines)
          (goto-char (point-min)))
        (rename-buffer (format "*reading /%s/%d*"
                               (sbbs--board-name board)
                               id))))))

  ;; INTERACTIVE FUNCTIONS

(defun sbbs-view-open (id)
  "Open thread ID in new buffer."
  (interactive (list (tabulated-list-get-id)))
  (let ((url (sbbs--board-url (format "/%d" id) t))
        (headline (substring-no-properties
                   (aref (tabulated-list-get-entry ) 2)))

        (buf (get-buffer-create
              (format "*loading /%s/%d*"
                      (sbbs--board-name sbbs--board)
                      id))))
    (url-retrieve url #'sbbs--thread-loader
                  (list sbbs--board id buf))
    (with-current-buffer buf

      (setq header-line-format (format "Thread %d: %s" id headline)))



    (switch-to-buffer buf)))

(defun sbbs-view-compose ()
  "Create buffer to start a new thread."
  (interactive)
  (let ((board sbbs--board))
    (with-current-buffer (generate-new-buffer "*new thread*")







|







 







<
<
<










|










>




<
<

>
|
>
>
>







246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
...
270
271
272
273
274
275
276



277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302


303
304
305
306
307
308
309
310
311
312
313
314
315
                                 (cdr (assq 'headline (cdr thread)))
                                 'face 'variable-pitch)))
                  ent))
          (setq-local tabulated-list-entries ent)
          (tabulated-list-print t t)
          (hl-line-highlight))))))

(defun sbbs--thread-loader (status id buf)
  "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"
................................................................................
      (save-match-data
        (while (search-forward "#f" nil t)
          (unless (cadddr (syntax-ppss))
            (replace-match "t")))))
    (let ((thread (read (current-buffer))))
      (kill-buffer)
      (with-current-buffer buf



        (let ((buffer-read-only nil))
          (erase-buffer)
          (setq header-line-format
                (format "Thread %d: %s" id
                        (cdr (assq 'headline thread))))
          (dolist (post (cadr (assq 'posts thread)))
            (sbbs--thread-insert-post post))
          (delete-blank-lines)
          (goto-char (point-min)))
        (rename-buffer (format "*reading /%s/%d*"
                               (sbbs--board-name sbbs--board)
                               id))))))

  ;; INTERACTIVE FUNCTIONS

(defun sbbs-view-open (id)
  "Open thread ID in new buffer."
  (interactive (list (tabulated-list-get-id)))
  (let ((url (sbbs--board-url (format "/%d" id) t))
        (headline (substring-no-properties
                   (aref (tabulated-list-get-entry ) 2)))
        (board sbbs--board)
        (buf (get-buffer-create
              (format "*loading /%s/%d*"
                      (sbbs--board-name sbbs--board)
                      id))))


    (with-current-buffer buf
      (sbbs-read-mode)
      (setq header-line-format (format "Thread %d: %s" id headline)
            sbbs--board board
            sbbs--thread-id id))
    (url-retrieve url #'sbbs--thread-loader (list id buf))
    (switch-to-buffer buf)))

(defun sbbs-view-compose ()
  "Create buffer to start a new thread."
  (interactive)
  (let ((board sbbs--board))
    (with-current-buffer (generate-new-buffer "*new thread*")