/[cmucl]/src/hemlock/netnews.lisp
ViewVC logotype

Diff of /src/hemlock/netnews.lisp

Parent Directory Parent Directory | Revision Log Revision Log | View Patch Patch

revision 1.3 by chiles, Tue Jul 30 10:26:04 1991 UTC revision 1.4 by chiles, Thu Aug 1 11:11:48 1991 UTC
# Line 1  Line 1 
1  ;;; -*- Package: Hemlock; Log: hemlock.log -*-  ;;; -*- Package: Hemlock; Log: hemlock.log -*-
2  ;;;  ;;;
3  ;;; **********************************************************************  ;;; **********************************************************************
4  ;;; This code was written as part of the Spice Lisp project at  ;;; This code was written as part of the CMU Common Lisp project at
5  ;;; Carnegie-Mellon University, and has been placed in the public domain.  ;;; Carnegie Mellon University, and has been placed in the public domain.
6  ;;; Spice Lisp is currently incomplete and under active development.  ;;; If you want to use this code or any part of CMU Common Lisp, please contact
7  ;;; If you want to use this code or any part of Spice Lisp, please contact  ;;; Scott Fahlman or slisp-group@cs.cmu.edu.
 ;;; Scott Fahlman (FAHLMAN@CMUC).  
8  ;;; **********************************************************************  ;;; **********************************************************************
9  ;;;  ;;;
10  ;;;    Written by Blaine Burks  ;;;    Written by Blaine Burks
# Line 39  Line 38 
38               (lambda (nn s d)               (lambda (nn s d)
39                 (declare (ignore nn d))                 (declare (ignore nn d))
40                 (write-string "#<Netnews Info>" s))))                 (write-string "#<Netnews Info>" s))))
   ;;  
41    (updatep (ext:required-argument) :type (or null t))    (updatep (ext:required-argument) :type (or null t))
42    (from-end-p nil :type (or null t))    (from-end-p nil :type (or null t))
43      ;;
44    ;; The string name of the current bboard.    ;; The string name of the current bboard.
45    (current (ext:required-argument) :type simple-string)    (current (ext:required-argument) :type simple-string)
46      ;;
47    ;; The number of the latest message read in the current group.    ;; The number of the latest message read in the current group.
48    (latest nil :type (or null fixnum))    (latest nil :type (or null fixnum))
49      ;;
50    ;; The cache of header info for the current bboard.  Each element contains    ;; The cache of header info for the current bboard.  Each element contains
51    ;; an association list of header fields to contents of those fields.  Indexed    ;; an association list of header fields to contents of those fields.  Indexed
52    ;; by id offset by the first message in the group.    ;; by id offset by the first message in the group.
   ;;  
53    (header-cache nil :type (or null vector))    (header-cache nil :type (or null vector))
54      ;;
55    ;; The number of HEAD requests currently waiting on the header stream.    ;; The number of HEAD requests currently waiting on the header stream.
   ;;  
