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


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

<number>             Go to the numbered article.
<meta-b>             List summary buffer.
<space>              Display the article.
c                    Catch up in this newsgroup; i.e., mark all articles as read.
h,<help>             Help.
j                    Mark the article as read.
k                    Mark as read all articles with the same subject as the current article.
m                    Mark the current article as still unread.
n,^n                 Go to the next article.
p,^p                 Same as n only scan backwards.
q,<end>              Quit newsgroup.
u                    Unsubscribe to this newsgroup.
v                    Display the article.
=                    List subjects of unread articles.
_                    List subjects of all articles.
<mouse-r>            News menu.


<Press any key to continue>")
  )


(eval-when (load)
  (setq *newsgroup-summary-comtab* (set-comtab 'newsgroup-summary-comtab
					'(#\1 com-article-number-1
					  #\2 com-article-number-2
					  #\3 com-article-number-3
					  #\4 com-article-number-4
					  #\5 com-article-number-5
					  #\6 com-article-number-6
					  #\7 com-article-number-7
					  #\8 com-article-number-8
					  #\9 com-article-number-9
					  #\0 com-article-number-0
					  #\m-b com-newsgroup-list-summary-buffers
					  #\c com-newsgroup-summary-c
					  #\h com-newsgroup-summary-help
					  #\j com-newsgroup-summary-j
					  #\k com-newsgroup-summary-k
					  #\m com-newsgroup-summary-m
					  #\n com-down-real-line
					  #\N com-down-real-line
					  #\p com-up-real-line
					  #\P com-up-real-line
					  #\q com-newsgroup-summary-q
					  #\space com-newsgroup-summary-space
					  #\u com-newsgroup-summary-u
					  #\v com-newsgroup-summary-space
					  #\= com-newsgroup-summary-=
					  #\_ com-newsgroup-summary-_
					  #\mouse-r com-newsgroup-summary-mouse-r
					  #\End com-newsgroup-summary-q
					  #\Help com-newsgroup-summary-help
					  #\Return com-newsgroup-summary-return
					  #\Rubout com-article-rubout
					  )))
  (set-comtab-indirection *newsgroup-summary-comtab* *zmacs-comtab*))


