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


(defun 4EN* (&optional arg)
  "2This is the user-callable function that selects the en utility.*"

  (declare (ignore arg))
  (let ((sheet (find-or-create-en-window)))
  	   (send sheet :select) 
	   (tv:await-window-exposure)
	   sheet))


(defun 4EN1* ()
  "2Read news.*"

  (unwind-protect
      (progn
	(format t "~:|")
	(fs:force-user-to-login)
	(en-version)
	(unless (news-initialized-p)
	  (condition-case (error-object)
	      (progn
	       (configure-news-menu)
	       (initialize-news))
	    (sys:abort (send *en* :kill))))

	;1;;Activate the method (en-frame :after :expose) every time the news window is selected.*
	(send *en* :set-news-initialize-check t)
	(reset-news-daemon :start)
	(en-newsgroup-selection-level))
    (en-close)))


(defun 4EN-CLOSE* ()

  (nntp-close *nntp-stream*)
  (setf *nntp-stream* nil)
  (setf *nntp-server-status* nil)
  t)


(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.*"

  (send newsgroup-component :mark-article t)
  (when (en-header-p newsgroup-component)
    (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 (char-equal (send newsgroup-component :moderated) #\m) "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-nntp-article newsgroup-component))
	   (t
	    (write-formatted-header newsgroup-component (send newsgroup-component :current-article-number) stream)
	    (format stream "~%")
	    (en-nntp-body newsgroup-component)))
	 (nntp-print *nntp-stream* stream))
      (sys:abort (nntp-flush *nntp-stream*)))
    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
	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
							(send newsgroup-component :current-article-number) :subject)
				       (send newsgroup-component :current-article-number)))))
	     ;1;;The subjects match.*
	     ((subjects-equal-p (car subject) (get-header-field newsgroup-component
							  (send newsgroup-component :current-article-number) :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)))))))


(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* (newsgroup-component)
  "2Send the NNTP-GROUP command for newsgroup-component.  Return T if the
newsgroup can be accessed.  Return NIL and display the reason if it the
newsgroup couldn't be accessed.*"

  (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 *nntp-stream* (send newsgroup-component :newsgroup-string) nil))
    (cond
      ;1;;The remote server detected a problem.*
      ((not valid-response)
       (format t "~2%Error accessing the newsgroup ~a.~%  ~a~%" (send newsgroup-component :newsgroup-string)
	       response-message)
       nil)
      (t
       (multiple-value-setq (number-of-articles first-article-number last-article-number)
	 (parse-nntp-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))))
	  (format t "~2%Can't access the newsgroup ~a.  It is protected or unavailable at this time.~%"
		  (send newsgroup-component :newsgroup-string))
	  nil)

	 ;1;;No errors accessing the newsgroup.*
	 (t
	  t))))))


(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-nntp-head newsgroup-component nil)
       (parse-and-store-article-header newsgroup-component (send newsgroup-component :current-article-number))
       t)
	  
      ;1;;Since we can't get the article header, mark the article as read so we won't look at this article again.*
      (t
       (send newsgroup-component :mark-article t)
       nil)))
  

(defun 4EN-K* (newsgroup-component)
  "2Mark all articles as read that match the subject of the current article. * 2The
entire newsgroup* 2is 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 (send newsgroup-component :current-article-number)
					    :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
								     (send newsgroup-component :current-article-number)
								     :subject))
	       (incf count)
	       (send newsgroup-component :mark-article t)
	       (format t "~%Article ~d junked.  ~a" (send newsgroup-component :current-article-number)
		       (get-header-field newsgroup-component (send newsgroup-component :current-article-number)
					 :subject))))
	    ;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
	     (when (and *display-articles-killed* (> count 0))
	       (prompt-and-read :character "~%Press any key to continue."))
	     (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-LIST-NEWSRC* ()
  "2Lists the current state of the .newsrc, along with status information.*"
  
  (format t "~:|~%  #  STATUS  NEWSGROUP")
  (loop for newsgroup-component in *newsrc-list*
	count t into i do
	(format t "~%~3d ~7a ~a~a ~a"
		i
		(cond
		  ((send newsgroup-component :subscribed-p)
		   (if (equal (send newsgroup-component :unread-article-count) 0)
		       "(READ)"
		       (send newsgroup-component :unread-article-count)))
		  (t
		   "(UNSUB)"))
		(send newsgroup-component :newsgroup-string)
		(if (send newsgroup-component :subscribed-p)
		    *subscribed*
		    *unsubscribed*)
		(convert-articles-read-to-string (send newsgroup-component :articles-read-bitmap)
						 (send newsgroup-component :high-article-number)
						 (send newsgroup-component :low-article-number)))))


