;;; -*- Mode:Common-Lisp; Package:ZWEI; Base:10; Fonts:(CPTFONT HL12B HL12I MEDFNB) -*-


(defun 4EN-ARTICLE-COMMAND* (newsgroup-component &optional (error t))
  "2Send the NNTP ARTICLE command to the NNTP server. Return T and the
response string if successful.  If error is set to T then signal an error condition
if no such article exists.  If error is set to NIL then return NIL and the response
string if no such article exists.*"
  (en-generic-article-command 'nntp:article-command newsgroup-component error))


(defun 4EN-BODY-COMMAND* (newsgroup-component &optional (error t))
  "2Send the NNTP BODY command to the NNTP server. Return T and the
response string if successful.  If error is set to T then signal an error condition
if no such article exists.  If error is set to NIL then return NIL and the response
string if no such article exists.*"
  (en-generic-article-command 'nntp:body-command newsgroup-component error))


(defun 4EN-CLOSE* ()
  (if *debug-en-nntp* (debug-en-print "~%Closing nntp connection..."))
  (nntp:close-nntp-stream *nntp-stream*)
  (setf *nntp-stream* nil)
  (setf *nntp-server-status* nil)
  (if *debug-en-nntp* (debug-en-print "Done."))
  t)


(defun 4EN-CTRL-N* (newsgroup-component subject)
  "2Scan the newsgroup for an article beginning with subject or if not found the
next* 2unread article. * 2Return T* 2and the subject. * 2Return nil if no unread articles
remain. * 2Subject should be a cons, the car of which is the subject string* 2and the
cdr is the article number.*"
  (loop with scanned-to-end-of-newsgroup = nil and
	count = 0 and
	saved-current-article-number = (send newsgroup-component :current-article-number) and
	saved-previous-article-number = (send newsgroup-component :previous-article-number) do
	(cond
	  ;1;;A next unread article was found.*
	  ((en-get-next-article newsgroup-component nil)
	   (cond
	     ;1;;No subject will match anything.*
	     ((or (null subject) (zerop (length (strip-subject (car subject)))))
	      (send newsgroup-component :set-previous-article-number saved-current-article-number)
	      (return (values t (cons (get-header-field newsgroup-component :subject)
				      (send newsgroup-component :current-article-number)))))
	     ;1;;The subjects match.*
	     ((subjects-equal-p (car subject) (get-header-field newsgroup-component :subject))
	      (send newsgroup-component :set-previous-article-number saved-current-article-number)
	      (return (values t subject)))))
	  ;1;;We have searched for subject starting from the current article to the end of the newsgroup.  Now start from the beginning*
	  ;1;;of the newsgroup.*
	  ((not scanned-to-end-of-newsgroup)
	   (when (send newsgroup-component :end-of-newsgroup-p)
	     (send newsgroup-component :set-current-article-number *start-index*)
	     (setf scanned-to-end-of-newsgroup :first-time)))
	  ;1;;If we get here then we have searched the entire newsgroup for any subject and nothing was found.*
	  ((null subject)
	   (return nil))
	  ;1;;We have searched the entire newsgroup for subject.  Now scan from the subject article number to the end of the*
	  ;1;;newsgroup for any subject.*
	  ((equal scanned-to-end-of-newsgroup :first-time)
	   (when (send newsgroup-component :end-of-newsgroup-p)
	     (setf scanned-to-end-of-newsgroup :last-try)
	     (send newsgroup-component :set-current-article-number (cdr subject))
	     (setf subject nil)))
	  ;1;;There are no more unread articles. *
	  ((equal scanned-to-end-of-newsgroup :last-try)
	   (when (send newsgroup-component :end-of-newsgroup-p)
	     (send newsgroup-component :set-previous-article-number saved-previous-article-number)
	     (return (values nil nil)))))
	(when (zerop (mod count 10))
	  (format *query-io* "."))
	(incf count)))


(defun 4EN-DISPLAY-ARTICLE* (stream newsgroup-component &optional (verbose nil))
  "2Display article on stream and mark the article as read.  If verbose is nil then
format the header.  If verbose is t then display the header as received from the
news server.  The function.  Return T if successful.  Return NIL if the article was
not found.*"
  (when (en-header-p newsgroup-component)
    (send newsgroup-component :mark-article t *mark-xref-articles-p*)
    (when (equal stream t)
      (format stream "~:|~%")
      (format stream "Article ~d ~@[(~a more) ~]in ~a~@[ (~a)~]:"
	      (send newsgroup-component :current-article-number)
	      (when (> (send newsgroup-component :unread-article-count) 0)
		(send newsgroup-component :unread-article-count))
	      (send newsgroup-component :newsgroup-string)
	      (when (send newsgroup-component :moderated-p) "moderated")))
    ;1;;Display the article and protect against the user pressing the abort key in the middle of the display.*
    (condition-case (error-object)
	(progn
	 (cond
	   (verbose
	    (en-article-command newsgroup-component))
	   (t
	    (write-formatted-header stream newsgroup-component *reformat-newsheaders-include-list*
				    *reformat-newsheaders-exclude-list*)
	    (format stream "~%")
	    (en-body-command newsgroup-component)))
	 (nntp:print-nntp-stream *nntp-stream* stream))
      (sys:abort (nntp:flush-nntp-stream *nntp-stream*)))
    t))



(defun 4EN-DISPLAY-ARTICLE-INTO-BUFFER* (buffer newsgroup-component &optional (verbose nil) (rotl nil))
"2Display article into the news buffer and mark the article as read.  If verbose is
nil then format the header.  If verbose is t then display the header as received
from the news server.  Return T if successful.  Return NIL if the article was
not found.*"
  (delete-interval buffer)			;1delete the contents of the buffer.*
  (cond
    ((en-header-p newsgroup-component)
     (send newsgroup-component :mark-article t *mark-xref-articles-p*)
     (let ((stream (interval-stream-into-bp (interval-first-bp buffer)))
	   (count 0))
       (format stream "Article ~d ~@[(~a more) ~]in ~a~@[ (~a)~]:"
	       (send newsgroup-component :current-article-number)
	       (when (> (send newsgroup-component :unread-article-count) 0)
		 (send newsgroup-component :unread-article-count))
	       (send newsgroup-component :newsgroup-string)
	       (when (send newsgroup-component :moderated-p) "moderated"))
       (incf count)
       (cond
	 (verbose
	  (format stream "~%")
	  (en-article-command newsgroup-component))
	 (t
	  (setf count (+ count (write-formatted-header stream newsgroup-component *reformat-newsheaders-include-list*
						       *reformat-newsheaders-exclude-list*)))
	  (format stream "~2%")
	  (incf count)
	  (en-body-command newsgroup-component t)))
       (cond
	 ((dotimes (i (+ (- 5 count) (window-n-plines *window*)) t)
	    (multiple-value-bind (line eof) (nntp:read-nntp-stream *nntp-stream*)
	      (cond
		((not eof)
		 (send stream :line-out (if rotl (rotl-line line) line)))
		(:else
		 (format stream "~2%~a" *end-of-article-line*)
		 (return nil)))))
	  (redisplay *window* :start (interval-first-bp buffer) nil)
	  (redisplay-article-mode-line)
	  (loop 
	    (multiple-value-bind (line eof) (nntp:read-nntp-stream *nntp-stream*)
	      (cond
		(eof (return))
		(t (format stream "~%~a" (if rotl (rotl-line line) line))))))
	  (format stream "~2%~a" *end-of-article-line*))
	 (t
	  (redisplay *window* :start (interval-first-bp buffer) nil)
	  (redisplay-article-mode-line)))
       t))
    (t
     (redisplay *window* :start (interval-first-bp buffer) nil)
     nil)))


(defun 4EN-GENERIC-ARTICLE-COMMAND* (function newsgroup-component error)
  "2Send a generic article command to the NNTP server. Return T and the
response string if successful.  If error is set to T then signal an error condition
if no such article exists.  If error is set to NIL then return NIL and the response
string if no such article exists.  FUNCTION is one of the article selection functions
i.e. 'nntp:article-command, 'nntp:group-command, or, 'nntp:head-command.*"
  ;1;;We will try to recover from errors as much as possible.  If we are not in the newsgroup then we will send a group command*
  ;1;;and try the article command again.  If the connection is not open then try to open the connection and do as before. *
  (if *debug-en-nntp* (debug-en-print "~%Sending nntp command ~a.  Article number = ~a"
				      function
				      (send newsgroup-component :current-article-number)))
  (cond
    ((en-server-open-p)
     (cond
       (error
	(condition-case (cond-obj)
	    (funcall function *nntp-stream* (send newsgroup-component :current-article-number) error)
	  (nntp:*no-selected-newsgroup-code*
	   (progn
	     (nntp:group-command *nntp-stream* (send newsgroup-component :newsgroup-string) nil)
	     (funcall function *nntp-stream* (send newsgroup-component :current-article-number) error)))))
       (t
	(condition-case (cond-obj)
	    (funcall function *nntp-stream* (send newsgroup-component :current-article-number) t)
	  (nntp:*no-selected-newsgroup-code*
	   (progn
	     (nntp:group-command *nntp-stream* (send newsgroup-component :newsgroup-string) nil)
	     (funcall function *nntp-stream* (send newsgroup-component :current-article-number) nil)))
	  (error
	   (values nil cond-obj))))))
    (t
     (en-open nil)
     (nntp:group-command *nntp-stream* (send newsgroup-component :newsgroup-string) nil)
     (funcall function *nntp-stream* (send newsgroup-component :current-article-number) error))))


(defun 4EN-GET-NEXT-ARTICLE* (newsgroup-component &optional (mode nil))
  "2Get the next article (mode = t) or next unread article (mode = nil)  from the
newsgroup.  NIL if there isn't a next article number. *"
  (when (send newsgroup-component :get-next-article-number mode)
    (en-header-p newsgroup-component)))


(defun 4EN-GROUP-COMMAND* (newsgroup-component)
  "2Send the GROUP command for newsgroup-component.  Return T if the
newsgroup can be accessed.  Return NIL if the newsgroup could not be accessed.*"
  (if *debug-en-nntp* (debug-en-print "~%Sending nntp group command for newsgroup ~a"
				      (send newsgroup-component :newsgroup-string)))
  (let (valid-response response-message number-of-articles first-article-number last-article-number)
    (unless (en-server-open-p) (en-open nil))
    (Multiple-value-setq (valid-response response-message)
      (nntp:group-command *nntp-stream* (send newsgroup-component :newsgroup-string) nil))
    (cond
      ;1;;The remote server detected a problem.*
      ((not valid-response)
       nil)
      (t
       (multiple-value-setq (number-of-articles first-article-number last-article-number)
	 (nntp:parse-group response-message))
       (cond
	 ;1;;This means that we were able to read articles in the past, but now the high article number has been reset back*
	 ;1;;to zero.  Something is wrong.  This usually occurs when the newsgroup directory is protected and we are*
	 ;1;;trying to access the directory over NFS.  Accessing the newsgroup directory on the system the directory resides*
	 ;1;;will not cause this error.  *
	 ((and (= 0 number-of-articles first-article-number last-article-number)
	       (not (= 0 (send newsgroup-component :low-article-number)
		       (send newsgroup-component :high-article-number))))
	  nil)
	 ;1;;No errors accessing the newsgroup.*
	 (t
	  t))))))


(defun 4EN-HEAD-COMMAND* (newsgroup-component &optional (error t))
  "2Send the NNTP HEAD command to the NNTP server. Return T and the
response string if successful.  If error is set to T then signal an error condition
if no such article exists.  If error is set to NIL then return NIL and the response
string if no such article exists.*"
  (en-generic-article-command 'nntp:head-command newsgroup-component error))


(defun 4EN-HEADER-P* (newsgroup-component)
  "2Return T if the article header has been retrieved or can be retrieved from the
article.* 2NIL if no such article. *"
    (cond
       ;1;;Has the article header already been stored onto the article number???*
      ((get newsgroup-component (send newsgroup-component :current-article-number))
       t)
      ;1;;Try to read and save the article header onto the article number???  If this fails then no such article.*
      ((en-head-command newsgroup-component nil)
       (parse-and-store-article-header newsgroup-component (send newsgroup-component :current-article-number))
       t)))


(defun 4EN-HEADER-FIELD-P* (newsgroup-component field)
  "2Return T if the header field field can be retrieved.  Otherwise return NIL.
Field should be in the form :subject, :from, :to, etc.*"
  (cond
    ;1;;The field has already been retrieved.*
    ((get-header-field newsgroup-component field)
     t)
    ;1;;Try to read and save the field from the article.*
    ((nntp:xhdr-command *nntp-stream* (format nil "~a ~a" field (send newsgroup-component :current-article-number)) nil)
     (parse-and-store-header-field newsgroup-component field)
     t)
    (t
     nil)))


(defun 4EN-K* (newsgroup-component)
  "2Mark all articles as read that match the subject of the current article.  The
entire newsgroup is searched. *"
  (let ((saved-current-article-number (send newsgroup-component :current-article-number))
        (saved-previous-article-number (send newsgroup-component :previous-article-number)))
    (loop with count = 0 and
	  saved-subject = (get-header-field newsgroup-component :subject)
	  ;1;;There must be a subject to kill.  If not, then just return.*
	  initially (when (zerop (length (strip-re-from-subject (strip-subject saved-subject))))
		      (return nil))
	  initially (send newsgroup-component :set-current-article-number *start-index*)
	  do
	  (cond
	    ((en-get-next-article newsgroup-component nil)
	     (when (subjects-equal-p saved-subject (get-header-field newsgroup-component :subject))
	       (incf count)
	       (send newsgroup-component :mark-article t *mark-xref-articles-p*)
	       ;1;;If we are looking at a summary buffer then mark the summary line in the buffer too.*
	       (when (and (equal *interval* *newsgroup-summary-buffer*) (send *newsgroup-summary-buffer* :get-summary-line))
		 (must-redisplay *window* dis-line (cadr (send *interval* :get-summary-line))
				 *newsgroup-summary-buffer-article-read-column*)
		 (redisplay *window*))
	       (format *query-io* "~d3 *" (send newsgroup-component :current-article-number))))
	    ;1;;If we are not at the end of the newsgroup then continue with the kill.  This usually means that there wasn't an*
	    ;1;;article for the valid article number.  This can happen if the article was canceled by the network.*
	    ((not (send newsgroup-component :end-of-newsgroup-p))
	     t)
	    (t
	     (return))))
    (send newsgroup-component :set-current-article-number saved-current-article-number)
    (send newsgroup-component :set-previous-article-number saved-previous-article-number)))


(defun 4EN-MOUSE-R* (&aux ret)
  "2Handle a mouse right keystroke. Return T if the news system was
reinitialized.  Return :ABORT if no item was selected.  Otherwise return NIL.*"
  (condition-case (cond-obj)
      (case (en-mouse-r-menu)
	('configure-news
	 (configure-news-menu t)
	 (setf ret (initialize-news))
	 (if ret
	     t
	     :abort))
	('reset-the-news-connection
	 (en-close)
	 (en-open)
	 (format *query-io* "~:|Connection reset.")
	 nil)
	('reinitialize-the-news-system
	 (cond
	   ((w:mouse-y-or-n-p "Are you sure you want to initialize news?")
	    (setf ret (initialize-news t))
	    ret)
	   (t
	     :abort)))
	('write-the-newsrc-file
	 (write-newsrc-file-menu)
	 nil)
	('restart-the-background-news-process
	 (reset-news-daemon t)
	 (format *query-io* "~:|Background news process restarted.")
	 nil)
	(otherwise :abort))
    (sys:abort :abort)))


(defun 4EN-MOUSE-R-MENU* ()
  "2Return the function to call.*"
  (w:menu-choose
    *en-mouse-r*
    :default-item (car *en-mouse-r*)
    :label (format nil "Explorer News ~a" *version*)))


(defun 4EN-OPEN* (&optional (verbose t))
  (cond
    ;1;Server is already open.  Return the server stream.*
    ((en-server-open-p)
     *nntp-stream*)
    (t
     (if verbose (format *query-io* "~:|Opening a connection to a remote NNTP server on ~a..." *nntp-host*))
     (multiple-value-setq (*nntp-stream* *nntp-server-status* *nntp-server-message*) (nntp:open-nntp-stream *nntp-host*)))))


(defun 4EN-SERVER-OPEN-P* ()
  "2Return the server stream.  If the server stream is not open return NIL.*"
  (and (streamp *nntp-stream*) (equal (send *nntp-stream* :status) :established) *nntp-stream*))

  
(defun 4EN-VERSION* ()
  "2Display version number.*"
  (format t "~%Version ~a" *version*))


(defun 4EN-/* (newsgroup-component string)
  (loop with 
	saved-current-article-number = (send newsgroup-component :current-article-number) and
	saved-previous-article-number = (send newsgroup-component :previous-article-number) and
	header = nil and
	read = nil and
	slash = (position #\/ string :start 1) 
        initially (when slash
		    (setf header (lisp:search "h" string :start2 slash :test #'string-equal))
		    (setf read (lisp:search "r" string :start2 slash :test #'string-equal)))
	initially (setf string (subseq string 0 slash))
	do
	(cond
	  ;1;;A next unread article was found. *
	  ((en-get-next-article newsgroup-component read)
	   (cond
	     (header
	      (when
		(dolist (item (get newsgroup-component (send newsgroup-component :current-article-number)) nil)
		  (when (lisp:search string (cadr item) :test #'string-equal)
		    (send newsgroup-component :set-previous-article-number saved-current-article-number)
		    (return t)))
		(return t)))
	     (t
	      (when (lisp:search string (get-header-field newsgroup-component :subject) :test #'string-equal)
		(send newsgroup-component :set-previous-article-number saved-current-article-number)
		(return t)))))
	  ;1;;Not at the end of the newsgroup but the next article was not found.  This means that the next article *
	  ;1;;does not exist.  Skip it.*
	  ((not (send newsgroup-component :end-of-newsgroup-p))
	   t)
	  ;1;;Not found.*
	  (t
	   (send newsgroup-component :set-current-article-number saved-current-article-number)
	   (send newsgroup-component :set-previous-article-number saved-previous-article-number)
	   (return nil)))))