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


(defun 4NEWSGROUP-HELP* ()
    
  (format t "~:|Newsgroup-Mode Commands:

<meta-b>             List summary buffer.
c                    Catch up in this newsgroup; i.e., mark all articles as read.
<meta-f>             Reselect the followup article buffer.
g newsgroup          Go to newsgroup.
<meta-g>             Same as g but displays a menu of newsgroups containing the input string.
h,<help>             Help.
^l                   Clear screen.
L                    Lists the current state of the .newsrc, along with status information.
n                    Go to the next newsgroup with unread news.
N                    Go to the next newsgroup.
p                    Go to the previous newsgroup with unread news.
P                    Go to the previous newsgroup.
q,<end>              Quit (Optionaly save the newsrc file).
s, c-x c-s           Save the newsrc file.
u                    Unsubscribe to this newsgroup.
y,<space>            Do this newsgroup now.
-                    Go the previously displayed newsgroup.
1                    Go to the first newsgroup.
^                    Go to the first newsgroup with unread news.
$                    Go to the end of the newsgroup list.
=                    Do this newsgroup now, but list subjects before displaying articles.
_                    Do this newsgroup now, but list subjects of all articles before displaying articles.
<mouse-r>            News menu.


<Press any key to continue>")
  )


(eval-when (load)
  (set-comtab *zmacs-comtab* nil
	      '(("Explorer News" . com-explorer-news)))
	      
  (setq *newsgroup-comtab* (set-comtab 'newsgroup-comtab
				       '(#\1 com-newsgroup-1
					 #\m-b com-newsgroup-list-summary-buffers
					 #\c com-newsgroup-c
					 #\g com-newsgroup-g
					 #\G com-newsgroup-g
					 #\m-G com-newsgroup-meta-g
					 #\h com-newsgroup-help
					 #\L com-newsgroup-shift-l
					 #\c-l com-newsgroup-control-l
					 #\n com-newsgroup-n
					 #\N com-newsgroup-shift-n
					 #\p com-newsgroup-p
					 #\P com-newsgroup-shift-p
					 #\q com-newsgroup-q
					 #\s com-newsgroup-save
					 #\space com-newsgroup-space
					 #\u com-newsgroup-u
					 #\y com-newsgroup-space
					 #\= com-newsgroup-=
					 #\_ com-newsgroup-_
					 #\- com-newsgroup--
					 #\^ com-newsgroup-^
					 #\$ com-newsgroup-$
					 #\mouse-r com-newsgroup-mouse-r
					 #\End com-newsgroup-q
					 #\Help com-newsgroup-help
					 #\Page com-newsgroup-control-l
					 )))
  (set-comtab-indirection *newsgroup-comtab* *zmacs-comtab*)

  (setq *newsgroup-control-x-comtab*
	(set-comtab 'newsgroup-control-x-comtab
		    '(#\c-w com-newsgroup-write-newsrc-file
		      #\c-s com-newsgroup-save
		      )))
  (set-comtab-indirection *newsgroup-control-x-comtab* *zmacs-control-x-comtab*)

  (set-comtab *newsgroup-comtab* (list #\c-x (make-extended-command *newsgroup-control-x-comtab*)))
  (set-comtab-indirection *newsgroup-comtab* *zmacs-comtab*)
  )


(defmajor 4COM-NEWSGROUP-MODE* newsgroup-mode "2Newsgroup-mode*"
	  "Major mode for Explorer news newsgroup mode." ()
  (setq *comtab* *newsgroup-comtab*)
  (set-mouse-documentation)
  (set-mode-line-list (newsgroup-mode-line)))


(defun 4NEWSGROUP-MODE-LINE* ()
  (kill-newsgroup-summary-buffer)		;1This isn't really the right place for this but I want to make sure the*
						;1summary buffer is gone only in newsgroup mode.*
  `("ZMACS (" *mode-name-list* ") " ,(format nil "~a" *user-default-newsrc-file*) "  (" ,(format nil "~a" *nntp-host*)
    ")       " ,(format nil "~a" (if *newsrc-changed* #\* #\ ))))


(defun 4REDISPLAY-NEWSGROUP-MODE-LINE* ()
  (set-mouse-documentation)
  (set-mode-line-list (newsgroup-mode-line))
  (redisplay-mode-line))


(defun 4NEWSGROUP-PROMPT* ()
  (with-read-only-suppressed (*en*)
    (let ((stream (open-editor-stream :window *window* :start :end))
	  (newsgroup-component (get-current-newsgroup)))
      (cond
	((not newsgroup-component)
	 (format stream "~%******** End of newsgroups--what next? [ynq]" )
	 (move-bp (point) (interval-last-bp *interval*)))
	(t
	 (format stream "~%******** ~5d unread articles in ~a--read now? [ynq]"
		 (send newsgroup-component :unread-article-count)
		 (send newsgroup-component :newsgroup-string))
	 (move-bp (point) (interval-last-bp *interval*))))
      (must-redisplay *window* dis-text)
      (redisplay-newsgroup-mode-line))))


(defcom 4COM-EXPLORER-NEWS*
	""
	()
  (en)
  dis-none)


(defcom 4COM-NEWSGROUP-C*
	""
	()
  (let ((newsgroup-component (get-current-newsgroup)))
    (when newsgroup-component
      (cond
	((y-or-n-p "~:|Do you really want to mark everything as read?")
	 (format *query-io* "Marking ~a as all read." (send newsgroup-component :newsgroup-string))
	 (send newsgroup-component :mark-all-articles t)
	 (format *query-io* "..Done")
	 (get-next-newsgroup nil)
	 (newsgroup-prompt))
	(t
	 (format *query-io* "~:|")
	 (newsgroup-prompt)))))
  dis-none)


(defcom 4COM-NEWSGROUP-G*
	""
	()
  (let (newsgroup-component (saved-newsrc-index *newsrc-index*)
	(newsgroup (prompt-and-read :string-or-nil "~:|Newsgroup:  ")))
    (cond
      ((not newsgroup)
       (format *query-io* "~:|"))
      ((position-to-newsgroup newsgroup)
       (unless (current-newsgroup-subscribed-p)
	 (cond
	   ((y-or-n-p (format nil "Newsgroup ~a is currently unsubscribed to--resubscribe?" newsgroup))
	    (subscribe-current-newsgroup t))
	   (t
	    (setf *newsrc-index* saved-newsrc-index))))
       (format *query-io* "~:|"))
      ((setf newsgroup-component (get-newsgroup-component-from-system-list newsgroup))
       (cond
	 ((y-or-n-p (format nil "Newsgroup ~a is currently unsubscribed to--resubscribe?" newsgroup))
	  (add-newsgroup-component-to-newsrc-list newsgroup-component *subscribed*)
	  (position-to-newsgroup newsgroup)
	  (send newsgroup-component :mark-all-articles nil)
	  (subscribe-current-newsgroup t))
	 (t
	  (setf *newsrc-index* saved-newsrc-index))))
      (t
       (format *query-io* "~:|Newsgroup ~a does not exist." newsgroup)))
    (newsgroup-prompt))
  dis-none)


(defcom 4COM-NEWSGROUP-META-G*
	""
	()
  (let ((saved-newsrc-index *newsrc-index*) newsgroup string)
    (setf string (prompt-and-read :string-or-nil "~:|Newsgroup search string (default is all newsgroups):  "))
    (format *query-io* "~:|Building menu of newsgroups.  Please wait...")
    (setf newsgroup (newsgroup-selection string))
    (cond
      ((not newsgroup)
       (format *query-io* "~:|"))
      ((position-to-newsgroup newsgroup)
       (unless (current-newsgroup-subscribed-p)
	 (cond
	   ((y-or-n-p (format nil "Newsgroup ~a is currently unsubscribed to--resubscribe?" newsgroup))
	    (subscribe-current-newsgroup t))
	   (t
	    (setf *newsrc-index* saved-newsrc-index))))
       (format *query-io* "~:|"))
      (t
       (format *query-io* "~:|Newsgroup ~a does not exist." newsgroup)))
    (newsgroup-prompt))
  dis-none)


(defcom 4COM-NEWSGROUP-HELP*
	""
	()
  (with-read-only-suppressed (*en*)
    (newsgroup-help))
  dis-none)


(defcom 4COM-NEWSGROUP-CONTROL-L*
	""
	()
  (clear-buffer *en*)
  (newsgroup-prompt)
  dis-none)


(defcom 4COM-NEWSGROUP-SHIFT-L*
	""
	()
  (newsgroup-selection)
  dis-text)


(defcom 4COM-NEWSGROUP-LIST-SUMMARY-BUFFERS*
	""
	()
    (format t "~&Summary Buffers:")
    (terpri *standard-output*)
    (dolist (buffer (history-list (send *window* :buffer-history)) nil)
      (when (newsgroup-summary-buffer-p buffer)
	(terpri *standard-output*)
	(send *standard-output* :item 'newsgroup-summary-buffer buffer "  ~a" (send buffer :name))))
    (terpri *standard-output*)
    dis-none)


(defcom 4COM-NEWSGROUP-N*
	""
	()
  (get-next-newsgroup nil)
  (newsgroup-prompt)
  dis-none)


(defcom 4COM-NEWSGROUP-SHIFT-N*
	""
	()
  (get-next-newsgroup t)
  (newsgroup-prompt)
  dis-none)


(defcom 4COM-NEWSGROUP-P*
	""
	()
  (get-previous-newsgroup nil)
  (newsgroup-prompt)
  dis-none)


(defcom 4COM-NEWSGROUP-SHIFT-P*
	""
	()
  (get-previous-newsgroup t)
  (newsgroup-prompt)
  dis-none)


(defcom 4COM-NEWSGROUP-Q*
	""
	()
  (en-close)
  (if *newsrc-changed*
      (if (y-or-n-p "~:|The newsrc file ~a has changed, do you wish to save it now? " *user-default-newsrc-file*)
	  (write-newsrc-file)))
  (delete-from-history *en* (send *window* :buffer-history))
  (send (history-latest-element (send *window* :buffer-history)) :select)
  dis-text)


(defcom 4COM-NEWSGROUP-SAVE*
	""
	()
  (COND
    ((not *newsrc-changed*)
     (format *query-io* "~&(No changes need to be written.)"))
    (t
     (write-newsrc-file)
     (redisplay-newsgroup-mode-line)))
  dis-none)


(defcom 4COM-NEWSGROUP-SPACE*
	""
	()
  (let ((newsgroup-component (get-current-newsgroup)))
    (cond
      ((not newsgroup-component)
       (get-next-newsgroup)
       (newsgroup-prompt))
      (t
       ;1;;Make sure we are able to access the newsgroup.*
       (cond
	 ((en-group-command newsgroup-component)
	  (send newsgroup-component :initialize-current-article-number)
	  (send newsgroup-component :get-next-article-number nil)
	  (com-article-selection))
	 (t
	  (format *query-io* "~:|Can't access the newsgroup ~a.  It is protected or unavailable at this time.~%"
		  (send newsgroup-component :newsgroup-string)))))))
  dis-none)


(defcom 4COM-NEWSGROUP-U*
	""
	()
  (let ((newsgroup-component (get-current-newsgroup)))
    (when newsgroup-component
      (subscribe-newsgroup newsgroup-component nil)
      (format *query-io* "~:|Unsubscribed to newsgroup ~a~%" (send newsgroup-component :newsgroup-string))
      (get-next-newsgroup nil)
      (newsgroup-prompt)))
  dis-none)


(defcom 4COM-NEWSGROUP-WRITE-NEWSRC-FILE*
	""
	()
  (let* ((*mini-buffer-dont-record* t)
	 (pathname (read-defaulted-pathname (format nil "Write newsrc file3:*") *user-default-newsrc-file* nil :newest)))
    (write-newsrc-file pathname))
  dis-none)


(defcom 4COM-NEWSGROUP-=*
	""
	()
  (let ((newsgroup-component (get-current-newsgroup)))
    (when newsgroup-component
      (send newsgroup-component :initialize-current-article-number)
1       *;1;;Make sure we are able to access the newsgroup.*
      (cond
	((en-group-command newsgroup-component)
	 (kill-newsgroup-summary-buffer)
	 (send *en* :set-newsgroup-component newsgroup-component)
	 (summary-command nil))
	(t
	 (format *query-io* "~:|Can't access the newsgroup ~a.  It is protected or unavailable at this time.~%"
		 (send newsgroup-component :newsgroup-string))))))
  dis-none)


(defcom 4COM-NEWSGROUP-_*
	""
	()
  (let ((newsgroup-component (get-current-newsgroup)))
    (when newsgroup-component
      (send newsgroup-component :initialize-current-article-number)
1       *;1;;Make sure we are able to access the newsgroup.*
      (cond
	((en-group-command newsgroup-component)
	 (kill-newsgroup-summary-buffer)
	 (send *en* :set-newsgroup-component newsgroup-component)
	 (summary-command t))
	(t
	 (format *query-io* "~:|Can't access the newsgroup ~a.  It is protected or unavailable at this time.~%"
		 (send newsgroup-component :newsgroup-string))))))
  dis-none)


(defcom 4COM-NEWSGROUP--*
	""
	()
  (let ((temp *newsrc-index*))
    (setf *newsrc-index* *previous-newsrc-index*)
    (setf *previous-newsrc-index* temp)
    (newsgroup-prompt))
  dis-none)


(defcom 4COM-NEWSGROUP-^*
	""
	()
  (let ((temp *newsrc-index*))
    (setf *newsrc-index* *start-index*)
    (get-next-newsgroup)
    (setf *previous-newsrc-index* temp))
  (newsgroup-prompt)
  dis-none)


(defcom 4COM-NEWSGROUP-$*
	""
	()
  (let ((temp *newsrc-index*))
    (setf *newsrc-index* *end-index*)
    (get-previous-newsgroup t)
    (setf *previous-newsrc-index* temp))
  (newsgroup-prompt)
  dis-none)


(defcom 4COM-NEWSGROUP-MOUSE-R*
	""
	()
  (case (en-mouse-r)
    ('t
     (clear-buffer *en*)
     (get-next-newsgroup nil)
     (newsgroup-prompt))
    (':abort)
    (Otherwise
     (redisplay-newsgroup-mode-line)))
  dis-none)


(defprop 4COM-NEWSGROUP-MOUSE-R* "News Menu" :mouse-short-documentation)


(defcom 4COM-NEWSGROUP-1*
	""
	()
  (let ((temp *newsrc-index*))
    (setf *newsrc-index* *start-index*)
    (get-next-newsgroup t)
    (setf *previous-newsrc-index* temp))
  (newsgroup-prompt)
  dis-none)