(defun 4EN-LIST-SUBJECTS* (mode)
  "2List subjects of all articles (mode = t) or all unread articles (mode = nil).
Return NIL when there are no more subjects to display.*"
  
  (let (article-number (newsgroup-component (get-current-newsgroup)))
    (send newsgroup-component :set-current-article-number *start*)
    
    (loop with count = 0 and i = *number-of-subjects-to-display* and subject
	  while (> i 0) do
	  
	  ;1;;Is there a next article???*
	  (unless (setf article-number (send newsgroup-component :get-next-article-number mode))
	    (return nil))

	  (cond
	    ((setf subject (get-header-field newsgroup-component (send newsgroup-component :current-article-number)
					     :subject))
	     (setf subject (strip-subject subject))
	     (setf count 0)
	     (decf i)
	     (format t "~%")
	     (format t "~a ~a" (send newsgroup-component :current-article-number)
		     (if (> (length subject) 0)
			 subject
			 "<No Subject>")))
	     
	    ((nntp-head *nntp-stream* (send newsgroup-component :current-article-number) nil)
	     (setf count 0)
	     (decf i)
	     (format t "~%")
	     (parse-and-store-article-header newsgroup-component (send newsgroup-component :current-article-number))
	     (setf subject (strip-subject (cadr (assoc :subject(get newsgroup-component
								    (send newsgroup-component :current-article-number))))))
	     (format t "~a ~a" (send newsgroup-component :current-article-number)
		     (if (> (length subject) 0)
			 subject
			 "<No Subject>")))

	    (t
	     (cond
	       ((zerop count)
		(format t "~%Skipping unavailable article(s)"))
	       ((zerop (mod count 10))
		(format t "...~d" count)))
	     (incf count)
	     (send newsgroup-component :mark-article t)))
	  finally (return t))))


