;;; COPYING ;; You can use or redistribute this file under the terms of any ;; version of the GPL or a BSD style copyright, your choice. ;; (The author for the purpose of the latter is Greg Stark) ;;; INSTRUCTIONS ;; load this file, putting ;; (load "/mit/gsstark/lib/elisp/nndsc") ;; in .gnus.el seems to work reasonably ;; you probably want to put something like ;; (setq gnus-secondary-select-methods '((nndsc ""))) ;; in there as well (or add it to your mail backend or ;; whatever else you have in there already). This will ;; tell Gnus to also ask nndsc about new groups and to also ;; activate nndsc groups when it asks the regular places for news. ;; Then start up Gnus and hit Az and subscribe to any discuss groups you want. ;; You may have to hit F to tell gnus to check for new newsgroups. ;; If you have gnus-read-active-file and/or gnus-save-killed-list set to nil ;; then you may have some trouble getting the groups to show up in the first place. ;; With Gnus 5.2.? or later you should be able to find them with "1 0 A m ^nndsc RET". ;; Before Gnus 5.2.? with those variables set to nil you'll need to uncomment ;; out the other definition of nndsc-request-newgroups -- ONLY DO THIS ONCE. ;; after nndsc tells Gnus about the groups save your .newsrc, quit and reload nndsc.el. ;;; WARNINGS ;; listing all groups is _really_ slow, that's edsc's fault. ;; you may want to put discuss groups at a higher level than other groups ;; and set gnus-activate-level one level below that, or just use 3g ;; to check for new mail or news without checking all discuss meetings. ;; If things go haywire nndsc can get out of sync with edsc; nndsc should detect ;; this in most cases, but if you're not sure what's going on do M-x nndsc-reset. ;; If you add a discuss group with a non-primary name it should mostly work, ;; but Gnus gets confused sometimes because that group doesn't appear in the ;; active file, i'm going to ask Lars what to do about this case. ;; any meeting all of whose names are illegal newsgroup names will not appear. ;;; TODO ;; reconsider which edsc query to use for getting transactions ;; separate meetings by server so gnus's code to handle downed servers works ;; make posting really work, gnus seems unwilling to use nndsc-request-post ;; and when it does it does weird things with it. ;; IDEA: never create synthetic message-id's for articles that have real ones ;; instead: (put real-message-id 'nndsc-txn-location (cons group txn-num)) ;; or even without the group name in an obarray associated with the group ;; we would have to notice message-id's in references and reply-to's ;; but then we wouldn't need the advice, i like this idea. ;; gti doesn't give us the real message-id, so it still wouldn't be perfect ;; Rent any and all Terry Gilliam movies ;; Staple bagels to your face ;; Write info file documentation (defvar nndsc-edsc-pathname "edsc" "*Name of program to run as slave process for discuss.") (defconst nndsc-version "nndsc 1.1") (require 'gnus) (require 'nnheader) (require 'nnoo) (nnoo-declare nndsc) (defvoo nndsc-coding-system-for-read 'no-conversion "*coding-system for read from edsc") (eval-when-compile (require 'cl)) (if (assoc "nndsc" gnus-valid-select-methods) nil (setq gnus-valid-select-methods (cons '("nndsc" none) gnus-valid-select-methods))) (defun nndsc-reset nil "Call this when nndsc gets out of sync with edsc, it will remove any pending queries, kill edsc, kill the process buffer, and generally lose state. Hopefully subsequent commands will restart edsc with a fresh consistent state. This should never signal an error or message anything regardless of any bogon invalid state and especially not in a sane state. It could be called from a normal close of the server. " (interactive) (if (nndsc-process-running-p nndsc-edsc-process) (condition-case nil (progn ;; Can't use nndsc-do-edsc-cmd because this function ;; should work when things are already out of sync. (nndsc-edsc-send-query nndsc-edsc-process "(quit)\n") (sleep-for 1) ; XXX (kill-process nndsc-edsc-process)) (error nil))) (condition-case nil (kill-buffer (process-buffer nndsc-edsc-process)) (error nil)) (setq nndsc-edsc-process nil) (setq nndsc-pending 0) (setq nndsc-pending-list nil) (condition-case nil (kill-buffer nndsc-edsc-buffer) (error nil)) (setq nndsc-edsc-buffer nndsc-edsc-buffer-name) t) ;; external ;;;###autoload (defun nndsc-open-server (server &optional definitions) (prog1 (cond (;; already open (and (nndsc-process-running-p nndsc-edsc-process) (buffer-live-p (process-buffer nndsc-edsc-process))) nndsc-edsc-process) (;; dead or not opened yet t ;; paranoia, make sure we get a fresh buffer, etc. (nndsc-reset) (let ((process-connection-type nil) ; pipe (coding-system-for-read nndsc-coding-system-for-read)) (setq nndsc-edsc-buffer (get-buffer-create nndsc-edsc-buffer-name)) (setq nndsc-edsc-process (start-process " *nndsc-edsc*" nndsc-edsc-buffer nndsc-edsc-pathname))) (set-process-sentinel nndsc-edsc-process 'nndsc-edsc-sentinel) (setq nndsc-pending 0) (setq nndsc-pending-list nil) ;; check the protocol version (save-excursion (set-buffer nndsc-edsc-buffer) (erase-buffer) (setq nndsc-edsc-version (nndsc-do-edsc-cmd "(gpv)\n")) (if (consp nndsc-edsc-version) (setq nndsc-edsc-version (car nndsc-edsc-version)) (setq nndsc-edsc-version 10)) (nnheader-message 3 "nndsc: Started edsc process... version %d.%d" (/ nndsc-edsc-version 10) (% nndsc-edsc-version 10)) (nndsc-process-running-p nndsc-edsc-process)))) (setq nndsc-status-string ""))) ;;;###autoload (defun nndsc-request-close nil (nndsc-close-server nil)) ;;;###autoload (defun nndsc-server-opened (&optional server) (nndsc-process-running-p nndsc-edsc-process)) ;;;###autoload (defun nndsc-close-server (&optional server) (nnheader-message 7 (concat "nndsc: Closing server " server)) ;; pending queries would only reset the server would would be annoying ;; so instead just use nndsc-reset (nndsc-reset) t) ;;;###autoload (defun nndsc-status-message (&optional server) nndsc-status-string) ;;;###autoload (defun nndsc-request-type (group &optional article) ;; this is just a kludge, i'm not even sure if dsmail always runs as daemon (if (and article (string-match "^daemon" (nth 12 (nndsc-do-edsc-cmd (format "(gti %d %s)\n" article group))))) 'mail 'news)) ;;;###autoload (defun nndsc-request-article (article &optional group server to-buffer) (nnheader-message 9 "nndsc: Reading article %s..." article) (catch 'abort (save-excursion (let* ((group (setq nndsc-current-group (or group nndsc-current-group))) (article-num (cond ((numberp article) article) ((stringp article) (let ((foo (nndsc-extract-id article))) (if (null foo) (throw 'abort nil)) (setq group (nth 0 foo)) (string-to-int (nth 1 foo)))) (t (throw 'abort nil)))) (article-data-1 (nndsc-do-edsc-cmd (format "(gtfc 1 %d %s)\n" article-num group))) ;; The gtf edsc query has a stupid bug, ;; it never closes the files, so you run ;; out of file descriptors. so we use gtfc. (article-data (if (listp article-data-1) (cdr article-data-1))) (tmpfile (if (listp article-data-1) (car article-data-1))) (article-header (if (consp article-data) (nndsc-create-header article-data group))) dsmail-archive) (if (null article-header) (throw 'abort nil)) (set-buffer (or to-buffer nntp-server-buffer " *nntpd*")) (erase-buffer) (let ((coding-system-for-read nndsc-coding-system-for-read)) (insert-file tmpfile)) (goto-char (point-min)) (insert "X-Discuss-Garbage: ") (beginning-of-line 2) (cond ((looking-at "^Subject:") (replace-match "X-Discuss-Subject: ") (beginning-of-line 2))) (if (setq dsmail-archive (nndsc-dsmail-mail-p)) (save-restriction (cond ((looking-at "^From ") (replace-match "X-Discuss-From-Line: ") (beginning-of-line 2))) (nnheader-narrow-to-headers) (mapcar (function (lambda (s) (goto-char (point-min)) (cond ((re-search-forward s nil t) (beginning-of-line) (insert "X-Discuss-"))))) '("^Message-Id:" "^References:" "^Newsgroups:"))) (insert "\n")) (nnheader-narrow-to-headers) (let ((headers (mail-header-extract))) (goto-char (point-min)) (while (looking-at "^Discuss") (forward-line 1)) (if (not dsmail-archive) (insert "Newsgroups: nndsc:" group "\n")) (if (not (assq 'subject headers)) (insert "Subject: " (aref article-header 1) "\n")) (if (not (assq 'from headers)) (insert "From: " (aref article-header 2) "\n")) (if (not (assq 'date headers)) (insert "Date: " (aref article-header 3) "\n")) (insert "Message-Id: " (aref article-header 4) "\n") (if (string= "" (aref article-header 5)) nil (insert "References: " (aref article-header 5) "\n")) (mapcar 'message-remove-header '("Chars" "Lines" "Xref"))) (widen) (goto-char (point-max)) (forward-line -1) ;; remove the --[###]-- (pref = [###]) (let ((trailing-garbage (buffer-substring (point) (point-max)))) (delete-region (point) (point-max)) (goto-char (point-min)) (forward-line 1) (insert "X-Discuss-Garbage: " trailing-garbage)) (nndsc-insert-lines) (goto-char (point-min)) (nnheader-message 9 "nndsc: Reading article %s...done" article) (cons group article-num))))) ;; XXX see the TODO entry (require 'advice) (defadvice gnus-copy-article-buffer (after nndsc-restore-headers activate) (save-excursion (set-buffer gnus-article-copy) (goto-char (point-min)) (if (looking-at "^Discuss") (save-restriction (nnheader-narrow-to-headers) (let ((id (mail-fetch-field "X-Discuss-Message-Id")) (ref (mail-fetch-field "X-Discuss-References"))) (message-remove-header "X-Discuss-Message-Id") (message-remove-header "X-Discuss-References") (message-remove-header "Message-Id") (message-remove-header "References") (if id (nnheader-replace-header "Message-Id" id)) (if ref (nnheader-replace-header "References" ref)))))) gnus-article-copy) ;;;###autoload (defun nndsc-close-group (group &optional server) t) ;;;###autoload (defun nndsc-open-group (group &optional server) (setq nndsc-current-group group)) ;;;###autoload (defun nndsc-request-group (group &optional server dont-check info) ;; XXX dont-check is undocumented and i should probably not being throwing it away (nnheader-message 9 "nndsc: Reading group %s" group) (nndsc-open-group group server) (save-excursion (let ((data (nndsc-do-edsc-cmd (format "(gmi %s)\n" group)))) (set-buffer (or nntp-server-buffer " (get-buffer-create *nntpd*")) (erase-buffer) (nnheader-message 9 "nndsc: Reading group %s...done" group) (if (eq ?\; data) nil (insert (format "211 %d %d %d %s\n" (nth 4 data);; last =~ total number of articles in group ? (nth 5 data);; lowest (nth 6 data);; highest (nth 1 data);; name )) t)))) (defun nndsc-create-header (article-data group) (vector (nth 0 article-data) ; article-number (nth 11 article-data) (if (nth 14 article-data) (format "<%s> (%s)" (nth 12 article-data) (nth 14 article-data)) (format "%s" (nth 12 article-data))) (nndsc-sanitize-date (nth 8 article-data));; date (nndsc-make-id group (nth 0 article-data) "unknown-discuss-server");; id (if (> (nth 3 article-data) 0) (nndsc-make-id group (nth 3 article-data) "unknown-discuss-server");; references "") (nth 10 article-data);; chars (nth 9 article-data);; lines "" ;;(format "Xref: unknown-discuss-server %s:%d" group (nth 0 article-data)) )) ;; XXX the arguments imply i should be able to handle a list of message-id's, oops ;;;###autoload (defun nndsc-retrieve-headers (articles &optional group server fetch-old) (nnheader-message 7 "nndsc: Reading %d headers%s..." (length articles) (if group (concat " in group " group) "")) (save-excursion (let ((remain (length articles)) (minfo (nndsc-do-edsc-cmd (format "(gmi %s)\n" group))) data) (mapcar (function (lambda (article) (nndsc-do-edsc-cmd (format "(gti %d %s)\n" article group) t))) articles) (set-buffer (or nntp-server-buffer " (get-buffer-create *nntpd*")) (erase-buffer) (while (> remain 0) (nnheader-message 8 "nndsc: Reading headers... %d left" remain) (setq data (nndsc-edsc-read-response nndsc-edsc-process)) (setq remain (1- remain)) ;;(set-buffer nntp-server-buffer) (if (listp data) (let ((header (nndsc-create-header data group))) ;; avoid garbage, don't generate extra strings ;; (insert (format "%d %s %s %s %s %s %d %d %s\n" (insert (int-to-string (aref header 0)) ?\t (aref header 1) ?\t (aref header 2) ?\t (aref header 3) ?\t (aref header 4) ?\t (aref header 5) ?\t (int-to-string (aref header 6)) ?\t (int-to-string (aref header 7)) ?\t (aref header 8) ?\n )))))) (nnheader-message 7 "nndsc: Reading headers...done") 'nov) ;;;###autoload (defun nndsc-retrieve-groups (groups &optional server) (nnheader-message 7 "nndsc: Reading %d groups..." (length groups)) (save-excursion (let ((remain (length groups)) data) (mapcar (function (lambda (g) (nndsc-do-edsc-cmd (format "(gmi %s)\n" g) t))) groups) (set-buffer nntp-server-buffer) (erase-buffer) (while (> remain 0) (nnheader-message 8 "nndsc: Reading groups... %d left (waiting for %s)" remain (car groups)) (setq data (nndsc-edsc-read-response nndsc-edsc-process)) (setq remain (1- remain)) ;;(set-buffer nntp-server-buffer) (if (listp data) ;; (insert (format "%s %d %d %c\n" (insert (car groups) ? (int-to-string (nth 4 data)) ? (int-to-string (nth 3 data)) ? ?n ?\n )) (setq groups (cdr groups))))) (nnheader-message 7 "nndsc: Reading groups...done") 'active) (defun nndsc-choose-group-name (m) (setq m (cdr m)) (while (and (consp m) (stringp (car m)) (string-match "[ \t:+]" (car m))) (setq m (cdr m))) (if (consp m) (car m) m)) ;;;###autoload (defun nndsc-request-list (&optional server) (nnheader-message 7 "nndsc: Getting list of groups...") (save-excursion (set-buffer (get-buffer-create " *nndsc-tmp-meetings*")) (erase-buffer) (insert-file (or (getenv "MEETINGS") (substitute-in-file-name "$HOME/.meetings"))) (let* ((num-meetings (count-lines (point-min) (point-max))) (time (/ num-meetings 3.0)) (msg (if (> time 60.0) (nnheader-message 7 "nndsc: Getting list of groups... (expect this to take %.1fm)" (/ time 60.0)) (nnheader-message 7 "nndsc: Getting list of groups... (expect this to take %ds)" time))) (meetings (nndsc-do-edsc-cmd "(gml)\n")) (meetingnames (mapcar 'nndsc-choose-group-name meetings))) (nnheader-message 7 "nndsc: Getting list of groups...done") (nndsc-retrieve-groups meetingnames server)))) ;;; XXX ??? ;;(defun nndsc-request-newgroups (date &optional server) ;; (nndsc-request-list server)) ;;;###autoload (defun nndsc-request-newgroups (date &optional server) nil) ;;;###autoload (defun nndsc-extract-meeting-from-group (group) (substring group (1+ (string-match ":" group)))) ;;;###autoload (defun nndsc-request-post (&optional server) (message-narrow-to-headers) (let* ((group (message-fetch-field "Newsgroups")) (meeting (nndsc-extract-meeting-from-group group)) (refs (message-fetch-field "References")) (pref-ref (if refs (substring refs (string-match "<[^>]*> *$" refs)))) (pref (if refs (string-to-number (nth 1 (nndsc-extract-id pref-ref))))) (subject (message-fetch-field "Subject")) (tmpfile "/tmp/nndsc.post")) ; XXX (widen) (goto-char (point-min)) (search-forward "\n\n") (nnheader-message 6 "Sending...") (write-region (point) (point-max) tmpfile) (if (not (equal ?\; (nndsc-do-edsc-cmd (format "(at %d %s %s)\n%s\n" pref tmpfile meeting subject))) ) (nnheader-message 6 "Sending...done") nil))) ;;`(nnchoke-request-post &optional SERVER)' ;;; this one has gone away with the advent of message-mode ;;`(nnchoke-request-post-buffer POST GROUP SUBJECT HEADER ARTICLE-BUFFER INFO FOLLOW-TO RESPECT-POSTER)' ;;; internal (defvar nndsc-edsc-version nil "edsc protocol version, need >= 2.5") (defvar nndsc-edsc-process nil "edsc process") (defvar nndsc-edsc-buffer-name " *nndsc-tmp*") (defvar nndsc-edsc-buffer nndsc-edsc-buffer-name "edsc output buffer") ;; I think there are various race conditions possible if this is true (defvar nndsc-debug-record-queries nil "whether to put the queries sent in the *nndsc-tmp* buffer") (defvar nndsc-pending 0 "number of pending queries sent to edsc") (defvar nndsc-max-pending 2 "maximum number of queries sent to edsc without reading responses") (defvar nndsc-pending-list nil "list of queries queued because pending > max-pending") (defvar nndsc-read-marker nil "we've read forms up till here") (defvar nndsc-status-string "" "last error message from edsc") (defvar nndsc-current-group nil) (defvar nndsc-edsc-last-io-time nil) (defvar nndsc-edsc-forced-timeout 120.0) (defun nndsc-edsc-try-read-response (process) ;; return nil ?; ?- or FORM ;; doesn't care where the point is and leaves it nowhere it particular (let ((buffer (process-buffer process))) (if (bufferp buffer) nil (setq buffer (get-buffer-create nndsc-edsc-buffer)) (set-process-buffer process buffer)) (set-buffer buffer) ;; this should be unnecessary, we can return nil in this case ;; (if (eq (point-min) (point-max)) ;; (save-excursion ;; (accept-process-output process))) (goto-char (point-min)) (let ((end-of-line (search-forward "\n" nil t)) retval) (if end-of-line (progn ;; we got something (goto-char (point-min)) (cond ;; error ((eq (char-after (point)) ?\;) (setq nndsc-status-string (buffer-substring (1+ (point)) (1- end-of-line))) (message "nndsc: %s" nndsc-status-string) (delete-region (point-min) end-of-line) ?\;) ;; warning ((eq (char-after (point)) ?- ) (setq nndsc-status-string (buffer-substring (1+ (point)) (1- end-of-line))) (message "nndsc: %s" nndsc-status-string) (delete-region (point-min) end-of-line) ?-) ;; query, don't use this except for debugging ((eq (char-after (point)) ?> ) (delete-region (point-min) end-of-line) nil) ;; another style of warning ((looking-at "discuss: ") (setq nndsc-status-string (buffer-substring (match-end 0) (1- end-of-line))) (message "nndsc: %s" nndsc-status-string) (delete-region (point-min) end-of-line) ?-) ;; no error (t (narrow-to-region (point-min) end-of-line) (prog1 (condition-case err (read buffer) (error (setq nndsc-status-string "Can't parse edsc output") (message "nndsc: %s" nndsc-status-string) ?\;)) (widen) (delete-region (point-min) end-of-line))))))))) ;; XXX the nndsc-pending stuff needs to be made per-process (defun nndsc-edsc-read-response (process) (save-excursion (accept-process-output) (let ((retval (nndsc-edsc-try-read-response process))) (while (or (not retval) (eq retval ?-)) (accept-process-output process 1) (setq retval (nndsc-edsc-try-read-response process))) (setq nndsc-pending (1- nndsc-pending)) (cond (nndsc-pending-list (nndsc-edsc-send-query process (car nndsc-pending-list)) (setq nndsc-pending-list (cdr nndsc-pending-list)))) retval))) (defun nndsc-edsc-send-query (process cmd) ;; i think this causes race conditions, don't use it except for debugging (cond (nndsc-debug-record-queries (set-buffer (process-buffer process)) (goto-char (point-max)) (beginning-of-line) (insert ">" cmd))) (send-string nndsc-edsc-process cmd) (setq nndsc-pending (1+ nndsc-pending))) (defun nndsc-do-edsc-cmd (cmd &optional no-wait) (if (or (and (/= nndsc-pending 0) (not no-wait)) (and nndsc-edsc-last-io-time (< nndsc-edsc-last-io-time (- (float-time) nndsc-edsc-forced-timeout)))) (progn (message "nndsc: Got out of sync, restarting edsc...") (sit-for 0) (setq nndsc-edsc-last-io-time (float-time)) (nndsc-reset) (nndsc-open-server 'server)) (setq nndsc-edsc-last-io-time (float-time))) (if (< nndsc-pending nndsc-max-pending) (nndsc-edsc-send-query nndsc-edsc-process cmd) (setq nndsc-pending-list (nconc nndsc-pending-list (list cmd)))) (if no-wait nil (nndsc-edsc-read-response nndsc-edsc-process))) (defun nndsc-edsc-sentinel (process signal) (let ((buffer (process-buffer process)) (status (process-status process)) (errmsg (substring signal 0 -1))) (cond ((eq status 'signal) (ding) (setq nndsc-status-string errmsg))) (message "nndsc closing connection: %s." errmsg) (sit-for 0))) (defun nndsc-process-running-p (process) (and process (processp process) (eq (process-status process) 'run))) (defun nndsc-make-id (path number host) (format "<%s:%d@%s>" path number host)) (defun nndsc-extract-id (message-id) (if (string-match "<\\([^:]*\\):\\([^@]*\\)@\\([^>]*\\)>" message-id) (list (substring message-id (match-beginning 1) (match-end 1)) (substring message-id (match-beginning 2) (match-end 2)) (substring message-id (match-beginning 3) (match-end 3))))) (defun nndsc-dsmail-mail-p nil "return non-nil iff the current buffer looks like a mail message from dsmail" (save-excursion (and (nnheader-article-p) (goto-char (point-min)) (search-forward "\n\n" nil t) ;; there are some real headers (save-excursion (re-search-backward "^To:" nil t)) ;; there's something after this (save-excursion (re-search-forward "\\S-" nil t)) ))) (defun nndsc-insert-lines () "Insert how many lines there are in the body of the mail. Return the number of characters in the body." (let (lines chars) (save-excursion (goto-char (point-min)) (when (search-forward "\n\n" nil t) (setq chars (- (point-max) (point))) (setq lines (count-lines (point) (point-max))) (forward-char -1) (save-excursion (when (re-search-backward "^Lines: " nil t) (delete-region (point) (progn (forward-line 1) (point))))) (beginning-of-line) (insert (format "Lines: %d\n" (max lines 0))) chars)))) ;; this is how the date currently comes out of edsc ;; (nndsc-sanitize-date "07/29/96 01:36") ;; (nndsc-sanitize-date "07/29/:6 01:36") ;; these are dates i want to handle in case this changes ;; (nndsc-sanitize-date "07/29/1996 01:36") ;; (nndsc-sanitize-date "07/29/106 01:36") ;; (nndsc-sanitize-date "07/29/2006 01:36") ;; murphy's law sez the athena maintainer chose yet another format ;; (nndsc-sanitize-date "07/29/06 01:36") (defconst nndsc-vector-o-months ["" "Jan" "Feb" "Mar" "Apr" "May" "Jun" "Jul" "Aug" "Sep" "Oct" "Nov" "Dec"]) (defun nndsc-sanitize-date (bad-date) (assert (and (eq ?/ (aref bad-date 2)) (eq ?/ (aref bad-date 5)))) ;; this is a recognizable date, don't bother with regexps (format "%d %s %d %s %s" (+ (* 10 (- (aref bad-date 3) ?0)) (- (aref bad-date 4) ?0)) (aref nndsc-vector-o-months (+ (* 10 (- (aref bad-date 0) ?0)) (- (aref bad-date 1) ?0))) (let (data year) (if (eq ? (aref bad-date 8)) (setq year (+ (* 10 (- (aref bad-date 6) ?0)) (- (aref bad-date 7) ?0))) (setq data (read-from-string bad-date 6) year (car data)) (if (/= 8 (cdr data)) (setq bad-date (substring bad-date (- (cdr data) 8))))) (cond ((not (numberp year)) nil) ((> year 1000) year) ((< year 70) (+ 2000 year)) (t (+ 1900 year)))) (substring bad-date 9) (cadr (current-time-zone)))) (defvar nndsc-subscribe-newsgroup-method 'gnus-subscribe-newsgroup-method "*Function for nndsc to use to force a new meeting into the zombie list depending on your setting of gnus-check-new-newsgroups you may need this since we don't support being asked for new groups. Besides, we may as well do this now since we have the data. The only disadvantage is if you prefer to jump to the group (In which case you choose the name) then you'll have to kill the existing zombie group, just set this to nil") (if gnus-summary-mode-map (define-key gnus-summary-mode-map "\C-c\C-a" 'nndsc-summary-add-mtg)) (condition-case nil (require 'gnus-util) (error nil)) (defun nndsc-summary-add-mtg (n) (interactive "P") (gnus-set-global-variables) (let ((articles (gnus-summary-work-articles n)) article) (while (setq article (pop articles)) (when (gnus-summary-select-article t nil nil article) (gnus-eval-in-buffer-window gnus-original-article-buffer (apply 'nndsc-add-mtg (nndsc-discuss-parse-meeting-announcement))) (gnus-article-hide-headers-if-wanted)) (gnus-summary-remove-process-mark article)))) ;;;###autoload (defun nndsc-add-mtg (host pathname) "Add a discuss meeting from an article." (interactive (or (and (null current-prefix-arg) (nndsc-discuss-parse-meeting-announcement)) (list (read-input "Host Name: ") (read-input "Pathname: " "/usr/spool/discuss/")))) (nnheader-message 7 "Trying to add meeting...") (let (result) (setq result (nndsc-do-edsc-cmd (format "(am %s %s)\n" host pathname))) (unless (eq ?\; result) (setq result (nndsc-choose-group-name result)) ;; this is only a temporary measure ;; the right thing is to keep a list of new_meetings meetings ;; to check when asked for new meetings as of some date (if (null nndsc-subscribe-newsgroup-method) (nnheader-message 7 "Trying to add meeting...done") (funcall (if (fboundp nndsc-subscribe-newsgroup-method) nndsc-subscribe-newsgroup-method (symbol-value nndsc-subscribe-newsgroup-method)) result) (nnheader-message 6 "Meeting added as %s" result)) ))) ;;(global-set-key "\C-x9n" 'nndsc-add-mtg) ;; stolen from discuss-misc.el (defun nndsc-discuss-parse-meeting-announcement () (let (host pathname arg-start) (save-excursion (goto-char (point-min)) (if (not (search-forward " Meeting Name: " nil t)) (error "Not a meeting announcement.")) (forward-line 1) (if (not (search-forward " Host: " nil t)) (error "Not a meeting announcement.")) (setq arg-start (point)) (end-of-line) (setq host (buffer-substring arg-start (point))) (forward-line 1) (if (not (search-forward " Pathname: " nil t)) (error "Not a meeting announcement.")) (setq arg-start (point)) (end-of-line) (setq pathname (buffer-substring arg-start (point))) (list host pathname)))) (provide 'nndsc)