56    (batch-count nil :type (or null fixnum))    (batch-count nil :type (or null fixnum))
57      ;;
58    ;; The list of newsgroups to read.    ;; The list of newsgroups to read.
59    (groups (ext:required-argument) :type cons)    (groups (ext:required-argument) :type cons)
60      ;;
61    ;; A vector of message ids indexed by buffer-line for this headers buffer.    ;; A vector of message ids indexed by buffer-line for this headers buffer.
62    (message-ids nil :type (or null vector))    (message-ids nil :type (or null vector))
63      ;;
64    ;; Where to insert the next batch of headers.    ;; Where to insert the next batch of headers.
65    mark    mark
66      ;;
67    ;; The message buffer used to view article bodies.    ;; The message buffer used to view article bodies.
68    buffer    buffer
69      ;;
70    ;; A list of message buffers that have been marked as undeletable by the user.    ;; A list of message buffers that have been marked as undeletable by the user.
71    (other-buffers nil :type (or null cons))    (other-buffers nil :type (or null cons))
72      ;;
73    ;; The window used to display buffer when \"Netnews Read Style\" is :multiple.    ;; The window used to display buffer when \"Netnews Read Style\" is :multiple.
74    message-window    message-window
75    ;; The window used to display headers when \"Netnews Read Style\" is :multiple.    ;;
76      ;; The window used to display headers when \"Netnews Read Style\" is
77      ;; :multiple.
78    headers-window    headers-window
79      ;;
80    ;; How long the message-ids and header-cache arrays are.  Reuse this array,    ;; How long the message-ids and header-cache arrays are.  Reuse this array,
81    ;; but don't break if there are more messages than we can handle.    ;; but don't break if there are more messages than we can handle.
82    (array-length default-netnews-headers-length :type fixnum)    (array-length default-netnews-headers-length :type fixnum)
83      ;;
84    ;; The id of the first message in the current group.    ;; The id of the first message in the current group.
85    (first nil :type (or null fixnum))    (first nil :type (or null fixnum))
86      ;;
87    ;; The id of the last message in the current-group.    ;; The id of the last message in the current-group.
88    (last nil :type (or null fixnum))    (last nil :type (or null fixnum))
89      ;;
90    ;; Article number of the first visible header.    ;; Article number of the first visible header.
91    (first-visible nil :type (or null fixnum))    (first-visible nil :type (or null fixnum))
92      ;;
93    ;; Article number of the last visible header.    ;; Article number of the last visible header.
94    (last-visible nil :type (or null fixnum))    (last-visible nil :type (or null fixnum))
95      ;;
96    ;; Number of the message that is currently displayed in buffer.  Initialize    ;; Number of the message that is currently displayed in buffer.  Initialize
97    ;; to -1 so I don't have to constantly check for the nullness of it.    ;; to -1 so I don't have to constantly check for the nullness of it.
98    (current-displayed-message -1 :type (or null fixnum))    (current-displayed-message -1 :type (or null fixnum))
99      ;;
100    ;; T if the last batch of headers is waiting on the header stream.    ;; T if the last batch of headers is waiting on the header stream.
101    ;; This is needed so NN-WRITE-HEADERS-TO-MARK can set the messages-waiting    ;; This is needed so NN-WRITE-HEADERS-TO-MARK can set the messages-waiting
102    ;; slot to nil.    ;; slot to nil.
103    (last-batch-p nil :type (or null t))    (last-batch-p nil :type (or null t))
104      ;;
105    ;; T if there are more headers in the current group. Nil otherwise.    ;; T if there are more headers in the current group. Nil otherwise.
106    (messages-waiting nil :type (or null t))    (messages-waiting nil :type (or null t))
107      ;;
108    ;; The stream on which we request headers from NNTP.    ;; The stream on which we request headers from NNTP.
109    header-stream    header-stream
110      ;;
111    ;; The stream on which we request everything but headers from NNTP.    ;; The stream on which we request everything but headers from NNTP.
112    stream)    stream)
113    
# Line 411  Line 429 
429                     (setf (nn-info-first nn-info) first)                     (setf (nn-info-first nn-info) first)
430                     (setf (nn-info-last nn-info) last)                     (setf (nn-info-last nn-info) last)
431                     (setf (nn-info-latest nn-info) latest))                     (setf (nn-info-latest nn-info) latest))
432                     ;;
433                   ;; Request the batch before setting message-ids so they start                   ;; Request the batch before setting message-ids so they start
434                   ;; coming before we need them.                   ;; coming before we need them.
                  ;;  