(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)
	 ;1;;Deactivate the method (en-frame :after :expose).*
	 (send *en* :set-news-initialize-check nil)
	 (setf ret (initialize-news))
	 ;1;;Reactivate the method (en-frame :after :expose).*
	 (send *en* :set-news-initialize-check t)
	 (if ret
	     t
	     :abort))

	('reset-the-news-connection
	 (en-close)
	 (en-open)
	 (format t "~%Connection reset.")
	 nil)
	
	('reinitialize-the-news-system
	 (cond
	   ((w:mouse-y-or-n-p "Are you sure you want to initialize news?")
	    ;1;;Deactivate the method (en-frame :after :expose).*
	    (send *en* :set-news-initialize-check nil)
	    (setf ret (initialize-news t))
	    ;1;;Reactivate the method (en-frame :after :expose).*
	    (send *en* :set-news-initialize-check t)
	    ret)
	   (t
	     :abort)))
	
	('write-the-newsrc-file
	 (write-newsrc-file-menu)
	 nil)
	
	('check-for-newnews
	 (format t "~%Checking for new news.  Please wait...")
	 (check-for-newnews)
	 (format t "Done")
	 nil)
	
	('restart-the-background-news-process
	 (news:reset-news-daemon t)
	 (format t "~%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-NEWSGROUP-SELECTION* (&optional (string nil))
  "2Display a menu of newsgroups containing the string string. * 2If string is NIL
then all newsgroups* 2are selected.* 2 Return the newsgroup selected.
Return nil if* 2nothing was selected.*"

  (w:menu-choose
    (sort 
      (let* (return-list (loc (locf return-list)))
	(dolist (newsgroup-component *newsrc-list* return-list)
	  (if (or (null string) (search string (send newsgroup-component :newsgroup-string) :test #'string-equal))
	      (rplacd loc (setf loc (list (send newsgroup-component :newsgroup-string)))))))
       #'string<)

    :menu-margin-choices '(:abort) :columns 1))


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

  (cond
    ((en-server-open-p)
     (nntp-article *nntp-stream* (send newsgroup-component :current-article-number) error))
    (t
     (en-open nil)
     (nntp-group *nntp-stream* (send newsgroup-component :newsgroup-string) nil)
     (nntp-article *nntp-stream* (send newsgroup-component :current-article-number) error))))


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

  (cond
    ((en-server-open-p)
     (nntp-body *nntp-stream* (send newsgroup-component :current-article-number) error))
    (t
     (en-open nil)
     (nntp-group *nntp-stream* (send newsgroup-component :newsgroup-string) nil)
     (nntp-body *nntp-stream* (send newsgroup-component :current-article-number) error))))


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

  (cond
    ((en-server-open-p)
     (nntp-head *nntp-stream* (send newsgroup-component :current-article-number) error))
    (t
     (en-open nil)
     (nntp-group *nntp-stream* (send newsgroup-component :newsgroup-string) nil)
     (nntp-head *nntp-stream* (send newsgroup-component :current-article-number) error))))


(defun 4EN-OPEN* (&optional (verbose *verbose*))

  (cond
    ;1;Server is already open.  Return the server stream.*
    ((en-server-open-p)
     *nntp-stream*)

    (t
     (if verbose (format t "~%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-host*)))))


(defun 4EN-PRINT* (newsgroup-component)
  
  (let ((default-printer (get-default-printer))
	(print-wide printer:*default-print-wide*)
	(copies 1)
	(print-verbose news:*print-verbose*)
	(printers (mapcar #'car (list-printers)))
	temp-zwei-file)
    (declare (special default-printer print-wide copies print-verbose printers))
    
    (condition-case (cond-obj)
	(progn
	 (w:choose-variable-values 
	   
	   '((default-printer    "Default Printer"
				 :documentation  "Click on desired printer."
	       :menu printers)
	     (copies "Number of copies" :documentation "The number of copies to be printed." :number)
	     (print-wide "Print wide sheet" :documentation "Do you want a wide-sheet print?" :boolean)
	     (print-verbose "Print article verbosely" :documentation "Do you want to include the entire article header or use the defaults?" :boolean)
	     )
	   
	   :label "Print Current Article"
	   
	   :margin-choices
	   *default-cvv-margin-choices*
	   
	   :near-mode '(:mouse)
	   )
	 
	 (setq temp-zwei-file (printer:get-temp-zwei-stream-file user-id))
	 (with-open-file (file-stream temp-zwei-file :direction :output :byte-size 8 :error nil)
	   (cond
	     ((errorp file-stream) (format t "~&error: ~a" file-stream) nil)
	     (t
	      (en-display-article file-stream newsgroup-component print-verbose))))
	 (apply #'print-file temp-zwei-file (list :printer-name default-printer :delete-after t :copies copies :print-wide
						  print-wide))
	 t)
      (sys:abort nil)
      (error (format t "~%Error: ~a" cond-obj)))))


(defun 4EN-PROMPT-AND-READ* (&optional format-string)
  "2Prompt and return one character or mouse button.*"
  
  (when format-string
    (format t "~a" format-string))
  (w:read-mouse-or-kbd))


(defun 4EN-SERVER-OPEN-P* ()
  "2Return T if the server is already open.*"

  (and (streamp *nntp-stream*) (equal (send *nntp-stream* :status) :established) t))

  
(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 (search "h" string :start2 slash :test #'string-equal))
		    (setf read (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 (search string (cadr item) :test #'string-equal)
		    (send newsgroup-component :set-previous-article-number saved-current-article-number)
		    (return t)))
		(return t)))
	     (t
	      (when (search string (get-header-field newsgroup-component (send newsgroup-component :current-article-number)
						     :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 fo