home *** CD-ROM | disk | FTP | other *** search
/ NetNews Usenet Archive 1993 #3 / NN_1993_3.iso / spool / gnu / emacs / gnus / 1490 < prev    next >
Encoding:
Text File  |  1993-01-23  |  8.8 KB  |  262 lines
  1. Path: sparky!uunet!cs.utexas.edu!swrinde!emory!gatech!usenet.ins.cwru.edu!agate!agate!rob
  2. From: rob@agate.berkeley.edu (Rob Robertson)
  3. Newsgroups: gnu.emacs.gnus
  4. Subject: XOVER support for GNUS
  5. Date: 22 Jan 93 15:00:47
  6. Organization: University of California, Bezerkeley
  7. Lines: 251
  8. Message-ID: <ROB.93Jan22150047@hanalei.berkeley.edu>
  9. NNTP-Posting-Host: hanalei.berkeley.edu
  10.  
  11.  
  12. I've cooked the the following hacks so that GNUS can support the XOVER
  13. command that will be available in INN 1.3.  It dramatically speeds up
  14. transfer times.  note these are just hacks, ideally nntp.el would probe
  15. for XOVER and automagically use it if it found it.
  16.  
  17. To use it just set the following hook:
  18.  
  19. (setq nntp-server-hook
  20.       (function
  21.        (lambda ()
  22.      (require 'xover)
  23.      (progn
  24.        (fset 'gnus-retrieve-headers 'xover-retrieve-headers)
  25.        (setq gnus-Article-prepare-hook
  26.          (function
  27.           (lambda ()
  28.             (xover-get-xrefs-on-fly))))))))
  29.  
  30. and byte compile xover.el, and put it in yer lisp path.
  31.  
  32. note that since the Overview database doesn't have the Xref: line,
  33. marking of Xrefs happens when you look at the article, so if you catch
  34. up inside *Subject* mode or do a kill, the other cross references
  35. won't be marked as read automagically...
  36.  
  37. rob
  38.               william robertson
  39.             rob@agate.berkeley.edu
  40.  
  41.      "when i was your age, i walked 10 miles to school, unarmed."
  42.  
  43. ;; hooks for GNUS to use the XOVER command to quickly download
  44. ;; headers.  
  45. ;;
  46. ;; $Header: /home/agate_a/rob/src/elisp/RCS/xover.el,v 1.2 1993/01/17 05:13:14 rob Exp $
  47. ;;
  48. ;; by William Robertson, rob@agate.berkeley.edu
  49. ;; based on code from nntp.el in the GNUS distribution,
  50. ;; by Masanobu UMEDA
  51.  
  52. ;; GNU Emacs is distributed in the hope that it will be useful,
  53. ;; but WITHOUT ANY WARRANTY.  No author or distributor
  54. ;; accepts responsibility to anyone for the consequences of using it
  55. ;; or for whether it serves any particular purpose or works at all,
  56. ;; unless he says so in writing.  Refer to the GNU Emacs General Public
  57. ;; License for full details.
  58.  
  59. ;; Everyone is granted permission to copy, modify and redistribute
  60. ;; GNU Emacs, but only under the conditions described in the
  61. ;; GNU Emacs General Public License.   A copy of this license is
  62. ;; supposed to have been given to you along with GNU Emacs so you
  63. ;; can know your rights and responsibilities.  It should be in a
  64. ;; file named COPYING.  Among other things, the copyright notice
  65. ;; and this notice must be preserved on all copies.
  66.  
  67. ;; this file consists of two parts:
  68.  
  69. ;; one a replacement for nntp-retrieve-headers that uses 
  70. ;; XOVER to download the headers in the group
  71.  
  72. ;; and since the overview database doesn't normally contain 
  73. ;; the Xref data, we have to get it when we actually look at 
  74. ;; articles.  'xover-get-xrefs-on-fly does that when called 
  75. ;; from 'gnus-Article-prepare-hook.
  76.  
  77. ;; this file wants to be byte-compiled
  78.  
  79. ;; i use the following hook to load xover.elc in.  in the future 
  80. ;; i'd like to write sumpin that checks the server and sees if it
  81. ;; supports XOVER and does the right thing.
  82. ;;
  83. ;;(setq nntp-server-hook
  84. ;;      (function
  85. ;;       (lambda ()
  86. ;;     (require 'xover)
  87. ;;     (if (string-match "^agate" nntp-server-name)
  88. ;;         (progn
  89. ;;           (fset 'gnus-retrieve-headers 'xover-retrieve-headers)
  90. ;;           (setq gnus-Article-prepare-hook
  91. ;;             (function
  92. ;;              (lambda ()
  93. ;;            (xover-get-xrefs-on-fly)))))))))
  94. (provide 'xover)
  95.  
  96. ;;(defun xover-test-server ()
  97. ;;  "Test if a server supports the XOVER command
  98. ;;To be called before we do a GROUP command"
  99. ;;  (progn
  100. ;;    (nntp-send-command "^[2345].*$" "XOVER" "1-1")
  101. ;;    (string-match "^[4][0-9][0-9][ \t]" nntp-status-string)))
  102.  
  103. (defmacro nntp-set-header-xref (header xref)
  104.   "Set article xref of HEADER to xref."
  105.   (` (aset (, header) 3 (, xref))))
  106.  
  107. ;;    to be called by gnus-Article-prepare-hook so that it
  108. ;;    adds the xrefs in to the header list of the articles 
  109. ;;    we've looked at, so that we won't get shown them again.
  110.  
  111. (defun xover-get-xrefs-on-fly ()
  112.   "Get Xrefs as we read the article, and place a reference in HEADER"
  113.   (save-restriction
  114.     (goto-char (point-min))
  115.     (search-forward "\n\n" nil 'move)
  116.     (narrow-to-region (point-min) (point))
  117.     (goto-char (point-min))
  118.     (if (re-search-forward "\nXref:[ \t]*\\(.*\\)\n" nil t) 
  119.     (nntp-set-header-xref gnus-current-headers
  120.                   (buffer-substring 
  121.                    (match-beginning 1) (match-end 1))))))
  122.  
  123. (defmacro xover-sequence-to-range (sequence)
  124.   "Convert a SEQUENCE to nntp ranges"
  125.   (` (let ((first (car sequence))
  126.     (last (car sequence)))
  127.     (while (and sequence (or (= last (car sequence)) ;Omit duplicated number
  128.                  (= (1+ last) (car sequence)))) ;Still in sequence
  129.       (setq last (car sequence))
  130.       (setq sequence (cdr sequence)))
  131.     (if (= first last)
  132.     (int-to-string first)
  133.       (concat (int-to-string first) "-" 
  134.                  (int-to-string last))))))
  135.  
  136. ;;    the function 'xover-retrieve-headers is a replacement for
  137. ;;    nntp-retrieve-headers, and uses the XOVER command to get the
  138. ;;    headers.  the syntax of the XOVER command is 
  139. ;;
  140. ;;        XOVER RANGE
  141. ;;
  142. ;;    where 
  143. ;;
  144. ;;        RANGE :  [0-9]+ | [0-9]+-[0-9]+
  145. ;;
  146. ;;    it returns on line per available article:
  147. ;;
  148. ;;    messno\tsubject\tfrom\tdate\tmsg-id\trefs\tlines\tbytes\n
  149. ;;
  150. ;;    the reply is terminated by a .\r\n
  151.  
  152. (defun xover-retrieve-headers (sequence)
  153.   "Return list of article headers specified by SEQUENCE of article id.
  154. The format of list is
  155.  `([NUMBER SUBJECT FROM XREF LINES DATE MESSAGE-ID REFERENCES] ...)'.
  156. Reader macros for the vector are defined as `nntp-header-FIELD'.
  157. Writer macros for the vector are defined as `nntp-set-header-FIELD'.
  158. News group must be selected before calling me."
  159.   (save-excursion
  160.     (set-buffer nntp-server-buffer)
  161.     (erase-buffer)
  162.     (let ((last-point (point-min))
  163.       (number (length sequence))
  164.       (received 0)
  165.       (count 0)
  166.       (headers nil)            ;Result list.
  167.       (article 0)
  168.       (subject nil)
  169.       (message-id)
  170.       (from nil)
  171.       (xref nil)
  172.       (lines 0)
  173.       (date nil)
  174.       (references nil)
  175.       (spin '(?- ?\ ?| ?/ )) 
  176.       (index 0))
  177.       ;; Send XOVER command.
  178.       (while sequence
  179.     (nntp-send-strings-to-server "XOVER" (xover-sequence-to-range sequence))
  180.     (setq count (1+ count))
  181.     ;; Every 400 header requests we have to read stream in order
  182.     ;;  to avoid deadlock.
  183.     (if (or (null sequence)        ;All requests have been sent.
  184.         (zerop (% count nntp-maximum-request)))
  185.         (progn
  186.           (accept-process-output)
  187.           (while (progn
  188.                (goto-char last-point)
  189.                ;; Count replies.
  190.                (while (re-search-forward "^\\.\r$" nil t)
  191.              (setq received (1+ received)))
  192.                (setq last-point (point))
  193.                (< received count))
  194.         ;; If number of headers is greater than 100, give
  195.         ;;  informative messages.
  196.         (and (numberp nntp-large-newsgroup)
  197.              (> number nntp-large-newsgroup)
  198.              (message "NNTP: Transfering %c" (nth index spin))
  199.              (setq index (% (1+ index) (length spin))))
  200.         (nntp-accept-response))
  201.           ))
  202.     )
  203.       ;; Wait for text of last command.
  204.       (goto-char (point-max))
  205.       (re-search-backward "^[0-9]" nil t)
  206.       (if (looking-at "^[23]")
  207.       (while (progn
  208.            (goto-char (- (point-max) 3))
  209.            (not (looking-at "^\\.\r$")))
  210.         (nntp-accept-response)))
  211.       (and (numberp nntp-large-newsgroup)
  212.        (> number nntp-large-newsgroup)
  213.        (message "NNTP: 100%% of headers received."))
  214.       ;; Now all of replies are received.
  215.       (setq received number)
  216.       (and (numberp nntp-large-newsgroup)
  217.        (> number nntp-large-newsgroup)
  218.        (message "NNTP: Parsing headers..."))
  219.       ;; Then examines replies.
  220.       (goto-char (point-min))
  221.       (while (not (eobp))
  222.     (if (looking-at "\\([0-9]+\\)\t\\(.*\\)\t\\(.*\\)\t\\(.*\\)\t\\(.*\\)\t\\(.*\\)\t\\(.*\\)\t\\(.*\\)\r$") 
  223.         (progn
  224.           (setq article
  225.             (string-to-int
  226.              (buffer-substring (match-beginning 1) (match-end 1))))
  227.           (setq subject
  228.             (buffer-substring (match-beginning 2) (match-end 2)))
  229.           (setq from
  230.             (buffer-substring (match-beginning 3) (match-end 3)))
  231.           (setq date
  232.             (buffer-substring (match-beginning 4) (match-end 4)))
  233.           (setq message-id
  234.             (buffer-substring (match-beginning 5) (match-end 5)))
  235.           (setq references
  236.             (buffer-substring (match-beginning 6) (match-end 6)))
  237.           (setq lines (string-to-int
  238.                (buffer-substring (match-beginning 8) (match-end 8))))
  239.           ;; Set default value.
  240.           (setq xref nil)
  241.           ;; Finished to parse one header.
  242.           (if (string= subject "")
  243.           (setq subject "(None)"))
  244.           (if (string= from "")
  245.           (setq from "(Unknown User)"))
  246.           (setq headers
  247.             (cons (vector article subject from
  248.                   xref lines date
  249.                   message-id references) headers))
  250.           (setq received (1- received))
  251.           (and (numberp nntp-large-newsgroup)
  252.            (> number nntp-large-newsgroup)
  253.            (zerop (% received 20))
  254.            (message "NNTP: Parsing headers... %d%%"
  255.                 (/ (* received 100) number)))))
  256.     (forward-line 1))
  257.       (and (numberp nntp-large-newsgroup)
  258.        (> number nntp-large-newsgroup)
  259.        (message "NNTP: Parsing headers... done"))
  260.       (nreverse headers))))
  261.  
  262.