(defmajor 4COM-NEWSGROUP-SUMMARY-MODE* newsgroup-summary-mode "2Newsgroup-Summary-Mode*"
	  "Major mode for news summary mode." ()
  (setq *comtab* *newsgroup-summary-comtab*)
  (set-mouse-documentation)
  (set-mode-line-list `(,(newsgroup-summary-mode-line))))


(defun 4NEWSGROUP-SUMMARY-MODE-LINE* ()
  (let ((newsgroup-component (buffer-newsgroup-component *interval*)))
    (format nil "ZMACS (Summary-Mode) Newsgroup: ~a" (send newsgroup-component :newsgroup-string))))


(defcom 4COM-NEWSGROUP-SUMMARY-C*
	""
	()
  (let ((newsgroup-component (send *newsgroup-summary-buffer* :newsgroup-component)))
    (format *query-io* "~:|")
    (cond
      ((y-or-n-p "Do you really want to mark everything as read?")
       (let ((first-number (car (send *newsgroup-summary-buffer* :get-first-summary-line)))
	     (last-number (caar (send *newsgroup-summary-buffer* :get-last-summary-line))))
	 (when (and (numberp first-number) (numberp last-number))
	   (send newsgroup-component :mark-articles first-number last-number t)))
       (com-newsgroup-summary-q))
      (t
       (format *query-io* "~:|"))))
  dis-none)


(defcom 4COM-NEWSGROUP-SUMMARY-HELP*
	""
	()
  (newsgroup-summary-help)
  dis-none)


(defcom 4COM-NEWSGROUP-SUMMARY-J*
	""
	()
  (let ((newsgroup-component (send *newsgroup-summary-buffer* :newsgroup-component))
	(article-number (send *interval* :get-article-number)))
    (when article-number
      (send newsgroup-component :set-current-article-number article-number)
      (mark-newsgroup-summary-buffer-article t)
      (send newsgroup-component :mark-article t *mark-xref-articles-p*)
      (must-redisplay *window* dis-line (cadr (send *interval* :get-summary-line))
		      *newsgroup-summary-buffer-article-read-column*)))
  dis-none)


(defcom 4COM-NEWSGROUP-SUMMARY-K*
	""
	()
  (let ((newsgroup-component (send *newsgroup-summary-buffer* :newsgroup-component))
	(article-number (send *newsgroup-summary-buffer* :get-article-number)))
    (send newsgroup-component :set-current-article-number article-number)
    (send newsgroup-component :mark-article t *mark-xref-articles-p*)
    (must-redisplay *window* dis-line (cadr (send *newsgroup-summary-buffer* :get-summary-line))
		    *newsgroup-summary-buffer-article-read-column*)
    (redisplay *window*)
    (save-article-subject newsgroup-component)
    (format *query-io* "~:|Removing duplicate subjects...")
    (en-k newsgroup-component))
  dis-none)


(defcom 4COM-NEWSGROUP-SUMMARY-M*
	""
	()
  (let ((newsgroup-component (send *newsgroup-summary-buffer* :newsgroup-component))
	(article-number (send *newsgroup-summary-buffer* :get-article-number)))
    (when article-number
      (send newsgroup-component :set-current-article-number article-number)
      (mark-newsgroup-summary-buffer-article nil)
      (send newsgroup-component :mark-article nil nil)
      ;1;;Mark xref articles as read.*
      (when *mark-xref-articles-p* (send newsgroup-component :mark-xref-articles t))
      (must-redisplay *window* dis-line (cadr (send *newsgroup-summary-buffer* :get-summary-line))
		      *newsgroup-summary-buffer-article-read-column*)))
  dis-none)


(defcom 4COM-NEWSGROUP-SUMMARY-MOUSE-R*
	""
	()
  (let ((newsgroup-component (send *newsgroup-summary-buffer* :newsgroup-component)))
    (case (en-mouse-r)
      ('t
       (com-newsgroup-summary-q))
      (':abort)
      (otherwise
1        *;1;;Make sure we are able to access the newsgroup.*
       (unless (en-group-command newsgroup-component)
	 (format *query-io* "~:|Can't access the newsgroup ~a.  It is protected or unavailable at this time.~%"
		 (send newsgroup-component :newsgroup-string))
	 (com-newsgroup-summary-q)))))
  dis-none)


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


(defcom 4COM-NEWSGROUP-SUMMARY-Q*
	""
	()
  (with-read-only-suppressed (*en*)
    (delete-interval *en*)
    (make-buffer-current *en*)
    (kill-newsgroup-summary-buffer)
    (get-next-newsgroup nil)
    (send *en* :set-major-mode 'newsgroup-mode)
    (newsgroup-prompt))
  dis-none)


(defcom 4COM-NEWSGROUP-SUMMARY-RETURN*
	""
	()
  (let ((newsgroup-component (send *newsgroup-summary-buffer* :newsgroup-component)))
    (cond
      ((not (zerop (length *article-number*)))
       (cond
	 ((equal (get-current-newsgroup) newsgroup-component)
	  (send newsgroup-component :update-current-article-number (parse-number *article-number*))
	  (send newsgroup-component :mark-article t *mark-xref-articles-p*)
	  (setf *article-number* "")
	  (com-article-selection))
	 (t
	  (position-to-newsgroup newsgroup-component)
	  (cond
	    ((en-group-command newsgroup-component)
	     (send newsgroup-component :update-current-article-number (parse-number *article-number*))
	     (send newsgroup-component :mark-article t *mark-xref-articles-p*)
	     (setf *article-number* "")
	     (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)))))))
      (t
       nil)))
  dis-none)


(defcom 4COM-NEWSGROUP-SUMMARY-SPACE*
	""
	()
  (let ((newsgroup-component (send *newsgroup-summary-buffer* :newsgroup-component))
	(article-number (send *interval* :get-article-number)))
    (when article-number
      (send newsgroup-component :set-current-article-number article-number)
      (com-article-selection)))
  dis-none)


(defcom 4COM-NEWSGROUP-SUMMARY-U*
	""
	()
  (let ((newsgroup-component (send *newsgroup-summary-buffer* :newsgroup-component)))
    (subscribe-current-newsgroup nil)
    (format *query-io* "~:|Unsubscribed to newsgroup ~a~%" (send newsgroup-component :newsgroup-string))
    (com-newsgroup-summary-q))
  dis-none)


(defcom 4COM-NEWSGROUP-SUMMARY-=*
	""
	()
  (kill-newsgroup-summary-buffer)
  (summary-command nil)
  dis-none)


(defcom 4COM-NEWSGROUP-SUMMARY-_*
	""
	()
  (kill-newsgroup-summary-buffer)
  (summary-command t)
  dis-none)


(defflavor 4NEWSGROUP-SUMMARY-BUFFER*
	   (newsgroup-component			;1Current newsgroup.*
	    summary-mode                        ;1T when both read and unread articles are displayed.  NIL means just unread.*
	    summary-lines			;1Format = ((<article-number>  "line"  <position>  :normal) ...)*
	    )
	   (zmacs-buffer)
  :settable-instance-variables
  :gettable-instance-variables
  :initable-instance-variables)


(defmethod 4(NEWSGROUP-SUMMARY-BUFFER :after :INIT*) (&optional &rest ignore)
  (setq read-only-p t)
  (setq undo-status :dont)
  (setf (get self :dont-sectionize) t)
  (setq saved-major-mode 'newsgroup-summary-mode)
  (send self :set-major-mode 'newsgroup-summary-mode)
  ;1prevent sticky minor modes from creeping in*
  (setq saved-mode-list nil)
  (setq *newsgroup-summary-buffer* self))


(defmethod 4(NEWSGROUP-SUMMARY-BUFFER :after :SELECT*) (&optional &rest ignore)
  (set-mode-line-list `(,(newsgroup-summary-mode-line)))
  (setf *article-number* "")
  (unless (equal (get-current-newsgroup) newsgroup-component)
    (position-to-newsgroup newsgroup-component))
  (must-redisplay *window* dis-text))