435                   (nn-request-next-batch nn-info                   (nn-request-next-batch nn-info
436                                          (value netnews-fetch-all-headers))                                          (value netnews-fetch-all-headers))
437                   (let ((message-ids (nn-info-message-ids nn-info))                   (let ((message-ids (nn-info-message-ids nn-info))
# Line 427  Line 445 
445                                        (make-array length :fill-pointer 0                                        (make-array length :fill-pointer 0
446                                                    :initial-element nil)))                                                    :initial-element nil)))
447                               (message-ids                               (message-ids
448                                (when (aref header-cache 0)                                (unless (zerop (length header-cache))
449                                  (fill header-cache nil))                                  (fill header-cache nil))
450                                (setf (fill-pointer message-ids) 0)                                (setf (fill-pointer message-ids) 0)
451                                (setf (fill-pointer header-cache) 0)                                (setf (fill-pointer header-cache) 0)
# Line 1330  Line 1348 
1348     pointer."     pointer."
1349    (nn-punt-headers (if p :none :latest)))    (nn-punt-headers (if p :none :latest)))
1350    
1351  (defcommand "Netnews Punt Headers" (p)  (defcommand "Netnews Group Punt Messages" (p)
1352    "Go on to the next group in \"Netnews Groups\" setting the netnews pointer    "Go on to the next group in \"Netnews Groups\" setting the netnews pointer
1353     for this bboard to the last visible message.  With an argument, set the     for this bboard to the last visible message.  With an argument, set the
1354     pointer to the last message in this group."     pointer to the last message in this group."
# Line 1678  Line 1696 
1696    
1697  ;;; NN-REPLY-USING-CURRENT-WINDOW makes sure there is only one window for a  ;;; NN-REPLY-USING-CURRENT-WINDOW makes sure there is only one window for a
1698  ;;; normal reply.  *netnews-post-frob-windows-hook* is bound to this when  ;;; normal reply.  *netnews-post-frob-windows-hook* is bound to this when
1699  ;;; "Netnews Reply To Message" is invoked."  ;;; "Netnews Reply to Group" is invoked."
1700  ;;;  ;;;
1701  (defun nn-reply-using-current-window (post-info buffer)  (defun nn-reply-using-current-window (post-info buffer)
1702    (declare (ignore post-info))    (declare (ignore post-info))
# Line 1711  Line 1729 
1729            (post-info-reply-window post-info) reply-window)))            (post-info-reply-window post-info) reply-window)))
1730    
1731  ;;; NN-REPLY-CLEANUP-SPLIT-WINDOWS just deletes one of the windows that  ;;; NN-REPLY-CLEANUP-SPLIT-WINDOWS just deletes one of the windows that
1732  ;;; "Netnews Reply to Message in Other Window" created, if they still exist.  ;;; "Netnews Reply to Group in Other Window" created, if they still exist.
1733  ;;;  ;;;
1734  (defun nn-reply-cleanup-split-windows (post-buffer)  (defun nn-reply-cleanup-split-windows (post-buffer)
1735    (let* ((post-info (variable-value 'post-info :buffer post-buffer))    (let* ((post-info (variable-value 'post-info :buffer post-buffer))
# Line 1720  Line 1738 
1738                 (member reply-window *window-list*))                 (member reply-window *window-list*))
1739        (delete-window reply-window))))        (delete-window reply-window))))
1740    
1741  (defcommand "Netnews Reply to Message" (p)  (defcommand "Netnews Reply to Group" (p)
1742    "Set up a POST buffer and insert the proper newgroups: and subject: fields.    "Set up a POST buffer and insert the proper newgroups: and subject: fields.
1743     Should be invoked from a \"News-Message\" or \"News-Headers\" buffer.     Should be invoked from a \"News-Message\" or \"News-Headers\" buffer.
1744     In a message buffer, reply to the message in that buffer, in a headers     In a message buffer, reply to the message in that buffer, in a headers
# Line 1733  Line 1751 
1751    (let ((*netnews-post-frob-windows-hook* #'nn-reply-using-current-window))    (let ((*netnews-post-frob-windows-hook* #'nn-reply-using-current-window))
1752      (nn-reply-to-message)))      (nn-reply-to-message)))
1753    
1754  (defcommand "Netnews Reply to Message in Other Window" (p)  (defcommand "Netnews Reply to Group in Other Window" (p)
1755    "Does exactly what \"Netnews Reply to Message\" does, but makes two windows.    "Does exactly what \"Netnews Reply to Group\" does, but makes two windows.
1756     One of the windows displays the message being replied to, and the other     One of the windows displays the message being replied to, and the other
1757     displays the reply."     displays the reply."
1758    "Does exactly what \"Netnews Reply to Message\" does, but makes two windows.    "Does exactly what \"Netnews Reply to Group\" does, but makes two windows.
1759     One of the windows displays the message being replied to, and the other     One of the windows displays the message being replied to, and the other
1760     displays the reply."     displays the reply."
1761    (declare (ignore p))    (declare (ignore p))
# Line 1780  Line 1798 
1798      (nn-reply-using-current-window nil draft-buffer)))      (nn-reply-using-current-window nil draft-buffer)))
1799    
1800    
1801  (defcommand "Netnews Reply via Mail" (p)  (defcommand "Netnews Reply to Sender" (p)
1802    "Reply to the sender of a message via mail using the Hemlock mailer."    "Reply to the sender of a message via mail using the Hemlock mailer."
1803    "Reply to the sender of a message via mail using the Hemlock mailer."    "Reply to the sender of a message via mail using the Hemlock mailer."
1804    (declare (ignore p))    (declare (ignore p))
# Line 2303  Line 2321 
2321    
2322  (defun nntp-post (stream)  (defun nntp-post (stream)
2323    (write-nntp-command "post" stream :post))    (write-nntp-command "post" stream :post))
   

Legend:
Removed from v.1.3  
changed lines
  Added in v.1.4

  ViewVC Help
Powered by ViewVC 1.1.5