unofficial mirror of bug-gnu-emacs@gnu.org 
 help / color / mirror / code / Atom feed
blob 0bf599553e42cf9bfa5665043d170bdf7eb48475 29906 bytes (raw)
name: lisp/gnus/nnfeed.el 	 # note: path name is non-authoritative(*)

  1
  2
  3
  4
  5
  6
  7
  8
  9
 10
 11
 12
 13
 14
 15
 16
 17
 18
 19
 20
 21
 22
 23
 24
 25
 26
 27
 28
 29
 30
 31
 32
 33
 34
 35
 36
 37
 38
 39
 40
 41
 42
 43
 44
 45
 46
 47
 48
 49
 50
 51
 52
 53
 54
 55
 56
 57
 58
 59
 60
 61
 62
 63
 64
 65
 66
 67
 68
 69
 70
 71
 72
 73
 74
 75
 76
 77
 78
 79
 80
 81
 82
 83
 84
 85
 86
 87
 88
 89
 90
 91
 92
 93
 94
 95
 96
 97
 98
 99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
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
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
 
;;; nnfeed.el --- Generic feed backend for Gnus -*- lexical-binding: t -*-

;; Copyright (C) 2023 Free Software Foundation, Inc.
;; Author: Daniel Semyonov <daniel@dsemy.com>

;; This file is part of GNU Emacs.

;; nnfeed is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.

;; nnfeed is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;; GNU General Public License for more details.

;; You should have received a copy of the GNU General Public License
;; along with nnfeed.  If not, see <https://www.gnu.org/licenses/>.

;;; Commentary:

;; Generic Gnus backend (intended) for implementing backends for web
;; feeds (Atom, RSS).
;;
;; This backend is abstract - it doesn't implement a parser for any
;; specific web feed type, and so can't be used independently.
;;
;; Instead, it implements a generic parser, feed data storage and most
;; of the Gnus backend interface; the intended use for this backend is
;; to be a source of inheritance for backends supporting new web feed
;; types.
;;
;; To implement new backends, use `nnfeed-define-basic-backend-interface':
;;
;;    ...
;;    (require 'nnfeed)
;;
;;    (nnoo-declare nnfoo nnfeed)
;;
;;    (nnfeed-define-basic-backend-interface nnfoo)
;;    ...
;;    [  definitions of parsing functions, see the "Feed parser interface"
;;       section for more information.  ]
;;
;;    (defvoo nnfoo-read-feed-function #'nnfoo--read-feed
;;     nil nnfeed-read-feed-function)
;;    ...
;;    (gnus-declare-backend (symbol-name nnfeed-backend) 'address)
;;
;;    (provide 'nnfoo)
;;
;;; Code:

(eval-when-compile
  (require 'subr-x))

(require 'gnus)
(require 'nnoo)

(defgroup nnfeed nil
  "Generic feed backend for Gnus."
  :group 'gnus)

(defcustom nnfeed-date-format "%F %X%p"
  "Format of displayed dates (see function `format-time-string')."
  :type 'string)

(nnoo-declare nnfeed)

(defvoo nnfeed-backend nil
  "Symbol which identifies this backend.")

(defvoo nnfeed-status-string nil
  "Last status message reported by this backend.")

;; This macro should be used to define inheriting backends.