(defmethod 4(NEWSGROUP-SUMMARY-BUFFER :after :KILL*) (&optional &rest ignore)
  (without-interrupts
    (setq *newsgroup-summary-buffer* nil)))


(defmethod 4(NEWSGROUP-SUMMARY-BUFFER :ADD-SUMMARY-LINE*) (line)
  "2Add to the list of summary lines.*"
  (setf summary-lines (append summary-lines (list (cons (send newsgroup-component :current-article-number)
							(list line 0 :normal))))))


(defmethod 4(NEWSGROUP-SUMMARY-BUFFER :ARTICLE-READ-P*) (summary-line)
  "2Return T if the article in the summary line has been read.*"
  (when (equal (aref (cadr summary-line) *newsgroup-summary-buffer-article-read-column*) #\ )
    t))


(defmethod 4(NEWSGROUP-SUMMARY-BUFFER :GET-ARTICLE-NUMBER*) (&optional (error t))
  "2Return the article number pointed to by the summary buffer. * 2Return NIL* 2if
the summary line does* 2not describe a message. * 2If error is T then barf an error
message.*"
    (let* ((bp (buffer-point self))
	   (line (bp-line bp))
	   (article-number (getf (line-plist line) :article-number)))
    (if (and (null article-number) error)
	(barf "Summary line does not describe a message.")
	article-number)))


(defmethod 4(NEWSGROUP-SUMMARY-BUFFER :GET-FIRST-SUMMARY-LINE*) ()
  "2Return the first summary line.  Return NIL if no such summary line exists.*"
  (car summary-lines))


(defmethod 4(NEWSGROUP-SUMMARY-BUFFER :GET-LAST-SUMMARY-LINE*) ()
  "2Return the last summary line.  Return NIL if no such summary line exists.*"
  (last summary-lines))


(defmethod 4(NEWSGROUP-SUMMARY-BUFFER :GET-SUMMARY-LINE*) ()
  "2Return the summary line of the article pointed to by the
newsgroup-component.* 2Return NIL if no such summary line exists.*"
  (assoc (send newsgroup-component :current-article-number) summary-lines))


(defmethod 4(NEWSGROUP-SUMMARY-BUFFER :MARK-ARTICLE*) (mode)
  "2Mark the current summary line as read (mode = t) or unread (mode = nil).*"
  (let ((line (send self :get-summary-line)))
    (when line
      (send self :mark-summary-line line mode))))


(defmethod 4(NEWSGROUP-SUMMARY-BUFFER :MARK-LINE*) (line mode)
  "2Mark the line as read (mode = t) or unread (mode = nil).*"
  (setf (aref line *newsgroup-summary-buffer-article-read-column*) (if mode #\  #\*)))


(defmethod 4(NEWSGROUP-SUMMARY-BUFFER :MARK-SUMMARY-LINE*) (summary-line mode)
  "2Mark the summary-line as read (mode = t) or unread (mode = nil).*"
  (send self :mark-line (cadr summary-line) mode))


(defun 4MARK-NEWSGROUP-SUMMARY-BUFFER-ARTICLE* (&optional (mode t))
  "2Mark the current summary line as read (mode = t) or unread (mode = nil).*"
  (when (newsgroup-summary-buffer-p *newsgroup-summary-buffer*)
    (send *newsgroup-summary-buffer* :mark-article mode)))


(defmethod 4(NEWSGROUP-SUMMARY-BUFFER :MOVE-TO-SUMMARY-LINE*) (summary-line)
  "2Move to the summary line summary-line.*"
  (move-bp (buffer-point self) (cdr summary-line)))
  

(defun 4MOVE-TO-SUMMARY-LINE* ()
  "2Move to the summary line pointed to by the newsgroup-component.*"
  (let ((summary-buffer (find-newsgroup-summary-buffer))
	line)
    (when summary-buffer
      (when (setf line (send summary-buffer :get-summary-line))
	(send summary-buffer :move-to-summary-line line)
	t))))


(defun 4MOVE-TO-FIRST-SUMMARY-LINE* ()
  "2Move to the first summary line in newsgroup-component.*"
  (let ((summary-buffer (find-newsgroup-summary-buffer))
	line)
    (when summary-buffer
      (when (setf line (send summary-buffer :get-first-summary-line))
	(send summary-buffer :move-to-summary-line line)
	t))))


(defun 4NEWSGROUP-SUMMARY-BUFFER-P* (object)
  "2T if OBJECT is an en summary buffer.*"
  (typep object 'newsgroup-summary-buffer))


(defun 4NEWSGROUP-SUMMARY-BUFFER-NAME* (newsgroup-component)
  "2Return the summary buffer name.*"
  (string-append (send newsgroup-component :newsgroup-string) " S"))


(defun 4CLEAR-NEWSGROUP-SUMMARY-BUFFER* ()
  (let ((summary-buffer (find-newsgroup-summary-buffer)))
    (when summary-buffer
      (with-read-only-suppressed (summary-buffer)
	(delete-interval summary-buffer)
	(send summary-buffer :set-newsgroup-component nil)
	(send summary-buffer :set-summary-lines nil)))))


(defun 4FIND-NEWSGROUP-SUMMARY-BUFFER* ()
  "2Return the newsgroup summary buffer.  If not found then return NIL.*"
  (when (newsgroup-summary-buffer-p *newsgroup-summary-buffer*)
    *newsgroup-summary-buffer*))


(defun 4INSERT-NEWSGROUP-SUMMARY-HEADING* (bp)
  (insert-moving bp #\return)
  (let ((line (create-line 'art-string 100 (bp-node bp))))
    (setf (line-length line) 0)
    (append-to-line line "Attrs.  Msg# Lines ")
    (loop for (item value) on *newsgroup-summary-template* by #'cddr
	  do
	  (when (symbolp item)
	    (append-to-line line (string-capitalize (string item)) 0 nil
			    (+ 2
			       (cond ((numberp value)
				      (abs value))
				     ((symbolp value)
				      (case value
					(:date-and-time 15)
					(:date 9)
					(:brief-date 6)
					(t 30)))
				     (t
				      30))))))
    (insert-moving bp line)
    (insert-moving bp #\Return)))


(defun 4KILL-NEWSGROUP-SUMMARY-BUFFER* ()
  (when (newsgroup-summary-buffer-p *newsgroup-summary-buffer*)
    (send *newsgroup-summary-buffer* :kill))
  (setq *newsgroup-summary-buffer* nil))


(defun 4MAKE-NEWSGROUP-SUMMARY-BUFFER* (newsgroup-component &optional (mode nil))
  "2Create and return a summary buffer.  If the summary buffer already exists
then return the summary buffer. If mode is T then return both read and unread
news.*"
  (let ((summary-buffer *newsgroup-summary-buffer*))
    (cond
      ;1;;The summary buffer information is current for this newsgroup.  Simply return the summary buffer.*
      ((and summary-buffer
	    (equal newsgroup-component (send summary-buffer :newsgroup-component))
	    (equal mode (send summary-buffer :summary-mode)))
       summary-buffer)
      (t
       (format *query-io* "~&Creating summary for ~a" (send newsgroup-component :newsgroup-string))
       (cond
	 ;1;;The summary buffer already exists but the information is not current.  Clear the old data.*
	 (summary-buffer
	  (clear-newsgroup-summary-buffer)
	  (send summary-buffer :set-newsgroup-component newsgroup-component)
	  (send summary-buffer :set-summary-lines nil)
	  (send summary-buffer :set-summary-mode mode))
	 ;1;;Create a new summary buffer.*
	 (t
	  (setq summary-buffer (make-instance 'newsgroup-summary-buffer :name "Newsgroup-summary-buffer"
					      :newsgroup-component newsgroup-component :summary-mode mode
					      :summary-lines nil))))
       (make-buffer-current summary-buffer)
       (with-read-only-suppressed (summary-buffer)
	 (insert-newsgroup-summary-heading (interval-last-bp summary-buffer))
	 (insert-line-with-leader (make-diagram-line 'mail-summary-black-line-diagram)
				  (bp-line (interval-last-bp summary-buffer)))
	 (redisplay *window*)
	 (loop with line and count = 0 and ucount = 0 and lines-accumulated = (+ 5 (window-n-plines *window*))
	       initially (send newsgroup-component :set-current-article-number *start-index*)
	       while (send newsgroup-component :get-next-article-number mode) do
	       (cond
		 ((en-header-p newsgroup-component)
		  (setq line (make-newsgroup-summary-line newsgroup-component))
		  (setf (line-node line) summary-buffer)
		  (send summary-buffer :mark-line line (article-read-p newsgroup-component))
		  (insert-line-with-leader line (bp-line (interval-last-bp summary-buffer)))
		  (send summary-buffer :add-summary-line line)
		  (when (zerop (decf lines-accumulated))
		    (redisplay *window* :start (interval-first-bp summary-buffer) nil))
		  (unless (zerop ucount)
		    (format *query-io* "~:|Creating summary for ~a" (send newsgroup-component :newsgroup-string)))
		  (setf ucount 0)
		  (when (zerop (mod (incf count) 10))
		    (format *query-io* "...~d" count)))
		 (t
		  ;1;;Skip unavailable articles.  Unavailable articles are articles that do not exist on the news server but are still*
		  ;1;;included in the low article/high article range.*
		  (cond
		    ((zerop ucount)
		     (incf ucount)
		     (format *query-io* "~&Skipping unavailable article(s)"))
		    ((zerop (mod (incf ucount) 10))
		     (format *query-io* "...~d" ucount)))
		  (send newsgroup-component :mark-article t nil)))
	       finally (send newsgroup-component :set-current-article-number (caar (send summary-buffer :summary-lines))))
	 (move-to-summary-line)
	 (format *query-io* "~:|")
	 summary-buffer)))))


(defun 4MAKE-NEWSGROUP-SUMMARY-LINE* (newsgroup-component)
  (let ((line (allocate-summary-line)))
    (setf (line-length line) 0)
    (mung-line line)
    (setf (getf (line-plist line) :article-number) (send newsgroup-component :current-article-number))
    (append-to-line line "       ")
    (format line "~5d " (send newsgroup-component :current-article-number))
    (format line "~5d " (or (get-header-field newsgroup-component :lines t) 0))
    (loop for (item value) on *newsgroup-summary-template* by #'cddr
	  with pad
	  do
	  (when pad
	    (append-to-line line "" 0 nil pad))
	  (setq pad 2)
	  (select item
	    (:from
	     (append-to-line line (or (get-header-field newsgroup-component :from t)
				      "") 0 nil (if (numberp value) value 30)))
	    (:subject
	     (append-to-line line (or (get-header-field newsgroup-component :subject t)
				      "<No Subject>") 0 nil (if (numberp value) value 30)))
	    (:date
	     (select value
	       (:date-and-time
		(append-to-line line (or (get-header-field newsgroup-component :date t) "") 0 nil 15))
	       (:date 
		(append-to-line line (or (get-header-field newsgroup-component :date t) "") 0 nil 9))
	       (:brief-date
		(append-to-line line (or (get-header-field newsgroup-component :date t) "") 0 nil 6))))))
    ;1; Make sure line's bps are ok in case line became shorter*
    (let ((length (line-length line)))
      (dolist (bp (line-bp-list line))
	(when (> (bp-index bp) length)
	  (setf (bp-index bp) length))))
    line))


(defun 4SUMMARY-COMMAND* (mode)
  "2Create and select a summary buffer of all read (mode = t) or unread (mode = nil) articles.
If the buffer already exists then simply select the buffer.*"
  (let ((newsgroup-component (get-current-newsgroup)))
    (condition-case (object)
	(let (summary-buffer saved-article-number)
	  (unless (send newsgroup-component :start-or-end-of-newsgroup-p)
	    (setf saved-article-number (send newsgroup-component :current-article-number)))
	  (send newsgroup-component :initialize-current-article-number)
	  (setf summary-buffer (make-newsgroup-summary-buffer newsgroup-component mode))
	  (cond
	    (saved-article-number
	     (send newsgroup-component :set-current-article-number saved-article-number)
	     (move-to-summary-line))
	    (t
	     (move-to-first-summary-line)))
	  (make-buffer-current summary-buffer))
      (sys:abort (progn (en-close) nil)))))


(tv:add-typeout-item-type *typeout-command-alist* newsgroup-summary-buffer "2Select*"
			  make-buffer-current t "Select this buffer.")

(compile-flavor-methods newsgroup-summary-buffer)