| 1 | ;;; nnslashdot.el --- interfacing with Slashdot |
| 2 | ;; Copyright (C) 1999, 2000 Free Software Foundation, Inc. |
| 3 | |
| 4 | ;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org> |
| 5 | ;; Keywords: news |
| 6 | |
| 7 | ;; This file is part of GNU Emacs. |
| 8 | |
| 9 | ;; GNU Emacs is free software; you can redistribute it and/or modify |
| 10 | ;; it under the terms of the GNU General Public License as published by |
| 11 | ;; the Free Software Foundation; either version 2, or (at your option) |
| 12 | ;; any later version. |
| 13 | |
| 14 | ;; GNU Emacs is distributed in the hope that it will be useful, |
| 15 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of |
| 16 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
| 17 | ;; GNU General Public License for more details. |
| 18 | |
| 19 | ;; You should have received a copy of the GNU General Public License |
| 20 | ;; along with GNU Emacs; see the file COPYING. If not, write to the |
| 21 | ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, |
| 22 | ;; Boston, MA 02111-1307, USA. |
| 23 | |
| 24 | ;;; Commentary: |
| 25 | |
| 26 | ;; Note: You need to have `url' and `w3' installed for this |
| 27 | ;; backend to work. |
| 28 | |
| 29 | ;;; Code: |
| 30 | |
| 31 | (eval-when-compile (require 'cl)) |
| 32 | |
| 33 | (require 'nnoo) |
| 34 | (require 'message) |
| 35 | (require 'gnus-util) |
| 36 | (require 'gnus) |
| 37 | (require 'nnmail) |
| 38 | (require 'mm-util) |
| 39 | (eval-when-compile |
| 40 | (ignore-errors |
| 41 | (require 'nnweb))) |
| 42 | ;; Report failure to find w3 at load time if appropriate. |
| 43 | (eval '(require 'nnweb)) |
| 44 | |
| 45 | (nnoo-declare nnslashdot) |
| 46 | |
| 47 | (defvoo nnslashdot-directory (nnheader-concat gnus-directory "slashdot/") |
| 48 | "Where nnslashdot will save its files.") |
| 49 | |
| 50 | (defvoo nnslashdot-active-url "http://slashdot.org/search.pl?section=&min=%d" |
| 51 | "Where nnslashdot will fetch the active file from.") |
| 52 | |
| 53 | (defvoo nnslashdot-comments-url "http://slashdot.org/comments.pl?sid=%s&threshold=%d&commentsort=%d&mode=flat&startat=%d" |
| 54 | "Where nnslashdot will fetch comments from.") |
| 55 | |
| 56 | (defvoo nnslashdot-article-url |
| 57 | "http://slashdot.org/article.pl?sid=%s&mode=nocomment" |
| 58 | "Where nnslashdot will fetch the article from.") |
| 59 | |
| 60 | (defvoo nnslashdot-threshold -1 |
| 61 | "The article threshold.") |
| 62 | |
| 63 | (defvoo nnslashdot-threaded t |
| 64 | "Whether the nnslashdot groups should be threaded or not.") |
| 65 | |
| 66 | (defvoo nnslashdot-group-number 0 |
| 67 | "The number of non-fresh groups to keep updated.") |
| 68 | |
| 69 | (defvoo nnslashdot-login-name "" |
| 70 | "The login name to use when posting.") |
| 71 | |
| 72 | (defvoo nnslashdot-password "" |
| 73 | "The password to use when posting.") |
| 74 | |
| 75 | ;;; Internal variables |
| 76 | |
| 77 | (defvar nnslashdot-groups nil) |
| 78 | (defvar nnslashdot-buffer nil) |
| 79 | (defvar nnslashdot-headers nil) |
| 80 | |
| 81 | ;;; Interface functions |
| 82 | |
| 83 | (nnoo-define-basics nnslashdot) |
| 84 | |
| 85 | (deffoo nnslashdot-retrieve-headers (articles &optional group server fetch-old) |
| 86 | (nnslashdot-possibly-change-server group server) |
| 87 | (condition-case why |
| 88 | (unless gnus-nov-is-evil |
| 89 | (if nnslashdot-threaded |
| 90 | (nnslashdot-threaded-retrieve-headers articles group) |
| 91 | (nnslashdot-sane-retrieve-headers articles group))) |
| 92 | (search-failed (nnslashdot-lose why)))) |
| 93 | |
| 94 | (deffoo nnslashdot-threaded-retrieve-headers (articles group) |
| 95 | (let ((last (car (last articles))) |
| 96 | (did nil) |
| 97 | (start 1) |
| 98 | (sid (caddr (assoc group nnslashdot-groups))) |
| 99 | (first-comments t) |
| 100 | (startats '(1)) |
| 101 | headers article subject score from date lines parent point s) |
| 102 | (save-excursion |
| 103 | (set-buffer nnslashdot-buffer) |
| 104 | (let ((case-fold-search t)) |
| 105 | (erase-buffer) |
| 106 | (when (= start 1) |
| 107 | (nnweb-insert (format nnslashdot-article-url |
| 108 | (nnslashdot-sid-strip sid)) t) |
| 109 | (goto-char (point-min)) |
| 110 | (search-forward "Posted by ") |
| 111 | (when (looking-at "<a[^>]+>\\([^<]+\\)") |
| 112 | (setq from (nnweb-decode-entities-string (match-string 1)))) |
| 113 | (search-forward " on ") |
| 114 | (setq date (nnslashdot-date-to-date |
| 115 | (buffer-substring (point) (1- (search-forward "<"))))) |
| 116 | (setq lines (/ (- (point) |
| 117 | (progn (forward-line 1) (point))) |
| 118 | 60)) |
| 119 | (push |
| 120 | (cons |
| 121 | 1 |
| 122 | (make-full-mail-header |
| 123 | 1 group from date |
| 124 | (concat "<" (nnslashdot-sid-strip sid) "%1@slashdot>") |
| 125 | "" 0 lines nil nil)) |
| 126 | headers)) |
| 127 | (while (and (setq start (pop startats)) |
| 128 | (< start last)) |
| 129 | (setq point (goto-char (point-max))) |
| 130 | (nnweb-insert |
| 131 | (format nnslashdot-comments-url |
| 132 | (nnslashdot-sid-strip sid) |
| 133 | nnslashdot-threshold 0 start) |
| 134 | t) |
| 135 | (when first-comments |
| 136 | (setq first-comments nil) |
| 137 | (goto-char (point-max)) |
| 138 | (while (re-search-backward "startat=\\([0-9]+\\)" nil t) |
| 139 | (setq s (string-to-number (match-string 1))) |
| 140 | (unless (memq s startats) |
| 141 | (push s startats))) |
| 142 | (setq startats (sort startats '<))) |
| 143 | (goto-char point) |
| 144 | (while (re-search-forward |
| 145 | "<a name=\"\\([0-9]+\\)\"><\\(b\\|H4\\)>\\([^<]+\\)</\\(b\\|H4\\)>.*score:\\([^)]+\\))" |
| 146 | nil t) |
| 147 | (setq article (string-to-number (match-string 1)) |
| 148 | subject (match-string 3) |
| 149 | score (match-string 5)) |
| 150 | (when (string-match "^Re: *" subject) |
| 151 | (setq subject (concat "Re: " (substring subject (match-end 0))))) |
| 152 | (setq subject (nnweb-decode-entities-string subject)) |
| 153 | (forward-line 1) |
| 154 | (if (looking-at |
| 155 | "by <a[^>]+>\\([^<]+\\)</a>[ \t\n]*.*(\\([^)]+\\))") |
| 156 | (progn |
| 157 | (goto-char (- (match-end 0) 5)) |
| 158 | (setq from (concat |
| 159 | (nnweb-decode-entities-string (match-string 1)) |
| 160 | " <" (match-string 2) ">"))) |
| 161 | (setq from "") |
| 162 | (when (looking-at "by \\(.+\\) on ") |
| 163 | (goto-char (- (match-end 0) 5)) |
| 164 | (setq from (nnweb-decode-entities-string (match-string 1))))) |
| 165 | (search-forward " on ") |
| 166 | (setq date |
| 167 | (nnslashdot-date-to-date |
| 168 | (buffer-substring (point) (progn (end-of-line) (point))))) |
| 169 | (setq lines (/ (abs (- (search-forward "<td ") |
| 170 | (search-forward "</td>"))) |
| 171 | 70)) |
| 172 | (forward-line 4) |
| 173 | (setq parent |
| 174 | (if (looking-at ".*cid=\\([0-9]+\\)") |
| 175 | (match-string 1) |
| 176 | nil)) |
| 177 | (setq did t) |
| 178 | (push |
| 179 | (cons |
| 180 | (1+ article) |
| 181 | (make-full-mail-header |
| 182 | (1+ article) |
| 183 | (concat subject " (" score ")") |
| 184 | from date |
| 185 | (concat "<" (nnslashdot-sid-strip sid) "%" |
| 186 | (number-to-string (1+ article)) |
| 187 | "@slashdot>") |
| 188 | (if parent |
| 189 | (concat "<" (nnslashdot-sid-strip sid) "%" |
| 190 | (number-to-string (1+ (string-to-number parent))) |
| 191 | "@slashdot>") |
| 192 | "") |
| 193 | 0 lines nil nil)) |
| 194 | headers))))) |
| 195 | (setq nnslashdot-headers (sort headers 'car-less-than-car)) |
| 196 | (save-excursion |
| 197 | (set-buffer nntp-server-buffer) |
| 198 | (erase-buffer) |
| 199 | (mm-with-unibyte-current-buffer |
| 200 | (dolist (header nnslashdot-headers) |
| 201 | (nnheader-insert-nov (cdr header))))) |
| 202 | 'nov)) |
| 203 | |
| 204 | (deffoo nnslashdot-sane-retrieve-headers (articles group) |
| 205 | (let ((last (car (last articles))) |
| 206 | (did nil) |
| 207 | (start (max (1- (car articles)) 1)) |
| 208 | (sid (caddr (assoc group nnslashdot-groups))) |
| 209 | headers article subject score from date lines parent point) |
| 210 | (save-excursion |
| 211 | (set-buffer nnslashdot-buffer) |
| 212 | (erase-buffer) |
| 213 | (when (= start 1) |
| 214 | (nnweb-insert (format nnslashdot-article-url |
| 215 | (nnslashdot-sid-strip sid)) t) |
| 216 | (goto-char (point-min)) |
| 217 | (search-forward "Posted by ") |
| 218 | (when (looking-at "<a[^>]+>\\([^<]+\\)") |
| 219 | (setq from (nnweb-decode-entities-string (match-string 1)))) |
| 220 | (search-forward " on ") |
| 221 | (setq date (nnslashdot-date-to-date |
| 222 | (buffer-substring (point) (1- (search-forward "<"))))) |
| 223 | (forward-line 2) |
| 224 | (setq lines (count-lines (point) |
| 225 | (re-search-forward |
| 226 | "A href=\"\\(http://slashdot.org\\)?/article"))) |
| 227 | (push |
| 228 | (cons |
| 229 | 1 |
| 230 | (make-full-mail-header |
| 231 | 1 group from date (concat "<" (nnslashdot-sid-strip sid) |
| 232 | "%1@slashdot>") |
| 233 | "" 0 lines nil nil)) |
| 234 | headers)) |
| 235 | (while (or (not article) |
| 236 | (and did |
| 237 | (< article last))) |
| 238 | (when article |
| 239 | (setq start (1+ article))) |
| 240 | (setq point (goto-char (point-max))) |
| 241 | (nnweb-insert |
| 242 | (format nnslashdot-comments-url (nnslashdot-sid-strip sid) |
| 243 | nnslashdot-threshold 4 start) |
| 244 | t) |
| 245 | (goto-char point) |
| 246 | (while (re-search-forward |
| 247 | "<a name=\"\\([0-9]+\\)\"><\\(b\\|H4\\)>\\([^<]+\\)</\\(b\\|H4\\)>.*score:\\([^)]+\\))" |
| 248 | nil t) |
| 249 | (setq article (string-to-number (match-string 1)) |
| 250 | subject (match-string 3) |
| 251 | score (match-string 5)) |
| 252 | (when (string-match "^Re: *" subject) |
| 253 | (setq subject (concat "Re: " (substring subject (match-end 0))))) |
| 254 | (setq subject (nnweb-decode-entities-string subject)) |
| 255 | (forward-line 1) |
| 256 | (if (looking-at |
| 257 | "by <a[^>]+>\\([^<]+\\)</a>[ \t\n]*.*(\\([^)]+\\))") |
| 258 | (progn |
| 259 | (goto-char (- (match-end 0) 5)) |
| 260 | (setq from (concat |
| 261 | (nnweb-decode-entities-string (match-string 1)) |
| 262 | " <" (match-string 2) ">"))) |
| 263 | (setq from "") |
| 264 | (when (looking-at "by \\(.+\\) on ") |
| 265 | (goto-char (- (match-end 0) 5)) |
| 266 | (setq from (nnweb-decode-entities-string (match-string 1))))) |
| 267 | (search-forward " on ") |
| 268 | (setq date |
| 269 | (nnslashdot-date-to-date |
| 270 | (buffer-substring (point) (progn (end-of-line) (point))))) |
| 271 | (setq lines (/ (abs (- (search-forward "<td ") |
| 272 | (search-forward "</td>"))) |
| 273 | 70)) |
| 274 | (forward-line 2) |
| 275 | (setq parent |
| 276 | (if (looking-at ".*cid=\\([0-9]+\\)") |
| 277 | (match-string 1) |
| 278 | nil)) |
| 279 | (setq did t) |
| 280 | (push |
| 281 | (cons |
| 282 | (1+ article) |
| 283 | (make-full-mail-header |
| 284 | (1+ article) (concat subject " (" score ")") |
| 285 | from date |
| 286 | (concat "<" (nnslashdot-sid-strip sid) "%" |
| 287 | (number-to-string (1+ article)) |
| 288 | "@slashdot>") |
| 289 | (if parent |
| 290 | (concat "<" (nnslashdot-sid-strip sid) "%" |
| 291 | (number-to-string (1+ (string-to-number parent))) |
| 292 | "@slashdot>") |
| 293 | "") |
| 294 | 0 lines nil nil)) |
| 295 | headers)))) |
| 296 | (setq nnslashdot-headers |
| 297 | (sort headers (lambda (s1 s2) (< (car s1) (car s2))))) |
| 298 | (save-excursion |
| 299 | (set-buffer nntp-server-buffer) |
| 300 | (erase-buffer) |
| 301 | (mm-with-unibyte-current-buffer |
| 302 | (dolist (header nnslashdot-headers) |
| 303 | (nnheader-insert-nov (cdr header))))) |
| 304 | 'nov)) |
| 305 | |
| 306 | (deffoo nnslashdot-request-group (group &optional server dont-check) |
| 307 | (nnslashdot-possibly-change-server nil server) |
| 308 | (let ((elem (assoc group nnslashdot-groups))) |
| 309 | (cond |
| 310 | ((not elem) |
| 311 | (nnheader-report 'nnslashdot "Group does not exist")) |
| 312 | (t |
| 313 | (nnheader-report 'nnslashdot "Opened group %s" group) |
| 314 | (nnheader-insert |
| 315 | "211 %d %d %d %s\n" (cadr elem) 1 (cadr elem) |
| 316 | (prin1-to-string group)))))) |
| 317 | |
| 318 | (deffoo nnslashdot-close-group (group &optional server) |
| 319 | (nnslashdot-possibly-change-server group server) |
| 320 | (when (gnus-buffer-live-p nnslashdot-buffer) |
| 321 | (save-excursion |
| 322 | (set-buffer nnslashdot-buffer) |
| 323 | (kill-buffer nnslashdot-buffer))) |
| 324 | t) |
| 325 | |
| 326 | (deffoo nnslashdot-request-article (article &optional group server buffer) |
| 327 | (nnslashdot-possibly-change-server group server) |
| 328 | (let (contents) |
| 329 | (condition-case why |
| 330 | (save-excursion |
| 331 | (set-buffer nnslashdot-buffer) |
| 332 | (let ((case-fold-search t)) |
| 333 | (goto-char (point-min)) |
| 334 | (when (and (stringp article) |
| 335 | (string-match "%\\([0-9]+\\)@" article)) |
| 336 | (setq article (string-to-number (match-string 1 article)))) |
| 337 | (when (numberp article) |
| 338 | (if (= article 1) |
| 339 | (progn |
| 340 | (re-search-forward "Posted by *<[^>]+>[^>]*<[^>]+> *on ") |
| 341 | (search-forward "<BR>") |
| 342 | (setq contents |
| 343 | (buffer-substring |
| 344 | (point) |
| 345 | (progn |
| 346 | (re-search-forward |
| 347 | "<p>.*A href=\"\\(http://slashdot.org\\)?/article") |
| 348 | (match-beginning 0))))) |
| 349 | (search-forward (format "<a name=\"%d\">" (1- article))) |
| 350 | (setq contents |
| 351 | (buffer-substring |
| 352 | (re-search-forward "<td[^>]+>") |
| 353 | (search-forward "</td>"))))))) |
| 354 | (search-failed (nnslashdot-lose why))) |
| 355 | |
| 356 | (when contents |
| 357 | (save-excursion |
| 358 | (set-buffer (or buffer nntp-server-buffer)) |
| 359 | (erase-buffer) |
| 360 | (mm-with-unibyte-current-buffer |
| 361 | (insert contents) |
| 362 | (goto-char (point-min)) |
| 363 | (while (re-search-forward "\\(<br>\r?\\)+" nil t) |
| 364 | (replace-match "<p>" t t)) |
| 365 | (goto-char (point-min)) |
| 366 | (insert "Content-Type: text/html\nMIME-Version: 1.0\n") |
| 367 | (insert "Newsgroups: " (caddr (assoc group nnslashdot-groups)) |
| 368 | "\n") |
| 369 | (let ((header (cdr (assq article nnslashdot-headers)))) |
| 370 | (nnheader-insert-header header)) |
| 371 | (nnheader-report 'nnslashdot "Fetched article %s" article)) |
| 372 | (cons group article))))) |
| 373 | |
| 374 | (deffoo nnslashdot-close-server (&optional server) |
| 375 | (when (and (nnslashdot-server-opened server) |
| 376 | (gnus-buffer-live-p nnslashdot-buffer)) |
| 377 | (save-excursion |
| 378 | (set-buffer nnslashdot-buffer) |
| 379 | (kill-buffer nnslashdot-buffer))) |
| 380 | (nnoo-close-server 'nnslashdot server)) |
| 381 | |
| 382 | (deffoo nnslashdot-request-list (&optional server) |
| 383 | (nnslashdot-possibly-change-server nil server) |
| 384 | (let ((number 0) |
| 385 | sid elem description articles gname) |
| 386 | (condition-case why |
| 387 | ;; First we do the Ultramode to get info on all the latest groups. |
| 388 | (progn |
| 389 | (mm-with-unibyte-buffer |
| 390 | (nnweb-insert "http://slashdot.org/slashdot.xml" t) |
| 391 | (goto-char (point-min)) |
| 392 | (while (search-forward "<story>" nil t) |
| 393 | (narrow-to-region (point) (search-forward "</story>")) |
| 394 | (goto-char (point-min)) |
| 395 | (re-search-forward "<title>\\([^<]+\\)</title>") |
| 396 | (setq description |
| 397 | (nnweb-decode-entities-string (match-string 1))) |
| 398 | (re-search-forward "<url>\\([^<]+\\)</url>") |
| 399 | (setq sid (match-string 1)) |
| 400 | (string-match "/\\([0-9/]+\\)\\(.shtml\\|$\\)" sid) |
| 401 | (setq sid (concat "00/" (match-string 1 sid))) |
| 402 | (re-search-forward "<comments>\\([^<]+\\)</comments>") |
| 403 | (setq articles (string-to-number (match-string 1))) |
| 404 | (setq gname (concat description " (" sid ")")) |
| 405 | (if (setq elem (assoc gname nnslashdot-groups)) |
| 406 | (setcar (cdr elem) articles) |
| 407 | (push (list gname articles sid) nnslashdot-groups)) |
| 408 | (goto-char (point-max)) |
| 409 | (widen))) |
| 410 | ;; Then do the older groups. |
| 411 | (while (> (- nnslashdot-group-number number) 0) |
| 412 | (mm-with-unibyte-buffer |
| 413 | (let ((case-fold-search t)) |
| 414 | (nnweb-insert (format nnslashdot-active-url number) t) |
| 415 | (goto-char (point-min)) |
| 416 | (while (re-search-forward |
| 417 | "article.pl\\?sid=\\([^&]+\\).*<b>\\([^<]+\\)</b>" |
| 418 | nil t) |
| 419 | (setq sid (match-string 1) |
| 420 | description |
| 421 | (nnweb-decode-entities-string (match-string 2))) |
| 422 | (forward-line 1) |
| 423 | (when (re-search-forward "<b>\\([0-9]+\\)</b>" nil t) |
| 424 | (setq articles (string-to-number (match-string 1)))) |
| 425 | (setq gname (concat description " (" sid ")")) |
| 426 | (if (setq elem (assoc gname nnslashdot-groups)) |
| 427 | (setcar (cdr elem) articles) |
| 428 | (push (list gname articles sid) nnslashdot-groups))))) |
| 429 | (incf number 30))) |
| 430 | (search-failed (nnslashdot-lose why))) |
| 431 | (nnslashdot-write-groups) |
| 432 | (nnslashdot-generate-active) |
| 433 | t)) |
| 434 | |
| 435 | (deffoo nnslashdot-request-newgroups (date &optional server) |
| 436 | (nnslashdot-possibly-change-server nil server) |
| 437 | (nnslashdot-generate-active) |
| 438 | t) |
| 439 | |
| 440 | (deffoo nnslashdot-request-post (&optional server) |
| 441 | (nnslashdot-possibly-change-server nil server) |
| 442 | (let ((sid (nnslashdot-sid-strip (message-fetch-field "newsgroups"))) |
| 443 | (subject (message-fetch-field "subject")) |
| 444 | (references (car (last (split-string |
| 445 | (message-fetch-field "references"))))) |
| 446 | body quoted pid) |
| 447 | (string-match "%\\([0-9]+\\)@slashdot" references) |
| 448 | (setq pid (match-string 1 references)) |
| 449 | (message-goto-body) |
| 450 | (narrow-to-region (point) (progn (message-goto-signature) (point))) |
| 451 | (goto-char (point-min)) |
| 452 | (while (not (eobp)) |
| 453 | (if (looking-at "> ") |
| 454 | (progn |
| 455 | (delete-region (point) (+ (point) 2)) |
| 456 | (unless quoted |
| 457 | (insert "<blockquote>\n")) |
| 458 | (setq quoted t)) |
| 459 | (when quoted |
| 460 | (insert "</blockquote>\n") |
| 461 | (setq quoted nil))) |
| 462 | (forward-line 1)) |
| 463 | (goto-char (point-min)) |
| 464 | (while (re-search-forward "^ *\n" nil t) |
| 465 | (replace-match "<p>\n")) |
| 466 | (widen) |
| 467 | (when (message-goto-signature) |
| 468 | (forward-line -1) |
| 469 | (insert "<p>\n") |
| 470 | (while (not (eobp)) |
| 471 | (end-of-line) |
| 472 | (insert "<br>") |
| 473 | (forward-line 1))) |
| 474 | (message-goto-body) |
| 475 | (setq body (buffer-substring (point) (point-max))) |
| 476 | (erase-buffer) |
| 477 | (nnweb-fetch-form |
| 478 | "http://slashdot.org/comments.pl" |
| 479 | `(("sid" . ,sid) |
| 480 | ("pid" . ,pid) |
| 481 | ("rlogin" . "userlogin") |
| 482 | ("unickname" . ,nnslashdot-login-name) |
| 483 | ("upasswd" . ,nnslashdot-password) |
| 484 | ("postersubj" . ,subject) |
| 485 | ("op" . "Submit") |
| 486 | ("postercomment" . ,body) |
| 487 | ("posttype" . "html"))))) |
| 488 | |
| 489 | (deffoo nnslashdot-request-delete-group (group &optional force server) |
| 490 | (nnslashdot-possibly-change-server group server) |
| 491 | (setq nnslashdot-groups (delq (assoc group nnslashdot-groups) |
| 492 | nnslashdot-groups)) |
| 493 | (nnslashdot-write-groups)) |
| 494 | |
| 495 | (deffoo nnslashdot-request-close () |
| 496 | (setq nnslashdot-headers nil |
| 497 | nnslashdot-groups nil)) |
| 498 | |
| 499 | (nnoo-define-skeleton nnslashdot) |
| 500 | |
| 501 | ;;; Internal functions |
| 502 | |
| 503 | (defun nnslashdot-possibly-change-server (&optional group server) |
| 504 | (nnslashdot-init server) |
| 505 | (when (and server |
| 506 | (not (nnslashdot-server-opened server))) |
| 507 | (nnslashdot-open-server server)) |
| 508 | (unless nnslashdot-groups |
| 509 | (nnslashdot-read-groups))) |
| 510 | |
| 511 | (defun nnslashdot-read-groups () |
| 512 | (let ((file (expand-file-name "groups" nnslashdot-directory))) |
| 513 | (when (file-exists-p file) |
| 514 | (mm-with-unibyte-buffer |
| 515 | (insert-file-contents file) |
| 516 | (goto-char (point-min)) |
| 517 | (setq nnslashdot-groups (read (current-buffer))))))) |
| 518 | |
| 519 | (defun nnslashdot-write-groups () |
| 520 | (with-temp-file (expand-file-name "groups" nnslashdot-directory) |
| 521 | (prin1 nnslashdot-groups (current-buffer)))) |
| 522 | |
| 523 | (defun nnslashdot-init (server) |
| 524 | "Initialize buffers and such." |
| 525 | (unless (file-exists-p nnslashdot-directory) |
| 526 | (gnus-make-directory nnslashdot-directory)) |
| 527 | (unless (gnus-buffer-live-p nnslashdot-buffer) |
| 528 | (setq nnslashdot-buffer |
| 529 | (save-excursion |
| 530 | (nnheader-set-temp-buffer |
| 531 | (format " *nnslashdot %s*" server)))))) |
| 532 | |
| 533 | (defun nnslashdot-date-to-date (sdate) |
| 534 | (condition-case err |
| 535 | (let ((elem (delete "" (split-string sdate)))) |
| 536 | (concat (substring (nth 0 elem) 0 3) " " |
| 537 | (substring (nth 1 elem) 0 3) " " |
| 538 | (substring (nth 2 elem) 0 2) " " |
| 539 | (substring (nth 3 elem) 1 6) " " |
| 540 | (format-time-string "%Y") " " |
| 541 | (nth 4 elem))) |
| 542 | (error ""))) |
| 543 | |
| 544 | (defun nnslashdot-generate-active () |
| 545 | (save-excursion |
| 546 | (set-buffer nntp-server-buffer) |
| 547 | (erase-buffer) |
| 548 | (dolist (elem nnslashdot-groups) |
| 549 | (insert (prin1-to-string (car elem)) |
| 550 | " " (number-to-string (cadr elem)) " 1 y\n")))) |
| 551 | |
| 552 | (defun nnslashdot-lose (why) |
| 553 | (error "Slashdot HTML has changed; please get a new version of nnslashdot")) |
| 554 | |
| 555 | ;(defun nnslashdot-sid-strip (sid) |
| 556 | ; (if (string-match "^00/" sid) |
| 557 | ; (substring sid (match-end 0)) |
| 558 | ; sid)) |
| 559 | |
| 560 | (defalias 'nnslashdot-sid-strip 'identity) |
| 561 | |
| 562 | (provide 'nnslashdot) |
| 563 | |
| 564 | ;;; nnslashdot.el ends here |