(defmacro nnfeed-define-basic-backend-interface (backend)
  "Define a basic set of functions and variables for BACKEND."
  `(progn
     (defvoo ,(nnoo-symbol backend 'backend) ',backend nil nnfeed-backend)
     (defvoo ,(nnoo-symbol backend 'status-string)
         nil nil nnfeed-status-string)
     (defvoo ,(nnoo-symbol backend 'group) nil nil nnfeed-group)
     (defvoo ,(nnoo-symbol backend 'servers)
         (make-hash-table :test 'equal) nil nnfeed-servers)
     (defvoo ,(nnoo-symbol backend 'group-article-ids)
         (make-hash-table :test 'equal) nil nnfeed-group-article-ids)
     (defvoo ,(nnoo-symbol backend 'group-articles)
         (make-hash-table :test 'eql) nil nnfeed-group-articles)
     (defvoo ,(nnoo-symbol backend 'group-article-max-num) 0 nil
             nnfeed-group-article-max-num)
     (defvoo ,(nnoo-symbol backend 'group-article-mix-num) 1 nil
             nnfeed-group-article-min-num)
     ,@(mapcar (lambda (fun)
                 `(deffoo ,(nnoo-symbol backend fun) (&optional server)
	            (,(nnoo-symbol 'nnoo fun) ',backend server)))
	       '(server-opened status-message))
     (deffoo ,(nnoo-symbol backend 'open-server) (server &optional defs)
       (nnfeed-open-server server defs ',backend))
     (nnoo-import ,backend (nnfeed))))

;;;; Feed parser interface:

;; The following set of server variables define a parser for a
;; specific web feed type.
;; An inheriting backend doesn't necessarily have to define all of
;; these functions (see the comments below for more information).
;; Apart from this set of variables there is also
;; `nnfeed-print-content-function' which can optionally be defined
;; by an inheriting backend to allow more advanced control over the
;; printing of articles.

(defvoo nnfeed-read-feed-function #'ignore
  "Function returning a Lisp object representing a feed (or part of it).

It should accept two arguments, the address of a feed and the name of
a group (or nil).
If a group name is supplied, it should return a representation of only
the group (as if it was extracted from the feed with
`nnfeed-read-group-function').")

(defvoo nnfeed-read-group-function #'ignore
  "Function returning a cons cell of a group and remaining data from a feed.

The returned group can be represented by any Lisp object.
It should accept a single argument, a Lisp object representing a feed
\(as can be returned by this function or `nnfeed-read-feed-function').")

(defvoo nnfeed-read-article-function #'ignore
  "Function returning a cons cell of an article and remaining data from a group.

The returned article can be represented by any Lisp object.
It should accept two arguments, a Lisp object representing a group
\(as can be returned by this function or `nnfeed-read-group-function'),
and a flag indicating whether the last article was not new or updated.")

(defvoo nnfeed-read-title-function #'ignore
  "Function returning the title of a group (a string).

It should accept a single argument, a Lisp object representing a group
\(as returned by `nnfeed-read-group-function').")

;; Optional.
(defvoo nnfeed-read-description-function #'ignore
  "Function returning the description of a group (a string), or nil.

It should accept a single argument, a Lisp object representing a group
\(as returned by `nnfeed-read-group-function').")

;; Either this function or `nnfeed-read-author-function' is required.
(defvoo nnfeed-read-group-author-function #'ignore
  "Function returning the author of a group (a string), or nil.

It should accept a single argument, a Lisp object representing a group
\(as returned by `nnfeed-read-group-function')..")

(defvoo nnfeed-read-id-function #'ignore
  "Function returning the ID of an article.

It should accept a single argument, a Lisp object representing an article
\(as returned by `nnfeed-read-article-function').")

(defvoo nnfeed-read-subject-function #'ignore
  "Function returning the subject of an article (a string), or nil.

It should accept a single argument, a Lisp object representing an article
\(as returned by `nnfeed-read-article-function').")

;; Either this function or `nnfeed-read-update-date-function' is required.
(defvoo nnfeed-read-publish-date-function #'ignore
  "Function returning the publish date of an article (a time value), or nil.

It should accept a single argument, a Lisp object representing an article
\(as returned by `nnfeed-read-article-function').")

;; Either this function or `nnfeed-read-publish-date-function' is required.
(defvoo nnfeed-read-update-date-function #'ignore
  "Function returning the update date of an article (a time value), or nil.

It should accept a single argument, a Lisp object representing an article
\(as returned by `nnfeed-read-article-function').")

;; Either this function or `nnfeed-read-group-author-function' is required.
(defvoo nnfeed-read-author-function #'ignore
  "Function returning the author of an article (a string), or nil.

It should accept a single argument, a Lisp object representing an article
\(as returned by `nnfeed-read-article-function').")

(defvoo nnfeed-read-headers-function #'ignore
  "Function returning an alist of article-wide MIME headers.

Each element of this alist maps a MIME header (a symbol,
i.e. `Content-Type') to its value.  As a special case, `:boundary'
maps to a string which will serve as the boundary between article
parts.  This must be supplied if a custom boundary is used in a
multipart content type header.  The default boundary is \"-_nnfeed_-\",
and is automatically modified to match the name of the back end.
It should accept a single argument, a Lisp object representing an article
\(as returned by `nnfeed-read-article-function').")

;; As mentioned in their docstrings, the last two parsing functions
;; can optionally return any Lisp representation they want, provided
;; an appropriate `nnfeed-print-content-function' is defined.  This
;; means they are also not _strictly_ required.

(defvoo nnfeed-read-links-function #'ignore
  "Function returning all links contained in an article.

With the default `nnfeed-print-content-function', it should return a
list of links, where each link is an alist mapping MIME content types
to links formatted for display in a part of that type.  Each content
type may also be a list of content types.
Otherwise, it could return any Lisp object.
It should accept a single argument, a Lisp object representing an article
\(as returned by `nnfeed-read-article-function').")

(defvoo nnfeed-read-parts-function #'ignore
  "Function returning an alist associating parts of an article to their headers.

With the default `nnfeed-print-content-function', each part should be a
string.  Otherwise, it can be any Lisp object.  The \"headers\" of
each part should be a list where each element is either a cons of a
MIME header (a symbol, i.e. `Content-Type') and its value (a string),
or any other Lisp object.  MIME headers will be printed, the rest will
be passed on to `nnfeed-print-content-function', which recognizes the
following extra data by default:
- `links', if present, will cause links to be printed in the part.
It should accept a single argument, a Lisp object representing an article
\(as returned by `nnfeed-read-article-function').")

;;;; Feed data storage:

;; This section defines the data types used to store feed data, and
;; functions to read and write it.
;; All variables in this section are automatically defined by
;; `nnfeed-define-basic-backend-interface'.

(defvoo nnfeed-servers (make-hash-table :test 'equal)
  "Hash table mapping known servers to their groups.

Each value in this table should itself be a hash table mapping known
group names to their data, which should be a vector of the form
[GROUP IDS ARTICLES MAX MIN DESCRIPTION], where:
- GROUP is the \"real\" group name (the name known to the server).
- IDS is a hash table mapping article IDs to their numbers.
- ARTICLES is a hash table mapping article numbers to articles and
  their attributes (see `nnfeed-group-articles').
- MAX is the maximum article number.
- MIN is the minimum article number.
- DESCRIPTION is the group description.")

(defvoo nnfeed-group-names (make-hash-table :test 'equal)
  "Hash table mapping real group names to their custom name.")

(defun nnfeed--server-address (server)
  "Return SERVER's real address."
  (if (string-suffix-p "-ephemeral" server)
      (setq server (or (cadr (assq (nnoo-symbol nnfeed-backend 'address)
                                   (cddr (gnus-server-to-method
                                          (concat
                                           (symbol-name nnfeed-backend) ":"
                                           server)))))
                       server))
    server))

(defun nnfeed--server-file (server)
  "Return the file containing data for SERVER."
  (expand-file-name (format "%s/%s.eld"
                            (string-trim (symbol-name nnfeed-backend)
                                         "nn")
                            (gnus-newsgroup-savable-name
                             (nnfeed--server-address server)))
                    gnus-directory))

(defun nnfeed--read-server (server)
  "Read SERVER's information from storage."
  (if-let ((f (nnfeed--server-file server))
           ((file-readable-p f)))
      (with-temp-buffer
        (insert-file-contents f)
        (goto-char (point-min))
        (puthash server (read (current-buffer)) nnfeed-servers))
    (nnheader-report nnfeed-backend "Can't read %s" server)))

(defun nnfeed--write-server (server)
  "Write SERVER's information to storage."
  (if-let ((f (nnfeed--server-file server))
           ((file-writable-p f)))
      (if-let ((s (gethash server nnfeed-servers))
               ((hash-table-p s)))
          (with-temp-file f
            (insert ";;;; -*- mode: lisp-data -*- DO NOT EDIT\n")
            (prin1 s (current-buffer))
            (insert "\n")
            t)
        t)
    (nnheader-report nnfeed-backend "Can't write %s" f)))

;; The following function uses the parsing functions defined in the last
;; section to parse a feed (or just one group from it).
;; This is the only place where these parsing functions are used; the Gnus
;; backend interface extracts all required information from the parsed feed.

(defun nnfeed--parse-feed (feed &optional group)
  "Parse GROUP from FEED into a new or existing server.
If GROUP is omitted or nil, parse the entire FEED."
  (let* ((feed (nnfeed--server-address feed))
         (s (or (gethash feed nnfeed-servers) (nnfeed--read-server feed)
                (make-hash-table :test 'equal)))
         (name group) ; (Maybe) fake name (or nil)
         (group (aref (gethash group s `[,group]) 0)) ; Real name (or nil)
         data)
    (when (setq data (funcall nnfeed-read-feed-function feed group))
      (while-let ((cg (or (and name (cons data)) ; `data' is a single group
                          (funcall nnfeed-read-group-function data)))
                  (cg (prog1 (car cg) (setq data (cdr cg)))))
        (let* ((name (funcall nnfeed-read-title-function cg)) ; Real name
               (group (gethash name nnfeed-group-names name)) ; (Maybe) fake name
               (info (gnus-get-info
                      (concat (symbol-name nnfeed-backend) "+" feed ":" group)))
               (g (or (gethash group s)
                      `[ ,name ,(make-hash-table :test 'equal)
                         ,(make-hash-table :test 'eql) nil 1 ""]))
               (desc (funcall nnfeed-read-description-function cg))
               (ids (aref g 1))
               (articles (aref g 2))
               (max (aref g 3))
               (max (if max max
                      (setq max 0) ; Find max article number
                      (dolist      ; remembered by Gnus.
                          ( r (cons (gnus-info-read info)
                                    (gnus-info-marks info))
                            max)
                        (mapc (lambda (x)
                                (let ((x (if (consp x)
                                             (if (< (car x) (cdr x))
                                                 (cdr x) (car x))
                                           x)))
                                  (when (< max x) (setq max x))))
                              (if (symbolp (car r)) (cdr r) r)))))
               (group-author (funcall nnfeed-read-group-author-function cg))
               stale)
          (and desc (aset g 5 desc))
          (while-let ((article (funcall nnfeed-read-article-function cg stale))
                      (article (prog1 (car article) (setq cg (cdr article)))))
            (when-let ((id (funcall nnfeed-read-id-function article))
                       (id (format "<%s@%s.%s>" id name nnfeed-backend)))
              (let* ((num (gethash id ids))
                     (update (funcall nnfeed-read-update-date-function article))
                     (prev-update (aref (gethash num articles
                                                 '[nil nil nil nil nil])
                                        4)))
                (if (or (null num) ; New article ID.
                        (and (null prev-update) update)
                        (and prev-update update
                             (time-less-p prev-update update)))
                    (let* ((num (or num (aset g 3 (setq max (1+ max)))))
                           (publish (funcall nnfeed-read-publish-date-function
                                             article)))
                      (setf
                       (gethash id (aref g 1)) num
                       (gethash num (aref g 2))
                       `[ ,id
                          ,(or (funcall nnfeed-read-author-function article)
                               group-author group)
                          ,(or (funcall nnfeed-read-subject-function article)
                               "no subject")
                          ,(or publish update '(0 0)) ; published
                          ,(or update publish '(0 0)) ; updated
                          ,(funcall nnfeed-read-links-function article)
                          ,(funcall nnfeed-read-parts-function article)
                          ,(funcall nnfeed-read-headers-function article)]
                       stale nil))
                  (setq stale t)))))
          (puthash group g s)))
      (puthash feed s nnfeed-servers))))

;;;; Gnus backend functions:

;; The following two sections define a Gnus backend interface based on
;; the parsed data from the last section.
;; All server variables in this section are automatically defined by
;; `nnfeed-define-basic-backend-interface'.
;; For more information about these functions see the "Back End
;; Interface" section of the Gnus manual.

(defvoo nnfeed-group nil
  "Name of the current group.")

(defvoo nnfeed-group-article-ids (make-hash-table :test 'equal)
  "Hash table mapping article IDs to their article number.")

(defvoo nnfeed-group-articles (make-hash-table :test 'eql)
  "Hash table mapping article numbers to articles and their attributes.

Each value in this table should be a vector of the form
[ID FROM SUBJECT DATE UPDATED LINKS PARTS HEADERS], where:
- ID is the ID of the article.
- FROM is the author of the article or group.
- SUBJECT is the subject of the article.
- DATE is the date the article was published, or last updated (time value).
- UPDATE is the date the article was last updated, or published (time value).
- LINKS is a collection of links (any Lisp object).
- PARTS is an alist associating the content of each part of the
  article to its headers.
- HEADERS is an alist associating article-wide MIME headers to their value.")

(defvoo nnfeed-group-article-max-num 0
  "Maximum article number for the current group.")

(defvoo nnfeed-group-article-min-num 1
  "Minimum article number for the current group.")

(nnoo-define-basics nnfeed)

(defun nnfeed--current-server-no-prefix ()
  "Remove the \"<backend>+\" prefix from the current server."
  (string-remove-prefix (concat (symbol-name nnfeed-backend) "+")
                        (nnoo-current-server nnfeed-backend)))

(defun nnfeed--group-data (group server)
  "Get parsed data for GROUP from SERVER."
  (when-let ((server (nnfeed--server-address server))
             (s (gethash server nnfeed-servers))
             ((hash-table-p s)))
    (gethash group s)))

(defun nnfeed-retrieve-article (article group)
  "Retrieve headers for ARTICLE from GROUP."
  (if-let ((a (gethash article (aref group 2))))
      (insert (format "221 %s Article retrieved.
From: %s\nSubject: %s\nDate: %s\nMessage-ID: %s\n.\n"
                      article
                      (aref a 1)
                      (aref a 2)
                      (format-time-string "%F %H:%M" (aref a 3))
                      (aref a 0)))
    (insert "404 Article not found.\n.\n")))

(deffoo nnfeed-retrieve-headers (articles &optional group server _fetch-old)
  (if-let ((server (or server (nnfeed--current-server-no-prefix)))
           (g (or (nnfeed--group-data group server)
                  `[ nil ,nnfeed-group-article-ids ,nnfeed-group-articles
                     nil nil nil])))
      (with-current-buffer nntp-server-buffer
        (erase-buffer)
        (or (and (stringp (car articles))
                 (mapc (lambda (a)
                         (nnfeed-retrieve-article
                          (gethash a (aref g 2)) g))
                       articles))
            (and (numberp (car articles))
                 (range-map (lambda (a) (nnfeed-retrieve-article a g))
                            articles)))
        'headers)
    (nnheader-report nnfeed-backend "Group %s not found" (or group ""))))

(deffoo nnfeed-open-server (server &optional defs backend)
  (let ((backend (or backend 'nnfeed))
        (a (nnfeed--server-address server))
        s)
    (nnoo-change-server backend server defs)
    (when (setq s (or (gethash a nnfeed-servers) (nnfeed--read-server server)))
      (maphash (lambda (group g)
                 (setq g (aref g 0))
                 (unless (string= group g)
                   (puthash g group nnfeed-group-names)))
               s))
    (setq a (nnfeed--server-file server))
    (or s (condition-case _ (make-directory (file-name-parent-directory a) t)
            (:success (file-writable-p a))
            (t nil))
        (and (nnoo-close-server nnfeed-backend server)
             (nnheader-report
              nnfeed-backend "Server file %s not readable or writable"
              server)))))

(deffoo nnfeed-request-close ()
  (when (hash-table-p nnfeed-servers)
    (maphash (lambda (server _) (nnfeed--write-server server)) nnfeed-servers)
    (setq nnfeed-servers (make-hash-table :test 'equal)))
  (setq nnfeed-status-string nil)
  t)

;; The default content printing function, which should be suitable for
;; most inheriting backends.

(defun nnfeed--print-content (content attributes links)
  "Return CONTENT formatted according to ATTRIBUTES, with LINKS possibly added."
  (let ((links (and (memq 'links attributes) links)))
    (when (or content links)
      (concat
       (and content (format "%s\n\n" content))
       (mapconcat (lambda (link)
                    (cdr (assoc (cdr (assq 'Content-Type attributes)) link
                                (lambda (types type)
                                  (if (stringp types) (string= types type)
                                    (member type types))))))
                  links)))))

(defvoo nnfeed-print-content-function #'nnfeed--print-content
  "Function returning a single piece of content for an article (a string).

It should accept three arguments, a part and its attributes (as returned
by `nnfeed-read-parts-function'), and links (as returned by
`nnfeed-read-links-function').")

(defun nnfeed--print-part (content headers mime links)
  "Print part of an article using its CONTENT, HEADERS, and LINKS.
Only HEADERS of a type included in MIME are considered."
  (concat
   (mapconcat (lambda (header)
                (when-let ((m (car-safe header))
                           ((member m mime)))
                  (format "%s: %s\n" m (cdr header))))
              headers)
   "\n"
   (funcall nnfeed-print-content-function content headers links)))

(deffoo nnfeed-request-article (article &optional group server to-buffer)
  (if-let ((server (or server (nnfeed--current-server-no-prefix)))
           (g (or (nnfeed--group-data group server)
                  (and (setq group nnfeed-group)
                       `[ nil ,nnfeed-group-article-ids
                          ,nnfeed-group-articles
                          ,nnfeed-group-article-max-num
                          ,nnfeed-group-article-min-num nil])))
           (num (or (and (stringp article)
                         (gethash article (aref g 1)))
                    (and (numberp article) article)))
           ((and (<= num (aref g 3))
                 (>= num (aref g 4))))
           (a (gethash num (aref g 2))))
      (with-current-buffer (or to-buffer nntp-server-buffer)
        (erase-buffer)
        (let* ((links (aref a 5))
               (parts (aref a 6))
               (headers (aref a 7))
               (boundary (or (cdr (assq :boundary headers))
                             (format "-_%s_-" nnfeed-backend)))
               (multi (length> parts 1))
               (mime '( Content-Type Content-Disposition
                        Content-Transfer-Encoding)))
          (insert (format
                   "Subject: %s\nFrom: %s\nDate: %s\nMessage-ID: %s\n"
                   (aref a 2) (aref a 1)
                   (format-time-string
                    nnfeed-date-format (or (aref a 3) '(0 0)))
                   (aref a 0))
                  (if (assq 'MIME-Version headers) "" "MIME-Version: 1.0\n")
                  (mapconcat (lambda (header)
                               (unless (keywordp (car header))
                                 (format "%s: %s\n" (car header) (cdr header))))
                             headers)
                  (if multi
                      (if (assq 'Content-Type headers) ""
                        (format
                         "Content-Type: multipart/alternative; boundary=%s\n"
                         boundary))
                    (prog1 (nnfeed--print-part
                            (caar parts) (cdar parts) mime links)
                      (setq parts nil)))
                  (mapconcat (lambda (part)
                               (format "--%s\n%s\n" boundary
                                       (nnfeed--print-part
                                        (car part) (cdr part) mime links)))
                             parts)
                  (if multi (format "--%s--" boundary) "\n")))
        `(,group . ,num))
    (nnheader-report nnfeed-backend "No such article")))

(deffoo nnfeed-request-group (group &optional server fast _info)
  (with-current-buffer nntp-server-buffer
    (erase-buffer)
    (if-let ((server (or server (nnfeed--current-server-no-prefix)))
             (g (or (if fast (nnfeed--group-data group server)
                      (setq server (nnfeed--parse-feed server group))
                      (and (hash-table-p server) (gethash group server)))
                    `[ ,group ,(make-hash-table :test 'equal)
                       ,(make-hash-table :test 'eql) 0 1 ""])))
        (progn
          (setq nnfeed-group group
                nnfeed-group-article-ids (aref g 1)
                nnfeed-group-articles (aref g 2)
                nnfeed-group-article-max-num (aref g 3)
                nnfeed-group-article-min-num (aref g 4))
          (insert (format "211 %s %s %s \"%s\""
                          (hash-table-count nnfeed-group-article-ids)
                          nnfeed-group-article-min-num
                          nnfeed-group-article-max-num group))
          t)
      (insert "404 group not found")
      (nnheader-report nnfeed-backend "Group %s not found" group))))

(deffoo nnfeed-close-group (group &optional server)
  (and (string= group nnfeed-group)
       (setq nnfeed-group nil
             nnfeed-group-article-ids (make-hash-table :test 'equal)
             nnfeed-group-articles (make-hash-table :test 'eql)
             nnfeed-group-article-max-num 0
             nnfeed-group-article-min-num 1))
  (setq server (or server (nnfeed--current-server-no-prefix)))
  (nnfeed--write-server server))

(deffoo nnfeed-request-list (&optional server)
  (with-current-buffer nntp-server-buffer
    (erase-buffer)
    (when-let ((p (point))
               (s (nnfeed--parse-feed
                   (or server (nnfeed--current-server-no-prefix))))
               ((hash-table-p s)))
      (maphash (lambda (group g)
                 (insert (format "\"%s\" %s %s y\n"
                                 group (aref g 3) (aref g 4))))
               s)
      (not (= (point) p)))))

(deffoo nnfeed-request-post (&optional _server)
  (nnheader-report nnfeed-backend "%s is a read only backend" nnfeed-backend))

;;;; Optional back end functions:

(deffoo nnfeed-retrieve-groups (_groups &optional server)
  (nnfeed-request-list server)
  'active)

(deffoo nnfeed-request-type (_group &optional _article)
  'unknown)

(deffoo nnfeed-request-group-description (group &optional server)
  (when-let ((server (or server (nnfeed--current-server-no-prefix)))
             (g (nnfeed--group-data group server)))
    (with-current-buffer nntp-server-buffer
      (erase-buffer)
      (insert group "	" (aref g 5) "\n"))))

(deffoo nnfeed-request-list-newsgroups (&optional server)
  (when-let ((server (or server (nnfeed--current-server-no-prefix)))
             (s (gethash (nnfeed--server-address server) nnfeed-servers))
             ((hash-table-p s)))
    (with-current-buffer nntp-server-buffer
      (erase-buffer)
      (maphash (lambda (group g)
                 (insert group "	" (aref g 5) "\n"))
               s))))

(deffoo nnfeed-request-rename-group (group new-name &optional server)
  (when-let ((server (or server (nnfeed--current-server-no-prefix)))
             (a (nnfeed--server-address server))
             (s (or (gethash a nnfeed-servers)
                    (and ; Open the server to add it to `nnfeed-servers'
                     (save-match-data
                       (nnfeed-open-server
                        server
                        (cdr ; Get defs and backend.
                         (assoc a (cdr (assq nnfeed-backend nnoo-state-alist))
                                (lambda (car key)
                                  (and (stringp car)
                                       (string-match
                                        (concat
                                         "\\`\\(\\(nn[[:alpha:]]+\\)\\+\\)?"
                                         (regexp-quote key) "\\'")
                                        car)
                                       (setq server car)))))
                        (if (match-string 1 server)
                            (intern (match-string 2 server)) 'nnfeed)))
                     (gethash a nnfeed-servers))))
             (g (or (nnfeed--group-data group a)
                    `[ ,group ,(make-hash-table :test 'equal)
                       ,(make-hash-table :test 'eql) nil 1 ""])))
    (puthash new-name g s)
    (puthash group new-name nnfeed-group-names)
    (remhash group s)
    (and (string= group nnfeed-group)
         (setq nnfeed-group new-name))
    t))

(provide 'nnfeed)

;;; nnfeed.el ends here

debug log:

solving 0bf599553e4 ...
found 0bf599553e4 in https://git.savannah.gnu.org/cgit/emacs.git

(*) Git path names are given by the tree(s) the blob belongs to.
    Blobs themselves have no identifier aside from the hash of its contents.^

Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/emacs.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).